added my little calculator

1 files changed, 74 insertions, 0 deletions

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