## A larger example: Calculator

The implementation of the desktop calculator is derived from the Fudgets example calculator:

```type CalcStack = [Integer]

type CalcState =
(CalcStack,
Integer,
Bool,
Bool)

numOp :: Integer -> CalcState -> CalcState
numOp n (x:xs, b, c, q) = ((if c then n:x:xs else if n < b then x*b+n:xs else x:xs), b, False,q)

unaryOp :: (Integer->Integer) -> CalcState -> CalcState
unaryOp f (x:xs, b, c, q) = (f x:xs, b, True,q)

quitCalc :: CalcState -> CalcState
quitCalc (ls, b, c, q) = (ls, b, c, True)

binaryOp :: (Integer -> Integer -> Integer) -> CalcState -> CalcState
binaryOp f ([x], b, c, q) = binaryOp f ([x,x], b, True, q)
binaryOp f (x:y:xs, b, c, q) = (f y x:xs, b, True, q)

dispCalcState :: CalcState -> String
dispCalcState (x:xs, b, _, _) = (if x < 0 then '-':bconv b (0-x) else bconv b x)++"    "++show b

startstate = ([0::Integer], 10, False, False)

digit d = ["0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"!!(d)]
bconv b x = if x < b then digit x else bconv b (x`div`b) ++ digit (x`mod`b)

button_ls :: [Component (Button (CalcState -> CalcState), DisplayHandle)]
button_ls =
[button (text "Quit")  (quitCalc),
button (text "Enter") (\ (x:xs, b, c, q) -> (x : x : xs, b, True, q)),
button (text "Clear") (\ (_:xs, b, c, q) -> (0:xs, b, False, q)),
button (text "BS")    (\ (x:xs, b, c, q) ->
((if c then x else x`div`b):xs, b, c, q)),
button (text "D")     (numOp 13), button (text "E")     (numOp 14),
button (text "F")     (numOp 15), button (text "mod")   (binaryOp (mod)),
button (text "A")     (numOp 10), button (text "B")     (numOp 11),
button (text "C")     (numOp 12), button (text "/")     (binaryOp (div)),
button (text "7")     (numOp 7),  button (text "8")     (numOp 8),
button (text "9")     (numOp 9),  button (text "*")     (binaryOp (*)),
button (text "4")     (numOp 4),  button (text "5")     (numOp 5),
button (text "6")     (numOp 6),  button (text "-")     (binaryOp (-)),
button (text "1")     (numOp 1),  button (text "2")     (numOp 2),
button (text "3")     (numOp 3),  button (text "+")     (binaryOp (+)),
button (text "0")     (numOp 0),  button (text "Chs")   (unaryOp (0-)),
button (text "Base")  (\ (x:xs, b, c, q) ->
(x:xs, (if x <= 36 && x > 1 then x else b), True, q)),
button (text "Pop")   (\ (x:xs, b, c, q) ->
(if null xs then ([x],b,c, q) else (xs,b,c, q)))]

main =
mkDC ["*title: Calc"]           >>= \ env ->
mapIO (\ x -> x env) button_ls >>= \ ls ->
let
(btns, dhs) = unzip ls

vs = zip
[(x,y) | y<-[1..7],x<-[1..4]]
dhs
in
fixedTable (4,7) (2,2) vs env         >>= \ (tab, tab_dh) ->
label "0" env                         >>= \ (lab, lab_dh) ->
realiseDH env (vbox [lab_dh, tab_dh]) >>
combineButtons btns                   >>= \ btn ->
let
loop st =
getButtonClick btn >>= \ op ->
case op st of
st1@(_,val,_,quit) ->
if quit then
shutdownShop
else
setLabel lab (dispCalcState st1) >>
loop st1
in
loop startstate
```