module calculator

// ********************************************************************************
// Clean example program.
//
// This program creates a dialog with a simple 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)