Yhc/Javascript/Programmers guide/EchoCPS 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  EchoCPS where

-- This module contains useful functions to access properties of underlying
-- Javascript objects in the type-agnostic manner: proceed with caution!
import UnsafeJS

-- This module contains functions to wrap expressions in CPS style
import CPS

-- This module contains Roman-Decimal conversion funcitons
import Roman

-- The modules under DOM are autogenerated from IDL
-- The modules under CDOM are utilities to simplify the use of DOM facilities
import DOM.Level1.Dom
import DOM.Level1.Html
import CDOM.Level1.DomUtils
import CDOM.Level1.Events
import DOM.Level1.Document
import DOM.Level1.HTMLElement
import DOM.Level1.HTMLDivElement
import DOM.Level1.HTMLInputElement

-- This module contains functions to obtain timestamps
import Debug.Profiling

-- Line-mode output: create a <div> element, place a text in it, 
-- append to the parent element (document body).

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 ->
       mkInput doc $ \inp ->
       addChild inp body $ \_ ->
       set'id "input-echo" inp $ \_ ->
       set'on "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 -> a -> Bool
       
inkey o e = unsafeGetProperty "keyCode" e $ \kcs ->
            unsafeToNum kcs $ \kci ->
            if kci == 13
              then
                get'value o $ \val ->
                unsafeToString val $ \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