summaryrefslogtreecommitdiff
path: root/calcGTK
diff options
context:
space:
mode:
Diffstat (limited to 'calcGTK')
-rw-r--r--calcGTK/calc.glade312
-rw-r--r--calcGTK/calc.hs74
2 files changed, 386 insertions, 0 deletions
diff --git a/calcGTK/calc.glade b/calcGTK/calc.glade
new file mode 100644
index 0000000..db09761
--- /dev/null
+++ b/calcGTK/calc.glade
@@ -0,0 +1,312 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Generated with glade 3.20.0 -->
+<interface>
+ <requires lib="gtk+" version="3.20"/>
+ <object class="GtkWindow" id="mainWindow">
+ <property name="can_focus">False</property>
+ <child>
+ <object class="GtkBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <property name="homogeneous">True</property>
+ <child>
+ <object class="GtkBox">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="orientation">vertical</property>
+ <child>
+ <object class="GtkScrolledWindow" id=" ">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="shadow_type">in</property>
+ <child>
+ <object class="GtkTextView" id="hist">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkTextView" id="output">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="editable">False</property>
+ <property name="cursor_visible">False</property>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">False</property>
+ <property name="fill">True</property>
+ <property name="position">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkGrid">
+ <property name="visible">True</property>
+ <property name="can_focus">False</property>
+ <property name="row_homogeneous">True</property>
+ <property name="column_homogeneous">True</property>
+ <child>
+ <object class="GtkButton" id="1">
+ <property name="label" translatable="yes">1</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="2">
+ <property name="label" translatable="yes">2</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="3">
+ <property name="label" translatable="yes">3</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="4">
+ <property name="label" translatable="yes">4</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="5">
+ <property name="label" translatable="yes">5</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="6">
+ <property name="label" translatable="yes">6</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="7">
+ <property name="label" translatable="yes">7</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="8">
+ <property name="label" translatable="yes">8</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="9">
+ <property name="label" translatable="yes">9</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="0">
+ <property name="label" translatable="yes">0</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id=".">
+ <property name="label" translatable="yes">.</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="=">
+ <property name="label" translatable="yes">=</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">0</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="(">
+ <property name="label" translatable="yes">(</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="+">
+ <property name="label" translatable="yes">+</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">0</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="-">
+ <property name="label" translatable="yes">-</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">1</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="*">
+ <property name="label" translatable="yes">*</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">2</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="/">
+ <property name="label" translatable="yes">/</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">4</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="CLR">
+ <property name="label" translatable="yes">CLR</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">1</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="DEL">
+ <property name="label" translatable="yes">DEL</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">2</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id=")">
+ <property name="label" translatable="yes">)</property>
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="receives_default">True</property>
+ </object>
+ <packing>
+ <property name="left_attach">3</property>
+ <property name="top_attach">3</property>
+ </packing>
+ </child>
+ </object>
+ <packing>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ <property name="position">1</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+</interface>
diff --git a/calcGTK/calc.hs b/calcGTK/calc.hs
new file mode 100644
index 0000000..ec47e05
--- /dev/null
+++ b/calcGTK/calc.hs
@@ -0,0 +1,74 @@
+-- Simple Stupid Calculator demonstrating basic gtk/glade and parsec parser usage --
+-- Hacked togeter by Miguel on May 3, 2018
+
+{-# LANGUAGE PackageImports #-}
+import "gtk3" Graphics.UI.Gtk
+import Control.Monad.IO.Class
+import Data.ByteString.Char8 (pack,unpack)
+import Numeric
+import Text.Parsec
+import Text.Parsec.Expr
+import Text.Parsec.Language
+import Text.Parsec.Number (fractional2)
+import Text.Parsec.Token
+
+-- parse calculation --
+calc s = case parse expr "" s of Right x -> showFFloat Nothing x ""
+ _ -> "?"
+
+table = [ [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft ]
+ , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ] ]
+
+lexer = makeTokenParser haskellDef
+expr = buildExpressionParser table term <?> "expression"
+term = parens lexer expr <|> fractional2 False <?> "simple expression"
+
+binary name fun assoc = Infix (do{ reservedOp lexer name; return fun }) assoc
+
+-- gui for the calculator --
+main = do initGUI
+ builder <- builderNew
+ builderAddFromFile builder "calc.glade"
+ window <- builderGetObject builder castToWindow "mainWindow"
+ output <- builderGetObject builder castToTextView "output"
+ outputBuff <- textViewGetBuffer output
+ hist <- builderGetObject builder castToTextView "hist"
+ histBuff <- textViewGetBuffer hist
+ end<-textBufferGetEndIter histBuff
+ histMark <- textBufferCreateMark histBuff Nothing end True
+
+ let conn = connBtn builder outputBuff
+ connA = connBtnAct builder outputBuff
+
+ -- connecting buttons --
+ sequence_ $ conn <$> map show [0..9] ++ ["+","-","/","*","(",")","."]
+
+ connA "CLR" $ textBufferSetByteString outputBuff (pack "")
+ connA "DEL" $ manipTextBuff outputBuff (\x -> case x of [] -> []; xs -> init xs)
+ connA "=" $ do txt<-getTextBuff outputBuff
+ manipTextBuff outputBuff calc
+ res<-getTextBuff outputBuff
+ manipTextBuff histBuff (\x -> x++txt++" = "++res++"\n")
+ end<-textBufferGetEndIter histBuff
+ textBufferMoveMark histBuff histMark end
+ textViewScrollToMark hist histMark 0 $ Just (0,1)
+ return ()
+
+ -- handler to run on window destruction
+ window `on` deleteEvent $ do liftIO mainQuit
+ return False
+ widgetShowAll window
+ mainGUI
+
+getTextBuff outputBuff = do start<-textBufferGetStartIter outputBuff
+ end<-textBufferGetEndIter outputBuff
+ unpack <$> textBufferGetByteString outputBuff start end True
+
+manipTextBuff outputBuff action = do txt<-getTextBuff outputBuff
+ textBufferSetByteString outputBuff (pack $ action $ txt)
+
+connBtn builder buff label = connBtnAct builder buff label $
+ textBufferInsertByteStringAtCursor buff (pack label)
+
+connBtnAct builder buff label act = do btn <- builderGetObject builder castToButton label
+ btn `on` buttonActivated $ act
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-08 18:27:41 +0000