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

