module Main where import Prelude hiding (putStrLn) import System.IO.UTF8 import BrownPLT.JavaScript import BrownPLT.JavaScript.PrettyPrint import Control.Monad import Language.JSMW import Data.DOM import Data.DOM.Dom import Data.DOM.Html2 import Data.DOM.Events import Data.DOM.HTMLBRElement import Data.DOM.HTMLDivElement import qualified Data.DOM.HTMLInputElement as I import qualified Data.DOM.HTMLButtonElement as B import qualified Data.DOM.MouseEvent as M main = putStrLn $ show $ stmt $ FunctionStmt undefined (Id undefined "main") [] (getBlock ( runJSMW 0 top)) -- Hold/pass calc state for convenience. data CStat a b c d = CStat a b c d -- Toplevel widget. top = mkDiv `container` (do setStyle ["width" := "400px", "text-align" := "right", "border-width" := "1px", "border-color" := "black", "horizontal-align" := "right"] calc) -- Calculator widget calc = do inp <- ref I.mkInput acc <- ref I.mkInput ops <- ref I.mkInput flg <- newJSRef true let cst = CStat inp acc ops flg dishide = do ask >>= I.set'disabled true >>= I.set'type (string "hidden") ref2ecrf inp >>= flip container (do setStyle ["width" := "96%", "text-align" := "right"] ask >>= I.set'value (string "0") >>= I.focus) ref2ecrf acc >>= flip container dishide ref2ecrf ops >>= flip container dishide passive mkBr mapM (opB cst) ["C", "\x00B1", "\x00B9\x2044\x2093"] passive mkBr mapM_ (digitB cst) ["7", "8", "9"] opB cst "/" passive mkBr mapM_ (digitB cst) ["4", "5", "6"] opB cst "*" passive mkBr mapM_ (digitB cst) ["1", "2", "3"] opB cst "-" passive mkBr mapM_ (digitB cst) ["0", "."] mapM_ (opB cst) ["=", "+"] return unit -- A button with digit on it. digitB (CStat inp acc ops flg) s = do sn <- stringM s let h :: OnHandler TMouseEvent THTMLButtonElement h e = do f <- readJSRef flg v <- I.get'value inp nv <- switch f $ do True --> stringM "" False --> return v writeJSRef flg false once =<< I.set'value (nv + sn) inp once =<< I.focus inp return true B.mkButton `container` (do setHandler "click" h passive (mkText sn) setStyle ["width" := "24%"]) -- A button with an operation on it. opB (CStat inp acc ops flg) op = do so <- stringM op let h :: OnHandler TMouseEvent THTMLButtonElement h e = doOp inp acc ops flg so B.mkButton `container` (do setHandler "click" h passive (mkText so) setStyle ["width" := "24%"]) -- Common part of calculator operation. doOp inp acc ops flg so = do writeJSRef flg true once =<< I.focus inp switch so $ do "\x00B9\x2044\x2093" --> do -- 1/x vi <- I.get'value inp >>= parseFloat >>= return . recip >>= toString once =<< (toString vi >>= flip I.set'value inp) return true "C" --> do once =<< I.set'value (string "0") inp once =<< I.set'value (string "0") acc once =<< I.set'value (string "") ops return true "\x00B1" --> do -- +- vi <- I.get'value inp >>= parseFloat >>= return . negate >>= toString once =<< (toString vi >>= flip I.set'value inp) return true "=" --> do vi <- I.get'value inp >>= parseFloat va <- I.get'value acc >>= parseFloat op <- I.get'value ops nv <- switch op $ do "+" --> return (va + vi) "-" --> return (va - vi) "*" --> return (va * vi) "/" --> return (va / vi) none (numberM 0) once =<< (toString nv >>= flip I.set'value inp) once =<< (toString vi >>= flip I.set'value acc) return true none $ do once =<< (I.get'value inp >>= flip I.set'value acc) once =<< I.set'value so ops return true