1:- module(timedcg,
2 [ now//1
3 , sync//0
4 , wait//0
5 , wait//1
6 , adv//1
7 , cue//1
8 , cue//2
9 , run_cued//2
10 , run_cued//3
11 , run_cued/2
12 , run_cued/3
13 , sleep_till/1
14 ]).
27:- meta_predicate run_cued(+,//,+,-), run_cued(+,+,//,+,-). 28:- meta_predicate run_cued(+,//), run_cued(+,+,//). 29
30:- use_module(library(dcg_core)). 31:- use_module(library(dcg_pair)). 32:- use_module(library(dcg_macros)). 33
34
40now(T,S,S) :- get_time(T).
47wait(T,T) :- sleep_till(T).
48wait(Pre,T,T) :- T1 is T-Pre, sleep_till(T1).
54sleep_till(T) :-
55 get_time(T0), T@>T0, DT is T-T0, sleep(DT).
60sync --> now(T), set(T).
64adv(DT) --> trans(T1,T2), {T2 is T1+DT}.
68quant(Q) --> trans(T1,T2), {T2 is Q*ceil(T1/Q)}.
72cue(D) --> now(T), set(T), adv(D).
77cue(D,Q) --> now(T), set(T), adv(D), quant(Q).
78
79cue(D,Q,O) --> now(T), set(T), adv(D), quant(Q), adv(O).
80lag(L) --> now(T0), get(T), {L is T-T0}.
81
82
83%% run_cued( +DT:nonneg, +Q:nonneg, +Cmd:phrase((time,S)), ?S1:S, ?S2:S) is nondet.
84%% run_cued( +DT:nonneg, +Cmd:phrase((time,S)), ?S1:S, ?S2:S) is nondet.
85%% run_cued( +DT:nonneg, +Q:nonneg, +Cmd:phrase(time)) is nondet.
86%% run_cued( +DT:nonneg, +Cmd:phrase(time)) is nondet.
87%
88% Run command Cmd in DT seconds. Cmd must operate in (time,S) DCG and is called
89% with the current real time plus DT seconds. If Q is supplied, the time
90% passed to Cmd is quantised upwards in units of Q seconds.
91run_cued(DT,Cmd) --> run_left((\< cue(DT), call_dcg(Cmd)),_,_).
92run_cued(DT,Q,Cmd) --> run_left((\< cue(DT,Q), call_dcg(Cmd)),_,_).
93run_cued(DT,Cmd) :- call_dcg((cue(DT), call_dcg(Cmd)),_,_).
94run_cued(DT,Q,Cmd) :- call_dcg((cue(DT,Q), call_dcg(Cmd)),_,_)
Time DCG
Some of the predicates below are designed to operate in a DCG where the state represents a time as a number of seconds since a particular epoch (see get_time/1). The enables the write of code in a sort of temporal modal logic form, where predicates can implicitly get at the current time (using get//1) or move to other times by chaging the DCG state.
*/