Commit 09092ff0 authored by Steffen Michels's avatar Steffen Michels

Merge branch 'waitForTimer-without-updating-every-second' into 'master'

Add a variant of waitForTimer that does not use currentDateTime and therefore does not update every second

See merge request !373
parents 40167d20 561bcee4
Pipeline #38606 passed with stage
in 7 minutes and 6 seconds
......@@ -344,7 +344,7 @@ simulateHandlingWithObject startLoc object objectLoc alarmLoc status user
>>| autoMove startLoc objectLoc shipShortestPath user myStatusMap myUserActorMap
>>= \objectReached -> if objectReached (pickupObject objectLoc object user myUserActorMap inventoryInSectionShare
>>| autoMove objectLoc alarmLoc shipShortestPath user myStatusMap myUserActorMap
>>= \targetReached -> if targetReached (waitForTimer 1
>>= \targetReached -> if targetReached (waitForTimer False 1
>>| useObject alarmLoc object user myUserActorMap inventoryInSectionShare
>>= \used -> if used (setAlarm user (alarmLoc, NormalStatus) myStatusMap @! True)
(return False))
......
......@@ -599,7 +599,7 @@ autoMove thisSection target pathFun user shipStatusShare userToActorShare
>>- \hopLocks -> get sharedGraph
>>- \graph -> case pathFun thisSection target statusMap exitLocks hopLocks graph of
Just (path=:[nextSection:_], _)
= waitForTimer 1
= waitForTimer False 1
>-| move roomCoord nextSection user
>-| addLog user "" ("Has moved to Section " <+++ nextSection)
>-| autoMove nextSection target pathFun user shipStatusShare userToActorShare
......
......@@ -71,7 +71,7 @@ where f [] = []
| otherwise = [a : f as]
doTaskPeriodically :: Int (Task a) -> Task a | iTask a
doTaskPeriodically period task = forever (waitForTimer period >>| task)
doTaskPeriodically period task = forever (waitForTimer False period >>| task)
doTaskPeriodicallyUntilPause :: Int (Task a) -> Task () | iTask a
doTaskPeriodicallyUntilPause period task
......
......@@ -79,7 +79,7 @@ declarationApplicant today
reminder :: Date String -> Task ()
reminder when msg
= waitForDate when >>| Hint ("Reminder: please " +++ msg) @>> viewInformation [] ()
= waitForDate True when >>| Hint ("Reminder: please " +++ msg) @>> viewInformation [] ()
selectOfficialSolarPanelCompany :: Task Company
selectOfficialSolarPanelCompany
......
......@@ -81,10 +81,10 @@ deadline :: Date (Task a) -> Task (Maybe a) | iTask a
deadline date task
= (task >>- return o Just)
-||-
(waitForDate date >>| return Nothing)
(waitForDate True date >>| return Nothing)
deadlineWith :: Date a (Task a) -> Task a | iTask a
deadlineWith date value task
= task
-||-
(waitForDate date >>| return value)
(waitForDate True date >>| return value)
......@@ -117,38 +117,43 @@ utcDateTimeToTimestamp :: !DateTime -> Timestamp
/**
* Creates a task which blocks a workflow until a specified time.
*
* @param Whether to show a UI with the current time
* @param Time: The specified time at which the task should complete
*
* @return The time to wait for
*
*/
waitForTime :: !Time -> Task Time
waitForTime :: !Bool !Time -> Task Time
/**
* Creates a task which blocks a workflow until a specified date.
*
* @param Whether to show a UI with the current date
* @param Date: The specified date at which the task should complete
*
* @return The date to wait for
*/
waitForDate :: !Date -> Task Date
waitForDate :: !Bool !Date -> Task Date
/**
* Creates a task which blocks a workflow until a specified date and time.
*
* @param Whether to show a UI with the current date and time
* @param DateTime: The specified date and time at which the task should complete
*
* @return The date and time to wait for
*/
waitForDateTime :: !DateTime -> Task DateTime
waitForDateTime :: !Bool !DateTime -> Task DateTime
/**
* Task completes after specified amount of time has passed
* since the creation of the task.
*
* @param Whether to show a UI with the current date and time
* @param The time to wait (in seconds before the task should complete
*
* @return The time the timer went off
*
*/
waitForTimer :: !Int -> Task DateTime
waitForTimer :: !Bool !Int -> Task DateTime
/**
......
......@@ -10,6 +10,8 @@ import iTasks.SDS.Combinators.Common
import iTasks.SDS.Sources.System
from iTasks.Internal.Task import mkInstantTask
import iTasks.Internal.IWorld
import iTasks.Internal.TaskEval
import iTasks.Internal.Util
import iTasks.UI.Definition
import iTasks.UI.Editor
import iTasks.UI.Editor.Controls
......@@ -218,26 +220,54 @@ utcDateTimeToTimestamp :: !DateTime -> Timestamp
utcDateTimeToTimestamp {DateTime|day,mon,year,hour,min,sec} =
timeGm {Tm|sec = sec, min = min, hour = hour, mday = day, mon = mon - 1, year = year - 1900, wday = 0, yday = 0, isdst = -1}
waitForTime :: !Time -> Task Time
waitForTime time
= Title "Wait for time" @>> Hint ("Wait until " +++ toString time) @>> viewSharedInformation [] currentTime
>>* [OnValue (ifValue (\now -> time < now) return)]
waitForDate :: !Date -> Task Date
waitForDate date
= Title "Wait for date" @>> Hint ("Wait until " +++ toString date) @>> viewSharedInformation [] currentDate
>>* [OnValue (ifValue (\now -> date < now) return)]
waitForTime :: !Bool !Time -> Task Time
waitForTime withUI time
| withUI = waitWithUI "Wait for time" currentTime time
| otherwise =
get currentDate >>- \today ->
let target = toDateTime today time in
get currentTime >>- \now
| now <= time -> waitWithoutUI target @ toTime
# (Timestamp target) = utcDateTimeToTimestamp target
# target = timestampToGmDateTime (Timestamp (target + 3600*24))
-> waitWithoutUI target @ toTime
waitForDate :: !Bool !Date -> Task Date
waitForDate withUI date
| withUI = waitWithUI "Wait for date" currentDate date
| otherwise = waitWithoutUI (toDateTime date {Time | hour=0,min=0,sec=0}) @ toDate
waitForDateTime :: !DateTime -> Task DateTime
waitForDateTime datetime
= Title "Wait for date and time" @>> Hint ("Wait until " +++ toString datetime) @>> viewSharedInformation [] currentDateTime
>>* [OnValue (ifValue (\now -> datetime < now) return)]
waitForTimer :: !Int -> Task DateTime
waitForTimer interval =
get currentTimestamp >>- \(Timestamp now) ->
timestampToLocalDateTime (Timestamp (now + interval)) >>- \endTime ->
waitForDateTime endTime
waitForDateTime :: !Bool !DateTime -> Task DateTime
waitForDateTime withUI datetime
| withUI = waitWithUI "Wait for date and time" currentDateTime datetime
| otherwise = waitWithoutUI datetime
waitForTimer :: !Bool !Int -> Task DateTime
waitForTimer withUI interval =
get currentTimestamp >>- \(Timestamp now) ->
timestampToLocalDateTime (Timestamp (now + interval)) >>-
waitForDateTime withUI
waitWithUI :: !String !(sds () d ()) !d -> Task d | Registrable sds & <, toString, iTask d
waitWithUI title share target =
Title title @>> Hint ("Wait until " +++ toString target) @>> viewSharedInformation [] share >>*
[OnValue (ifValue (\now -> target <= now) return)]
waitWithoutUI :: !DateTime -> Task DateTime
waitWithoutUI datetime =
localDateTimeToTimestamp datetime >>- \timestamp ->
let
timespec = timestampToSpec timestamp
param = {start=timespec,interval={tv_sec=1,tv_nsec=0}}
in
Task (eval param) >>*
[OnValue (ifValue ((<=) timespec) \_ -> get currentDateTime)]
where
eval _ DestroyEvent _ iworld
= (DestroyedResult, iworld)
eval param event {taskId,lastEval} iworld
# (Ok (ReadingDone now),iworld) = readRegister taskId (sdsFocus param iworldTimespec) iworld
= (ValueResult (Value now False) (mkTaskEvalInfo lastEval) (mkUIIfReset event (ui UIEmpty)) (Task (eval param)), iworld)
dateTimeStampedShare :: !(sds p b (DateTime,c)) -> SDSLens p b c | gText{|*|}, TC p & TC b & TC c & RWShared sds
dateTimeStampedShare sds
......
......@@ -101,7 +101,7 @@ iworldTimespecNextFire now reg {start,interval}
# start = toI start
interval = toI interval
reg = toI reg
passed = reg - start
passed = max (zero - interval) (reg - start)
= toT (start + ((passed / interval + one) * interval))
where
toI x = toInteger x.tv_sec * toInteger 1000000000 + toInteger x.tv_nsec
......
Markdown is supported
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