From 9d1659957b81ba3655cc16e4d47426ca154b287b Mon Sep 17 00:00:00 2001 From: Miguel Date: Sun, 17 Mar 2019 11:20:04 +0100 Subject: added my little calculator --- calcGTK/calc.glade | 312 +++++++++++++++++++++++++++++++++++++++++++++++++++++ calcGTK/calc.hs | 74 +++++++++++++ 2 files changed, 386 insertions(+) create mode 100644 calcGTK/calc.glade create mode 100644 calcGTK/calc.hs 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 @@ + + + + + + False + + + True + False + vertical + True + + + True + False + vertical + + + True + True + in + + + True + True + + + + + True + True + 0 + + + + + True + True + False + False + + + True + True + 1 + + + + + False + True + 0 + + + + + True + False + True + True + + + 1 + True + True + True + + + 0 + 2 + + + + + 2 + True + True + True + + + 1 + 2 + + + + + 3 + True + True + True + + + 2 + 2 + + + + + 4 + True + True + True + + + 0 + 1 + + + + + 5 + True + True + True + + + 1 + 1 + + + + + 6 + True + True + True + + + 2 + 1 + + + + + 7 + True + True + True + + + 0 + 0 + + + + + 8 + True + True + True + + + 1 + 0 + + + + + 9 + True + True + True + + + 2 + 0 + + + + + 0 + True + True + True + + + 0 + 3 + + + + + . + True + True + True + + + 1 + 3 + + + + + = + True + True + True + + + 3 + 0 + + + + + ( + True + True + True + + + 2 + 3 + + + + + + + True + True + True + + + 0 + 4 + + + + + - + True + True + True + + + 1 + 4 + + + + + * + True + True + True + + + 2 + 4 + + + + + / + True + True + True + + + 3 + 4 + + + + + CLR + True + True + True + + + 3 + 1 + + + + + DEL + True + True + True + + + 3 + 2 + + + + + ) + True + True + True + + + 3 + 3 + + + + + True + True + 1 + + + + + + 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 -- cgit v1.2.3