-- Demo program which gets a multi-level list via AJAX
-- and displays it on a page.


module AJAXList where

import UnsafeJS
import CPS

-- import Numeric

import CDOM.Level2.DomUtils
import DOM.Level2.HTMLElement
import DOM.Level2.HTMLDivElement
import DOM.Level2.HTMLSpanElement
import qualified DOM.Level2.HTMLButtonElement as B
import qualified DOM.Level2.HTMLOptionElement as O
import qualified DOM.Level2.HTMLSelectElement as S
import qualified DOM.Level2.HTMLInputElement as I
import qualified DOM.Level2.HTMLImageElement as J
import DOM.Level2.KeyEvent
import DOM.Level2.Events
import DOM.Level2.Dom
import DOM.Level2.Node
import DOM.Level2.CSS2Properties

import Graphics.UI.WebSP.Types
import Graphics.UI.WebSP.Containers
import Graphics.UI.WebSP.Display
import Graphics.UI.WebSP.Passive
import Graphics.UI.WebSP.Combinators
import Graphics.UI.WebSP.Weblogue
import Graphics.UI.WebSP.Input
import Graphics.UI.WebSP.Decorations
import Graphics.UI.WebSP.Routing
import Graphics.UI.WebSP.Utility
import Graphics.UI.WebSP.Ctlpar
import Graphics.UI.WebSP.Library
import Graphics.UI.WebSP.Context


import Graphics.UI.Fudgets.SP.StreamProc

main = docBodyT mainSP ([] :: [([Int], TEvent)]) id

mainSP = shellT "Up Counter" upcntW ([] :: [([Int], TEvent)])
    |>>> shellT "Three Button Counter" tbcntW ([] :: [([Btn], TEvent)])
    |>>> shellT "Select Element with Icons" selicnW ([] :: [([Int], TEvent)])
    |>>> shellT "Factorial" factW ([] :: [([Int], TEvent)])

shellT ns w mms = genericC (mkDiv `withClass` "shell") $
         genericC (mkDiv `withClass` "title") (textD ns)
    |>>> genericT (mkDiv `withClass` "client")
                  (\x msg doc ctx par -> toCPS (MASend msg))
                  (leafR nullU)
                  w mms


upcntW = stripR
    |>>> genericC (mkSpan `withClass` "btn") (buttonI [0] "Up" (textD "Up"))
    |>>> mapstateU count 0 
    |>>> mapU show
    |>>> genericC (mkSpan `withClass` "display") (stringD "0")
    |>>> genericC (mkDiv `withClass` "divider") (leafR nullU)


data Btn = Up | Down | Reset deriving (Eq, Ord)

tbcntW = let btn r i v t = genericC (mkSpan `withClass` "btn") $
                           buttonI r v (imageD i t |>>>textD t)
             ctl n b = case b of
               Down  -> (n - 1, [n - 1])
               Reset -> (0,     [0])
               Up    -> (n + 1, [n + 1])
         in  taggedR [ (Down,  btn [Down]  "icons/go-down.png" Down "Down") 
                     , (Reset, btn [Reset] "icons/go-bottom.png" Reset "Reset")
                     , (Up,    btn [Up]    "icons/go-up.png" Up "Up")]
             |>>> mapstateU ctl 0
             |>>> mapU show
             |>>> genericC (mkSpan `withClass` "display") (stringD "0")
             |>>> genericC (mkDiv `withClass` "divider") (leafR nullU)

mapstateU f s doc ctx par = mapstateSP f s

count s _ = (s + 1, [s + 1])

selicnW = stripR 
     |>>> genericC (mkSpan `withClass` "btn") (
            selectI [0] 1 (iconoptP "icons/mail.png" "Mail" 
                      |>>> iconoptP "icons/edit.png" "Edit"
                      |>>> iconoptP "icons/help-about.png" "Help"))
     |>>> genericC (mkSpan `withClass` "display") (stringD "None")
     |>>> genericC (mkDiv `withClass` "divider") (leafR nullU)

fac 0 = 0
fac 1 = 1
fac n = n * (fac (n - 1))

mfac :: String -> String
mfac s = catchJS ((show . fac . read) s) (\_ -> "--")
         

factW = stripR
   |>>> genericC (mkSpan `withClass` "btn") (inputlnI [0])
   |>>> mapU mfac
   |>>> genericC (mkSpan `withClass` "display") (stringD "0")
   |>>> genericC (mkDiv `withClass` "divider") (leafR nullU)

inputlnI r = genericI I.mkInput
                      (flip keyHandlerPF ent) r
                      "keydown"
                      (\x msg doc ctx par -> I.get'value x $ \v -> toCPS (MASend v))
                      (leafR nullU)

ent e k = get'keyCode e $ \c -> k $ EvtAction (c == cDOM_VK_ENTER) True