[Added Unicode and CPS/DOM versions of the Echo demo program
golubovsky@gmail.com**20070320022955] {
hunk ./src/translator/js/lib/haskell/CDOM/Level1/DomUtils.hs 4
- getDocument, getHTMLDocument,
+ getDocument, getHTMLDocument, insertChild,
hunk ./src/translator/js/lib/haskell/CDOM/Level1/DomUtils.hs 32
- (appendChild parent child :: CPS b TNode)$ \p -> k parent
+ (appendChild parent child :: CPS b TNode) $ \p -> k parent
+
+insertChild :: (CNode refChild, CNode newChild, CNode parent) =>
+ refChild -> newChild -> parent -> CPS b parent
+
+insertChild before child parent k =
+ (insertBefore parent child before :: CPS b TNode) $ \p -> k parent
addfile ./web/jsdemos/EchoCPS.hs
hunk ./web/jsdemos/EchoCPS.hs 1
+-- 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
+
+
addfile ./web/jsdemos/EchoCPS.html
hunk ./web/jsdemos/EchoCPS.html 1
+
+
+
+
+EchoCPS
+
+
+
+
+
addfile ./web/jsdemos/EchoUnicode.html
hunk ./web/jsdemos/EchoUnicode.html 1
+
+
+
+
+Echo
+
+
+
+
+
}