deadline.icl 1.27 KB
Newer Older
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
1
2
3
4
5
6
7
8
9
module deadline

import StdEnv, StdHtml

derive gForm []
derive gUpd []

npersons = 5

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
10
Start world = doHtmlServer (multiUserTask npersons (deadline mytask <<@ Persistent)) world
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
11
12
13

mytask = STask "Press" 0

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
14
15
deadline :: (Task a) -> (Task a) | iData a
deadline task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
16
=						[Txt "Choose person you want to delegate work to:",Br,Br] 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
17
						?>>	STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
18
	=>> \whomPD		->	[Txt "Until what time do you want to wait today?",Br,Br] 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
19
						?>>	STask "SetTimer" (Time 0 0 0)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
20
21
22
23
24
25
26
	=>> \time		->	[Txt "Cancel delegated work if you are getting impatient:",Br,Br]
						?>> PCTasks
								[ ("Waiting",	shifttask (toInt(toString whomPD)) time task)
								, ("Cancel",	returnV (False,createDefault))
								]
	=>> \(ok,value) ->	if ok 	[Txt ("Result of task: " +++ printToString value),Br,Br] 
								[Txt "Task expired or canceled, default value chosen !",Br,Br]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
27
						?>> STask "OK" value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
28
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
29
30
	shifttask who time task
		= 	(who,"Timed Task") 	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
31
32
				@: 	PCTask2	
					(	waitForTimeTask time 								// wait for deadline
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
33
						#>> returnV (False,createDefault)					// return default value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
34
35
36
37
38
					, 	[Txt ("Please finish task before" <+++ time),Br,Br]	// tell deadline
						?>> (task =>> \v -> returnV (True,v))				// do task and return its result
					)