Commit 2159cbf8 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

[bodytags] kunnen nu als Clean data gebruikt worden in een editor

parent e51c5451
......@@ -2,11 +2,15 @@ module workflowExamples
import StdEnv, StdHtml
import htmlTask
import htmlTask, htmlHandler
derive gForm []
derive gUpd []
testCode tst = STask "OK" (showHtml [Txt "Vul de waarde in: ",Br, Hr [], B [] "test", Br ], 0) tst
//Start world = doHtmlServer (multiUser (Quotation myQuotation)) world
//Start world = doHtmlServer (multiUser twotasks3) world
Start world = doHtmlServer (multiUser agenda2) world
......@@ -23,7 +27,7 @@ where
= mkHtml "test" [idform.form <=> html] hst
where
persistent tasks tst
# tst = setTaskAttribute Persistent tst
// # tst = setTaskAttribute Persistent tst
= tasks tst
......@@ -62,7 +66,7 @@ twotasks3 tst
# ((forAssist,fromSecr),tst) = mkRDynTaskCall "secr-assist" 0 tst // split name task
= PTasks
[( "boss", STask "Choose" Easy `bind`
\situation -> forSecr (taskForSecr situation forAssist) `bind`
\situation -> forSecr ((1,"Do Job ") @: taskForSecr situation forAssist) `bind`
\result -> STask "accept" result
)
,("secretary", fromBoss)
......@@ -71,7 +75,7 @@ twotasks3 tst
where
taskForSecr Easy forAssist tst
# tst = returnF [Txt ("Handle easy case")] tst
= forAssist (STask "Damage" 0) tst
= forAssist ((2,"Specify damage") @: STask "Damage" 0) tst
taskForSecr (Difficult upperbound) _ tst
# tst = returnF [Txt ("Handle difficult case with limit " +++ (toString upperbound) +++ " Euro's")] tst
= checktask upperbound tst
......@@ -160,27 +164,35 @@ instance toString (a,b) | toString a & toString b
where
toString (a,b) = "(" <+++ a <+++ "," <+++ b <+++ ")"
agenda2 = \tst -> agenda` 0 ( Date 0 0 0, Time 0 0 0
) tst
agenda2 = \tst -> agenda` 0 (Date 0 0 0,Time 0 0 0) tst
where
agenda` who date tst
# (date,tst) = STask "SetDateAndTime" date tst
agenda` who daytime tst
# (daytime,tst) = askDateTime daytime tst
# (whoPd,tst) = STask "AskPerson" (PullDown (1,100) (who,[toString i \\ i <- [0..10]])) tst
# ((ok,date),tst) = ((toInt (toString whoPd),"Meeting Request") @: handle date) tst
# ((ok,daytime),tst)= ((toInt (toString whoPd),"Meeting Request") @: handle daytime) tst
| ok
# tst = returnF [Txt "Proposal accepted",Br] tst
= returnTask date tst
# tst = returnF [Txt ("No, but can we meet on the " <+++ date <+++ "?"),Br] tst
# tst = returnF [Txt "Accepted",Br] tst
= returnTask daytime tst
# tst = promptDateTime daytime tst
# (ok,tst) = CTask_button [("Accept",returnV True),("Sorry",returnV False)] tst
| ok = returnV date tst
= mkTask (agenda` (toInt(toString whoPd)) date) tst
| ok = returnV daytime tst
= mkTask (agenda` (toInt(toString whoPd)) daytime) tst
where
handle date tst
# tst = returnF [Txt ("Can we meet on the " <+++ date <+++ "?"),Br] tst
handle daytime tst
# tst = promptDateTime daytime tst
# (ok,tst) = CTask_button [("Accept",returnV True),("Sorry",returnV False)] tst
| ok = returnV (ok,date) tst
# (date,tst) = STask "AlternativeDate" date tst
= returnV (ok,date) tst
| ok = returnV (ok,daytime) tst
# (daytime,tst) = askDateTime daytime tst
= returnV (ok,daytime) tst
askDateTime (date,time) tst
# input = (showHtml [Txt "Meeting Date: "], date, showHtml [Txt "Meeting Time: "], time)
# ((_,date,_,time),tst) = STask "Set" input tst
= ((date,time),tst)
promptDateTime (date,time) tst
= returnF [Txt ("Can we meet on the " <+++ date <+++ " at " <+++ time <+++ "?"),Br] tst
//agenda :: (Task Bool)
agenda = \tst -> agenda` (PullDown (1,300) (0,[toString i \\ i <- [0..10]]) ) tst
......@@ -281,6 +293,9 @@ where
calcCosts booked = sum [cost \\ (_,_,_,cost) <- hd booked]
isNil [] = True
isNil _ = False
// quotation example
:: QForm = { fromComp :: String
......
......@@ -17,6 +17,8 @@ import
, htmlArrow // arrow instantiations for iData forms
, htmlTask // for easy creation of workflow tasks based on iData
// html code generation:
......
......@@ -191,6 +191,7 @@ None :== [NoAttr]
| Ul [Ul_Attr] [BodyTag] // unordered list <ul></ul>
| Var [Std_Attr] String // variable text <var></var>
| InlineCode String // to give the ability to plug in code directly
| STable [Table_Attr] [[BodyTag]] // simple table used for Clean forms
| BodyTag [BodyTag] // improves flexibility for code generation
| EmptyBody // same
......
......@@ -104,7 +104,8 @@ gHpr{|BodyTag|} prev (Tr attr body) = prev <+> htmlAttrCmnd "tr" attr body
gHpr{|BodyTag|} prev (Tt attr text) = prev <+> htmlAttrCmnd "tt" attr text
gHpr{|BodyTag|} prev (Txt text) = prev <+ text
//gHpr{|BodyTag|} prev (Txt attr text) = prev <+> htmlAttrCmnd "b" attr text
gHpr{|BodyTag|} prev (InlineCode text) = [|text:prev]
gHpr{|BodyTag|} prev (U attr text) = prev <+> htmlAttrCmnd "u" attr text
gHpr{|BodyTag|} prev (Ul attr body) = prev <+> htmlAttrCmnd "ul" attr body
gHpr{|BodyTag|} prev (Var attr text) = prev <+> htmlAttrCmnd "var" attr text
......@@ -246,7 +247,5 @@ derive gHpr TxtDir
derive gHpr Ul_Attr
derive gHpr BodyAttr
/*
gHpr{|BodyAttr|} prev (Batt_background file) = prev <+ " background=" <+ file
gHpr{|BodyAttr|} prev (Batt_bgcolor color) = prev <+ " bgcolor=" <+ color
*/
......@@ -42,6 +42,14 @@ toHtmlForm :: !(*HSt -> *(Form a,*HSt)) -> [BodyTag] // toHtmlForm disp
toBody :: (Form a) -> BodyTag // just (BodyTag form.body)
createDefault :: a | gUpd{|*|} a // creates a default value of requested type
:: Inline = Inline String
derive gForm Inline
derive gUpd Inline
derive gParse Inline
derive gPrint Inline
showHtml :: [BodyTag] -> Inline // enabling to show Html code in Clean data
// definitions on HSt
instance FileSystem HSt // enabling file IO on HSt
......@@ -49,7 +57,6 @@ instance FileSystem HSt // enabling file IO on HSt
appWorldHSt :: !.(*World -> *World) !*HSt -> *HSt // enabling World operations on HSt
accWorldHSt :: !.(*World -> *(.a,*World)) !*HSt -> (.a,!*HSt) // enabling World operations on HSt
// Specialists section...
// Added for testing of iData applications with GAST
......
......@@ -487,6 +487,17 @@ toHtmlForm anyform
toBody :: (Form a) -> BodyTag
toBody form = BodyTag form.form
derive gUpd Inline
derive gParse Inline
derive gPrint Inline
gForm{|Inline|} (init,formid) hst
# (Inline string) = formid.ival
= ({changed=False, value=formid.ival, form=[InlineCode string]},incrHSt 2 hst)
showHtml :: [BodyTag] -> Inline
showHtml bodytags = Inline (foldl (+++) "" (reverse [x \\ x <|- gHpr {|*|} [|] bodytags]))
createDefault :: a | gUpd{|*|} a
createDefault = fromJust (snd (gUpd {|*|} (UpdSearch (UpdC "Just") 0) Nothing))
derive gUpd Maybe
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment