*** empty log message ***

libraries/htmlGEC/Examples/Simple Workflows/workflowExamples.icl

@@ -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
 

libraries/htmlGEC/htmlTask.dcl

@@ -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 

libraries/htmlGEC/htmlTask.icl

@@ -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