blob: ec47e0569d762758b9b06c32421bf962eb3409e9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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
|
