Personal tools

Yhc/Javascript/Programmers guide/EchoCPS demo source

From HaskellWiki

< Yhc | Javascript | Programmers guide(Difference between revisions)
Jump to: navigation, search
(Imported the source)
 
m (EchoCPS demo source moved to Yhc/Javascript/Programmers guide/EchoCPS demo source)

Revision as of 20:52, 13 June 2007

-- 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
 
import UnsafeJS
 
import CPS
import Roman
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
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 ->
       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