deadline.icl 1.35 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 (repeatTask (deadline mytask) )) world
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
11

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
12
mytask = STask "OK" 0
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
13

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 "SetTime" (Time 0 0 0)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
20
	=>> \time		->	[Txt "Cancel delegated work if you are getting impatient:",Br,Br]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
21
22
23
24
25
26
27
28
29
30
						?>> PCTask2
								(	delegateTask (toInt(toString whomPD)) time task
								, 	STask_button "Cancel" (returnV (False,createDefault))
								)
	=>> \(ok,value) ->	if ok 	(	[Txt ("Result of task: " +++ printToString value),Br,Br] 
									?>> STask_button "OK" (returnV value)
								)
								(	[Txt "Task expired or canceled, you have to do it yourself!",Br,Br]
									?>>	STask_button "OK" task
								)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
31
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
32
	delegateTask who time task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
33
		= 	(who,"Timed Task") 	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
34
35
				@: 	PCTask2	
					(	waitForTimeTask time 								// wait for deadline
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
36
						#>> returnV (False,createDefault)					// return default value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
37
38
39
40
41
					, 	[Txt ("Please finish task before" <+++ time),Br,Br]	// tell deadline
						?>> (task =>> \v -> returnV (True,v))				// do task and return its result
					)