Yhc/Javascript/Programmers guide/EchoCPS2 demo source

-- A program similar to the Echo program, written
-- without monads as the first step to Fudgets adoption.
-- The program also demonstrates use of the DOM Level1 framework
-- also implemented in CPS style.
 
module  EchoCPS2 where
 
import UnsafeJS
 
import CPS
import Roman
import DOM.Level2.Dom
import DOM.Level2.Html2
import CDOM.Level2.DomUtils
import CDOM.Level2.Events
import DOM.Level2.Events
import DOM.Level2.Document
import DOM.Level2.HTMLElement
import DOM.Level2.HTMLDivElement
import DOM.Level2.HTMLInputElement
import DOM.Level2.KeyEvent
import Debug.Profiling
 
 
putLine s mbb c = getHTMLDocument $ \doc ->
                  documentBody doc $ \body ->
                  mkDiv doc $ \dv ->
                  mkText doc s $ \tx ->
                  addChild tx dv $ \ch ->
                  let iac = case mbb of
                              Nothing -> addChild dv
                              Just b -> insertChild b dv
                  in  iac body $ \ct -> 
                  c ct
 
 
main = getHTMLDocument $ \doc ->
       documentBody doc $ \body ->
       putLine ("*** Echo Benchmark ***") nodeNothing $ \_ ->
       mkInput doc $ \inp ->
       addChild inp body $ \_ ->
       set'id "input-echo" inp $ \_ ->
       setEventHandler "keypress" (inkey inp) inp $ \_ ->
       focus inp $ id
 
romdec :: String -> (String, String)
 
romdec v =
  let rom = (catchJS ((show . fromRoman) v) (\_ -> ""))
      dec = (catchJS ((toRoman . read) v) (\_ -> ""))
  in (rom, dec)
 
inkey :: THTMLInputElement -> TKeyEvent -> Bool
 
inkey o e = get'keyCode e $ \kci ->
            if kci == cDOM_VK_ENTER
              then
                get'value o $ \v ->
                if length v > 0
                  then
                    getTimeStamp $ \t1 -> 
                    toCPE (romdec v) $ \(rom, dec) ->
                    rom `seq` dec `seq` getTimeStamp $ \t2 ->
                    putLine (v ++ " " ++ rom ++ " " ++ dec ++ " " ++ show (t2 - t1) ++ " ms") 
                            (Just o) $ \_ ->
                    set'value "" o $ \_ ->
                    True
                  else  
                    True
              else True