Calculator

1 files changed, 102 insertions, 0 deletions

diff --git a/calculator.icl b/calculator.icl
new file mode 100644
index 0000000..58a384c
--- /dev/null
+++ b/calculator.icl
@@ -0,0 +1,102 @@
+module calculator
+
+import StdEnv, StdIO
+
+:: Calculator :== History
+:: History :== [Entry]
+:: Entry = Cmd Command | N Real | Invalid
+:: Command = Add | Sub | Mul | Div
+
+calc :: History -> History
+calc [] = [N 0.0]
+calc [Cmd c:es] = [Cmd c:es]
+calc [N b:[Cmd c:[N a:es]]] = [apply a c b : es]
+where
+    apply :: Real Command Real -> Entry
+    apply a Add b = N (a + b)
+    apply a Sub b = N (a - b)
+    apply a Mul b = N (a * b)
+    apply _ Div 0.0 = Invalid
+    apply a Div b = N (a / b)
+calc h = h
+
+instance zero History where zero = [N 0.0]
+
+instance toString History
+where
+    toString [] = "0"
+    toString [N n:h]
+    | toReal (toInt n) == n = toString (toInt n)
+    | otherwise = toString n
+    toString [Invalid:h] = "C"
+    toString [Cmd Add:h] = toString h +++ "+"
+    toString [Cmd Sub:h] = toString h +++ "-"
+    toString [Cmd Mul:h] = toString h +++ "*"
+    toString [Cmd Div:h] = toString h +++ "/"
+
+Start :: *World -> *World
+Start world
+# (ids, world) = openIds 17 world 
+# id_add = ids!!10
+# id_sub = ids!!11
+# id_mul = ids!!12
+# id_div = ids!!13
+# id_clr = ids!!14
+# id_eq  = ids!!15
+# id_res = ids!!16
+# but_numbers = [ButtonControl ("&" +++ toString i) [ControlId (ids!!i), ControlFunction (func_num i id_res), buttonwidth] \\ i <- [0..9]]
+# but_add = ButtonControl "&+" [ControlId id_add, ControlFunction (func_add id_res), buttonwidth]
+# but_sub = ButtonControl "&-" [ControlId id_sub, ControlFunction (func_sub id_res), buttonwidth]
+# but_mul = ButtonControl "&*" [ControlId id_mul, ControlFunction (func_mul id_res), buttonwidth]
+# but_div = ButtonControl "&/" [ControlId id_div, ControlFunction (func_div id_res), buttonwidth]
+# but_clr = ButtonControl "&C" [ControlId id_clr, ControlFunction (func_clr id_res), buttonwidth]
+# but_eq  = ButtonControl "&=" [ControlId id_eq,  ControlFunction (func_eq id_res), buttonwidth]
+# text_res = TextControl "0" [ControlId id_res, ControlWidth (PixelWidth 200)]
+# controls = text_res :+: LayoutControl (ListLS [
+        LayoutControl (ListLS [but_numbers!!7, but_numbers!!8, but_numbers!!9, but_add]) [ControlPos (Left, zero)],
+        LayoutControl (ListLS [but_numbers!!4, but_numbers!!5, but_numbers!!6, but_sub]) [ControlPos (Left, zero)],
+        LayoutControl (ListLS [but_numbers!!1, but_numbers!!2, but_numbers!!3, but_mul]) [ControlPos (Left, zero)],
+        LayoutControl (ListLS [but_numbers!!0, but_clr, but_eq, but_div]) [ControlPos (Left, zero)]
+    ]) [ControlHMargin 0 0, ControlVMargin 0 0, ControlPos (Left, zero)]
+# dialog = Dialog "Calculator" controls [WindowClose (noLS closeProcess)]
+= startIO NDI Void (initialise dialog) [] world
+where
+    initialise dialog pst
+    # (error,pst)       = openDialog zero dialog pst
+    | error <> NoError  = closeProcess pst
+    | otherwise         = pst
+
+    buttonwidth = ControlWidth (ContentWidth "+")
+
+    func_num :: Int Id (History, PSt .l) -> (History, PSt .l)
+    func_num n textid (h, pst) = (new_h n h, appPIO (setControlText textid (toString (new_h n h))) pst)
+    where
+        new_h n [] = [N (toReal n)]
+        new_h n [N m:h] = [N (10.0 * m + toReal n) : h]
+        new_h n h = [N (toReal n) : h]
+
+    add_cmd :: History Command -> History
+    add_cmd [] _ = []
+    add_cmd [Invalid : h] _ = [Invalid : h]
+    add_cmd [Cmd _ : h] c = [Cmd c : h]
+    add_cmd h c = [Cmd c : calc h]
+
+    func_add :: Id (History, PSt .l) -> (History, PSt .l)
+    func_add textid (h, pst) = let new_h = add_cmd h Add in (new_h, appPIO (setControlText textid (toString new_h)) pst)
+
+    func_sub :: Id (History, PSt .l) -> (History, PSt .l)
+    func_sub textid (h, pst) = let new_h = add_cmd h Sub in (new_h, appPIO (setControlText textid (toString new_h)) pst)
+
+    func_mul :: Id (History, PSt .l) -> (History, PSt .l)
+    func_mul textid (h, pst) = let new_h = add_cmd h Mul in (new_h, appPIO (setControlText textid (toString new_h)) pst)
+
+    func_div :: Id (History, PSt .l) -> (History, PSt .l)
+    func_div textid (h, pst) = let new_h = add_cmd h Div in (new_h, appPIO (setControlText textid (toString new_h)) pst)
+
+    func_clr :: Id (History, PSt .l) -> (History, PSt .l)
+    func_clr textid ([_:h], pst) = (h, appPIO (setControlText textid (toString h)) pst)
+    func_clr textid st = st
+
+    func_eq :: Id (History, PSt .l) -> (History, PSt .l)
+    func_eq textid (h, pst) = let new_h = calc h in (new_h, appPIO (setControlText textid (toString new_h)) pst)
+