Commit ede0dd40 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent 3a5842cf
...@@ -11,6 +11,9 @@ Start world = doHtmlServer (multiUserTask npersons (repeatTask (deadline mytask) ...@@ -11,6 +11,9 @@ Start world = doHtmlServer (multiUserTask npersons (repeatTask (deadline mytask)
mytask = STask "OK" 0 mytask = STask "OK" 0
deadline :: (Task a) -> (Task a) | iData a deadline :: (Task a) -> (Task a) | iData a
deadline task deadline task
= [Txt "Choose person you want to delegate work to:",Br,Br] = [Txt "Choose person you want to delegate work to:",Br,Br]
......
module delegate
import StdEnv, StdHtml
derive gForm [], Maybe
derive gUpd [], Maybe
derive gPrint Maybe
derive gParse Maybe
//derive gerda Maybe
npersons = 5
Start world = doHtmlServer (multiUserTask npersons (delegate mytask (Time 0 0 15))) world
mytask = STask "Done" 0
delegate taskToDelegate time
= [Txt "Choose persons you want to delegate work to:",Br,Br]
?>> determineSet [] =>> \set -> delegateToSet set
where
delegateToSet set = recTask "delegateToSet" delegateToSet`
where
delegateToSet`
= PCTasks [("Waiting", who @:: STask "I Will Do It" Void #>> returnV who) \\ who <- set]
=>> \who -> who @:: (timedTask time taskToDelegate)
=>> \(b,work)-> if b (returnV work) (delegateToSet set )
determineSet set = recTask "determineSet" determineSet`
where
determineSet`
= [Txt ("Current set:" +++ print set)]
?>> CTask [("Add Person", cancelTask choosePerson =>> \nr -> returnV nr)
,("Finished", returnV Nothing)
]
=>> \result -> case result of
(Just new) -> determineSet (sort (removeDup [new:set]))
Nothing -> returnV set
choosePerson = STask "Set" (PullDown (1,100) (0,[toString i \\ i <- [1..npersons]]))
=>> \whomPD -> returnV (Just (toInt(toString whomPD)))
cancelTask task = PCTask2 (task,STask "Cancel" Void #>> returnV createDefault)
print [] = ""
print [x:xs] = toString x +++ " " +++ print xs
timedTask time task = PCTask2 ( PCTasks [ ("TimedTask",task =>> \value -> returnV (True,value))
, ("Return", returnV (False,createDefault))
]
, waitForTimerTask time #>> returnV (False,createDefault)
)
module newsGroups module newsGroups
// In this example newsgroups are created and maintained // In this example newsgroups are created and maintained
// User 0 is the manager of the newsgroup who can create ne newgroups // User 0 is the manager of the newsgroup who can create new newgroups
// All other users can subscribe to such a newsgroup, commit a message or read news // All other users can subscribe to such a newsgroup, commit a message or read news
// (c) mjp 2007
import StdEnv, StdHtml import StdEnv, StdHtml
......
...@@ -2664,7 +2664,7 @@ OtherModules ...@@ -2664,7 +2664,7 @@ OtherModules
Y: 10 Y: 10
SizeX: 800 SizeX: 800
SizeY: 624 SizeY: 624
DclOpen: True DclOpen: False
IclOpen: False IclOpen: False
LastModified: No 0 0 0 0 0 0 LastModified: No 0 0 0 0 0 0
Module Module
......
...@@ -21,7 +21,8 @@ instance == (DisplayMode a) | == a ...@@ -21,7 +21,8 @@ instance == (DisplayMode a) | == a
derive gLexOrd HtmlDate, HtmlTime derive gLexOrd HtmlDate, HtmlTime
instance < HtmlDate, HtmlTime instance < HtmlDate, HtmlTime
instance toString HtmlDate, HtmlTime instance toString HtmlDate, HtmlTime
instance + HtmlTime
instance - HtmlTime
// lay out // lay out
......
...@@ -396,6 +396,10 @@ where ...@@ -396,6 +396,10 @@ where
derive gLexOrd HtmlTime, HtmlDate derive gLexOrd HtmlTime, HtmlDate
instance < HtmlTime where (<) ht1 ht2 = gEq{|*|} (gLexOrd{|*|} ht1 ht2) LT instance < HtmlTime where (<) ht1 ht2 = gEq{|*|} (gLexOrd{|*|} ht1 ht2) LT
instance + HtmlTime where (+) (Time h1 m1 s1) (Time h2 m2 s2)
= Time (h1 + h2) (m1 + m2) (s1 + s2)
instance - HtmlTime where (-) (Time h1 m1 s1) (Time h2 m2 s2)
= Time (h1 - h2) (m1 - m2) (s1 - s2)
instance < HtmlDate where (<) hd1 hd2 = gEq{|*|} (gLexOrd{|*|} hd1 hd2) LT instance < HtmlDate where (<) hd1 hd2 = gEq{|*|} (gLexOrd{|*|} hd1 hd2) LT
instance toString HtmlTime where instance toString HtmlTime where
......
...@@ -129,9 +129,11 @@ mkRDynTaskCall :: String a *TSt -> (((Task a) -> (Task a),Task a),*TSt)| iData ...@@ -129,9 +129,11 @@ mkRDynTaskCall :: String a *TSt -> (((Task a) -> (Task a),Task a),*TSt)| iData
/* Time and Date management: /* Time and Date management:
waitForTimeTask :: Task is done when time has come waitForTimeTask :: Task is done when time has come
waitForTimerTask:: Task is done when specified amount of time has passed
waitForDateTask :: Task is done when date has come waitForDateTask :: Task is done when date has come
*/ */
waitForTimeTask :: HtmlTime -> (Task HtmlTime) waitForTimeTask :: HtmlTime -> (Task HtmlTime)
waitForTimerTask:: HtmlTime -> (Task HtmlTime)
waitForDateTask :: HtmlDate -> (Task HtmlDate) waitForDateTask :: HtmlDate -> (Task HtmlDate)
/* Lifting iData domain to iTask domain /* Lifting iData domain to iTask domain
......
...@@ -156,7 +156,9 @@ mkTask taskname mytask = \tst -> mkTask` tst ...@@ -156,7 +156,9 @@ mkTask taskname mytask = \tst -> mkTask` tst
where where
mkTask` tst mkTask` tst
# tst = incTask tst // every task should first increment its tasknumber # tst = incTask tst // every task should first increment its tasknumber
= mkTaskNoInc taskname mytask tst # (tasknr,tst) = tst!tasknr // to avoid uniqueness type error
# (a,tst) = mkTaskNoInc taskname mytask tst
= (a,{tst & tasknr = tasknr})
mkTaskNoInc :: !String (Task a) -> (Task a) | iData a // common second part of task wrappers mkTaskNoInc :: !String (Task a) -> (Task a) | iData a // common second part of task wrappers
mkTaskNoInc taskname mytask = \tst -> mkTaskNoInc` tst mkTaskNoInc taskname mytask = \tst -> mkTaskNoInc` tst
...@@ -176,14 +178,13 @@ repeatTask2 task = \tst -> mkTask "repeatTask2" repeatTask` tst ...@@ -176,14 +178,13 @@ repeatTask2 task = \tst -> mkTask "repeatTask2" repeatTask` tst
where where
repeatTask` tst=:{tasknr} repeatTask` tst=:{tasknr}
# (val,tst) = task {tst & tasknr = [-1:tasknr]} // shift tasknr # (val,tst) = task {tst & tasknr = [-1:tasknr]} // shift tasknr
= repeatTask2 task {tst & tasknr = tasknr} // loop = repeatTask2 task tst // loop
recTask2 :: !String (Task a) -> (Task a) | iData a recTask2 :: !String (Task a) -> (Task a) | iData a
recTask2 taskname mytask = \tst -> mkTask taskname recTask` tst recTask2 taskname mytask = \tst -> mkTask taskname recTask` tst
where where
recTask` tst=:{tasknr} recTask` tst=:{tasknr}
# (val,tst) = mytask {tst & tasknr = [-1:tasknr]} // shift tasknr = mytask {tst & tasknr = [-1:tasknr]} // shift tasknr
= (val,{tst & tasknr = tasknr})
// same, but by remembering results stack space can be saved // same, but by remembering results stack space can be saved
...@@ -395,7 +396,7 @@ where ...@@ -395,7 +396,7 @@ where
| not adone = (a,{tst & activated = adone, html = html +|+ BT choice.form +-+ ahtml, hst = hst}) | not adone = (a,{tst & activated = adone, html = html +|+ BT choice.form +-+ ahtml, hst = hst})
= (a,{tst & activated = adone, html = html +|+ ahtml, hst = hst}) = (a,{tst & activated = adone, html = html +|+ ahtml, hst = hst})
but i = LButton defpixel (i <+++ ":Or") but i = LButton defpixel i
mode i j mode i j
| i==j = Display | i==j = Display
= Edit = Edit
...@@ -505,18 +506,17 @@ where ...@@ -505,18 +506,17 @@ where
ireturnV :: a -> (Task a) | iData a ireturnV :: a -> (Task a) | iData a
ireturnV a = \tst -> (a,{tst & activated = True}) ireturnV a = \tst -> (a,tst)
returnV :: a -> (Task a) | iData a returnV :: a -> (Task a) | iData a
returnV a = \tst -> mkTask "returnV" returnV` tst returnV a = \tst -> mkTask "returnV" returnV` tst
where where
returnV` tst = (a,{tst & activated = True}) // return result task returnV` tst = (a,tst) // return result task
returnTask :: a -> (Task a) | iData a returnTask :: a -> (Task a) | iData a
returnTask a = \tst -> mkTask "returnTask" (returnTask` a) tst returnTask a = \tst -> mkTask "returnTask" (returnTask` a) tst
where where
returnTask` a tst=:{tasknr,activated,html,hst} returnTask` a tst=:{tasknr,activated,html,hst}
// # editId = "edit_" <+++ showTaskNr tasknr
= (a,{tst & html = html +|+ BT [toHtml a ], activated = True, hst = hst}) // return result task = (a,{tst & html = html +|+ BT [toHtml a ], activated = True, hst = hst}) // return result task
returnVF :: a [BodyTag] -> (Task a) | iData a returnVF :: a [BodyTag] -> (Task a) | iData a
...@@ -658,10 +658,17 @@ waitForTimeTask time = \tst -> mkTask "waitForTimeTask" waitForTimeTask` tst ...@@ -658,10 +658,17 @@ waitForTimeTask time = \tst -> mkTask "waitForTimeTask" waitForTimeTask` tst
where where
waitForTimeTask` tst=:{tasknr,hst} waitForTimeTask` tst=:{tasknr,hst}
# taskId = itaskId tasknr "_Time_" # taskId = itaskId tasknr "_Time_"
# (taskdone,hst) = mkStoreForm (Init,cFormId tst.storageInfo taskId (False,time)) id hst // remember time # (stime,hst) = mkStoreForm (Init,cFormId tst.storageInfo taskId time) id hst // remember time
# ((currtime,_),hst) = getTimeAndDate hst # ((currtime,_),hst) = getTimeAndDate hst
| currtime < time = (time,{tst & activated = False,hst = hst}) | currtime < stime.value= (stime.value,{tst & activated = False,hst = hst})
= (time,{tst & hst = hst}) = (currtime - stime.value,{tst & hst = hst})
waitForTimerTask:: HtmlTime -> (Task HtmlTime)
waitForTimerTask time = waitForTimerTask`
where
waitForTimerTask` tst=:{hst}
# ((ctime,_),hst) = getTimeAndDate hst
= waitForTimeTask (ctime + time) {tst & hst = hst}
waitForDateTask:: HtmlDate -> (Task HtmlDate) waitForDateTask:: HtmlDate -> (Task HtmlDate)
waitForDateTask date = \tst -> mkTask "waitForDateTask" waitForDateTask` tst waitForDateTask date = \tst -> mkTask "waitForDateTask" waitForDateTask` tst
......
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