Commit 45e16e46 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 163eaa28
......@@ -9,13 +9,13 @@ derive gUpd []
//Start world = doHtmlServer (mkflow Coffeemachine) world
//Start world = doHtmlServer (mkflow CoffeeMachineInf) world
//Start world = doHtmlServer (mkflow (requestTask 100)) world
// Start world = doHtmlServer (mkflow (RecordSongs ["song 1","song 2","song 3"])) world
//Start world = doHtmlServer (mkflow CreateMusic) world
//Start world = doHtmlServer (mkflow (Quotation myQuotation)) world
//Start world = doHtmlServer (mkflow travel) world
Start world = doHtmlServer (mkflow optelTaak) world
Start world = doHtmlServer (mkflow agenda) world
where
mkflow tasks hst
# (html,hst) = startTask tasks hst
......@@ -28,16 +28,59 @@ optelTaak tst
| c > 1000 = returnTask c tst
= mkTask optelTaak tst
test2 tst
# (tboss,tsecr,tst) = mkLTask "travel" travel tst
# (result,tst) = PTasks
[( "secretary"
, PTask2 (tsecr `bind` \t -> returnTask t, working "secr")
)
,( "boss"
, PTask2 (tboss `bind` \t -> returnTask t, working "boss")
)
agenda :: (Task Bool)
agenda = \tst -> agenda` tst
where
agenda` tst
# ((voorstel,acceptatie),tst) = mkLTaskRTC "agenda" init datumbrief tst
# (afspraak,tst) = PTasks
[( "persoon1"
, acceptatie `bind` \t -> returnTask t
)
,( "persoon2"
, STask "kiesDatum" init `bind` voorstel
)
] tst
| not (hd afspraak) = mkTask agenda tst
= returnTask (hd afspraak) tst
where
init = Date 2 2 2006
datumbrief date tst
# tst = returnF [Txt "voorgestelde datum:",Br] tst
# (_,tst) = returnTask date tst // laat voorgestelde datum zien
= CTask_button [ ("geaccepteerd", returnTask True)
, ("afgewezen", returnTask False)
] tst
test3 tst
# ((tboss,tsecr),tst) = mkLTaskRTC "telop" 0 telop tst
# (result,tst) = PTasks
[( "secretary"
, tsecr
)
,( "boss"
, STask "waarde" 0 `bind` tboss
)
] tst
= returnTask result tst
where
telop b tst
# (_,tst) = returnTask b tst
# (a,tst) = STask "telop" 0 tst
= returnTask (a+b) tst
test2 tst
# ((tboss,tsecr),tst) = mkLTask "travel" travel tst
# (result,tst) = PTasks
[( "secretary"
, PTask2 (tsecr `bind` \t -> returnTask t, tsecr `bind` \t -> returnTask t)
)
,( "boss"
, PTask2 (tboss `bind` \t -> returnTask t, tsecr `bind` \t -> returnTask t)
)
] tst
= returnTask result tst
where
working s tst = CTask_button [(s+++"Working",working s),(s+++"Done",returnTask "done")] tst
......@@ -120,6 +163,11 @@ Quotation (state,form) tst
// coffee machine
CoffeeMachineInf :: *TSt -> (Int,*TSt)
CoffeeMachineInf tst
# (_,tst) = Coffeemachine tst
= mkTask CoffeeMachineInf tst
Coffeemachine tst
# (_,tst) = returnTask "Choose Product" tst
# ((toPay,product),tst) = CTask_button
......@@ -128,13 +176,17 @@ Coffeemachine tst
, ("Thee",returnTask (50,"Thee"))
, ("Chocolate",returnTask (100,"Chocolate"))
] tst
# (returnMoney,tst) = getCoins (toPay,0) tst
# ((cancel,returnMoney),tst) = getCoins (toPay,0) tst
| cancel = returnTask ("Cancelled",returnMoney) tst
= returnTask (product,returnMoney) tst
where
getCoins (toPay,paid) tst
# (coin,tst) = CTask_button [(toString i <+++ " cts", returnTask i) \\ i <- [5,10,20,50,100]] tst
# ((cancel,coin),tst)= PCTask2 ( CTask_button [(toString i <+++ " cts", returnTask (False,i)) \\ i <- [5,10,20,50,100]]
, STask_button "Cancel" (returnV (True,0))
) tst
| cancel = returnV (cancel,paid) tst
| toPay - coin > 0 = mkTask (getCoins (toPay - coin,paid + coin)) tst
= returnV (coin - toPay) tst
= returnV (cancel,coin - toPay) tst
// coffee machine, monadic style
......
......@@ -12,7 +12,7 @@ import StdHtml
startTask :: lift iData to iTask domain
mkTask :: promote TSt state function to an interactive Task, i.e. task will only be called when it is its turn
mkLTask :: split indicated task in a lazy task and
a task which can be used to activate that lazy task aftrewhich it waits for its completion and result
a task which can be used to activate that lazy task after which it waits for its completion and result
STask :: a Sequential iTask
STask_button :: do corresponding iTask when button pressed
......@@ -39,9 +39,13 @@ appIData :: lift iData editors to iTask domain
startTask :: (Task a) *HSt -> ([BodyTag],HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkLTask :: String (Task a) *TSt -> (Task a,Task a,*TSt)
mkLTask :: String (Task a) *TSt -> ((Task a,Task a),*TSt)
| gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkLTaskRTC :: String b (b -> Task a) *TSt -> ((b -> Task a,Task a),*TSt)
| gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
& gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
STask :: String a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STask_button :: String (Task a) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
STasks :: [(String,Task a)] -> (Task [a]) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
......
......@@ -11,10 +11,70 @@ derive gPrint Niks
:: Niks = Niks // to make an empty task
// lazy task ???
startTask :: (Task a) *HSt -> ([BodyTag],HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
startTask taska hst
# (_,((_,_,html),hst)) = taska (newTask,hst)
= (html,hst)
where
newTask = ([],True,[])
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkTask mytask = \tst -> mkTask` tst
where
mkTask` tst=:((i,myturn,html),hst)
# tst = incTask tst // every task should first increment its tasknumber
| not myturn = (createDefault,tst) // not active, return default value
= mytask tst
incTask ((i,b,html),hst) = ((incTasknr i,b,html),hst)
where
incTasknr [] = [0]
incTasknr [i:is] = [i+1:is]
mkLTaskRTC :: String b (b -> Task a) *TSt -> ((b -> Task a,Task a),*TSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
& gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC b
mkLTaskRTC s initb batask tst = let (a,b,c) = LazyTask` s (incTask tst) in ((a,b),c)
where
LazyTask` s tst=:((j,myturn,html),hst) = (bossTask, workerTask s,tst)
where
workerTask s tst = mkTask (workerTask` s) tst
where
workerTask` s tst=:((i,myturn,html),hst)
# (boss,hst) = bossStore id hst // check input from boss
# (worker,hst) = workerStore id hst // check result from worker
# bdone = fst boss.value
# binput = snd boss.value
# wdone = fst worker.value
# wresult = snd worker.value
| wdone = (wresult,((i,True,html<|.|> [Txt ("Lazy task \"" +++ s +++ "\" completed:")]),hst))
| bdone
# (wresult,((_,wdone,whtml),hst)) = batask binput ((j++[0],True,[]),hst) // apply task to input from boss
| wdone // worker task finshed
# (_,hst) = workerStore (\_ -> (wdone,wresult)) hst // store task and status
= workerTask` s ((i,myturn,html),hst) // complete as before
= (createDefault,((i,False,html <|.|> if wdone [] [Txt ("lazy task \"" +++ s +++ "\" activated:"),Br] <|.|> whtml),hst))
= (createDefault,((i,False,html<|.|>[Txt ("Waiting for task \"" +++ s +++ "\"..")]),hst)) // no
bossTask b tst = mkTask bossTask` tst
where
bossTask` tst=:((i,myturn,html),hst)
# (boss,hst) = bossStore id hst // check input from boss
# (worker,hst) = workerStore id hst // check result from worker
# bdone = fst boss.value
# binput = snd boss.value
# wdone = fst worker.value
# wresult = snd worker.value
| bdone && wdone = (wresult,((i,True,html<|.|> [Txt ("Result of lazy task \"" +++ s +++ "\" :")]),hst)) // finished
| not bdone
# (_, hst) = bossStore (\_ -> (True,b)) hst // store b information to communicate to worker
= (createDefault,((i,False,html<|.|>[Txt ("Waiting for task \"" +++ s +++ "\"..")]),hst))
= (createDefault,((i,False,html<|.|>[Txt ("Waiting for task \"" +++ s +++ "\"..")]),hst))
workerStore fun = mkStoreForm (Init,sFormId ("workerStore" <+++ mkTaskNr j) (False,createDefault)) fun
bossStore fun = mkStoreForm (Init,sFormId ("bossStore" <+++ mkTaskNr j) (False,initb)) fun
mkLTask :: String (Task a) *TSt -> (Task a,Task a,*TSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkLTask s task tst = LazyTask` s task (incTask tst)
mkLTask :: String (Task a) *TSt -> ((Task a,Task a),*TSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkLTask s task tst = let (a,b,c) = LazyTask` s task (incTask tst) in ((a,b),c)
where
LazyTask` s task tst=:((j,myturn,html),hst) = (bossTask, workerTask s task,tst)
where
......@@ -42,27 +102,6 @@ where
lazyTaskStore fun = mkStoreForm (Init,sFormId ("getLT" <+++ mkTaskNr j) (False,createDefault)) fun
checkBossSignal fun = mkStoreForm (Init,sFormId ("setLT" <+++ mkTaskNr j) (fun False)) fun
startTask :: (Task a) *HSt -> ([BodyTag],HSt) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
startTask taska hst
# (_,((_,_,html),hst)) = taska (newTask,hst)
= (html,hst)
where
newTask = ([],True,[])
mkTask :: (*TSt -> *(a,*TSt)) -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
mkTask mytask = \tst -> mkTask` tst
where
mkTask` tst=:((i,myturn,html),hst)
# tst = incTask tst // every task should first increment its tasknumber
| not myturn = (createDefault,tst) // not active, return default value
= mytask tst
incTask ((i,b,html),hst) = ((incTasknr i,b,html),hst)
where
incTasknr [] = [0]
incTasknr [i:is] = [i+1:is]
returnTask :: a -> (Task a) | gForm{|*|}, gUpd{|*|}, gPrint{|*|}, gParse{|*|}, TC a
returnTask a = \tst -> mkTask (returnTask` a) tst
where
......@@ -191,12 +230,13 @@ where
# (choice,hst) = TableFuncBut (Init,sFormId ("Cbt_task_" <+++ mkTaskNr i) [[(but txt,\_ -> n)] \\ txt <- map fst options & n <- [0..]]) hst
# (chosen,hst) = mkStoreForm (Init,sFormId ("Cbt_chosen_" <+++ mkTaskNr i) 0) choice.value hst
# chosenTask = snd (options!!chosen.value)
# chosenTaskName = fst (options!!chosen.value)
# (a,((_,adone,ahtml),hst)) = chosenTask ((i ++ [chosen.value + 1],True,[]),hst)
| not adone = ([a],((i,adone,html <|.|> [choice.form <=> ahtml]),hst))
| not adone = ([a],((i,adone,html <|.|> [choice.form <=> ( [Txt ("Task: " +++ chosenTaskName)] <|.|> ahtml)]),hst))
# (alist,((_,finished,_),hst))
= checkAllTasks 0 [] ((i,myturn,[]),hst)
| finished = (alist,((i,finished,html),hst))
= ([a],((i,finished,html <|.|> [choice.form <=> ahtml]),hst))
= ([a],((i,finished,html <|.|> [choice.form <=> ([Txt ("Task: " +++ chosenTaskName)] <|.|> ahtml)]),hst))
but i = LButton defpixel i
......
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