Yhc/Javascript/Programmers guide/EchoCPS demo source: Difference between revisions
(Imported the source) |
m (EchoCPS demo source moved to Yhc/Javascript/Programmers guide/EchoCPS demo source) |
||
(No difference)
|
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