1 program simpletimer;
2
3
4 uses exec, timer, amigados, amigalib;
5
6
7
8 { manifest constants -- 'never will change' }
9 const
10 SECSPERMIN = (60);
11 SECSPERHOUR = (60*60);
12 SECSPERDAY = (60*60*24);
13
14 var
15 seconds : longint;
16 tr : ptimerequest; { IO block for timer commands }
17 oldtimeval : ttimeval; { timevals to store times }
18 mytimeval : ttimeval;
19 currentval : ttimeval;
20
Create_Timernull21 Function Create_Timer(theUnit : longint) : pTimeRequest;
22 var
23 Error : longint;
24 TimerPort : pMsgPort;
25 TimeReq : pTimeRequest;
26 begin
27 TimerPort := CreatePort(Nil, 0);
28 if TimerPort = Nil then
29 Create_Timer := Nil;
30 TimeReq := pTimeRequest(CreateExtIO(TimerPort,sizeof(tTimeRequest)));
31 if TimeReq = Nil then begin
32 DeletePort(TimerPort);
33 Create_Timer := Nil;
34 end;
35 Error := OpenDevice(TIMERNAME, theUnit, pIORequest(TimeReq), 0);
36 if Error <> 0 then begin
37 DeleteExtIO(pIORequest(TimeReq));
38 DeletePort(TimerPort);
39 Create_Timer := Nil;
40 end;
41 TimerBase := pointer(TimeReq^.tr_Node.io_Device);
42 Create_Timer := pTimeRequest(TimeReq);
43 end;
44
45 Procedure Delete_Timer(WhichTimer : pTimeRequest);
46 var
47 WhichPort : pMsgPort;
48 begin
49
50 WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort;
51 if assigned(WhichTimer) then begin
52 CloseDevice(pIORequest(WhichTimer));
53 DeleteExtIO(pIORequest(WhichTimer));
54 end;
55 if assigned(WhichPort) then
56 DeletePort(WhichPort);
57 end;
58
59 procedure wait_for_timer(tr : ptimerequest; tv : ptimeval);
60 begin
61 tr^.tr_node.io_Command := TR_ADDREQUEST; { add a new timer request }
62
63 { structure assignment }
64 tr^.tr_time.tv_secs := tv^.tv_secs;
65 tr^.tr_time.tv_micro := tv^.tv_micro;
66
67 { post request to the timer -- will go to sleep till done }
68 DoIO(pIORequest(tr));
69 end;
70
71 { more precise timer than AmigaDOS Delay() }
time_delaynull72 function time_delay(tv : ptimeval; theunit : longint): longint;
73 var
74 tr : ptimerequest;
75 begin
76 { get a pointer to an initialized timer request block }
77 tr := create_timer(theunit);
78
79 { any nonzero return says timedelay routine didn't work. }
80 if tr = NIL then time_delay := -1;
81
82 wait_for_timer(tr, tv);
83
84 { deallocate temporary structures }
85 delete_timer(tr);
86 time_delay := 0;
87 end;
88
set_new_timenull89 function set_new_time(secs : longint): longint;
90 var
91 tr : ptimerequest;
92 begin
93 tr := create_timer(UNIT_MICROHZ);
94
95 { non zero return says error }
96 if tr = nil then set_new_time := -1;
97
98 tr^.tr_time.tv_secs := secs;
99 tr^.tr_time.tv_micro := 0;
100 tr^.tr_node.io_Command := TR_SETSYSTIME;
101 DoIO(pIORequest(tr));
102
103 delete_timer(tr);
104 set_new_time := 0;
105 end;
106
get_sys_timenull107 function get_sys_time(tv : ptimeval): longint;
108 var
109 tr : ptimerequest;
110 begin
111 tr := create_timer( UNIT_MICROHZ );
112
113 { non zero return says error }
114 if tr = nil then get_sys_time := -1;
115
116 tr^.tr_node.io_Command := TR_GETSYSTIME;
117 DoIO(pIORequest(tr));
118
119 { structure assignment }
120 tv^ := tr^.tr_time;
121
122 delete_timer(tr);
123 get_sys_time := 0;
124 end;
125
126
127
128
129 procedure show_time(secs : longint);
130 var
131 days,hrs,mins : longint;
132 begin
133 { Compute days, hours, etc. }
134 mins := secs div 60;
135 hrs := mins div 60;
136 days := hrs div 24;
137 secs := secs mod 60;
138 mins := mins mod 60;
139 hrs := hrs mod 24;
140
141 { Display the time }
142 writeln('* Hour Minute Second (Days since Jan.1,1978)');
143 writeln('* ', hrs, ': ',mins,': ', secs,' ( ',days, ' )');
144 writeln;
145 end;
146
147
148 begin
149 writeln('Timer test');
150
151 { sleep for two seconds }
152 currentval.tv_secs := 2;
153 currentval.tv_micro := 0;
154 time_delay(@currentval, UNIT_VBLANK);
155 writeln('After 2 seconds delay');
156
157 { sleep for four seconds }
158 currentval.tv_secs := 4;
159 currentval.tv_micro := 0;
160 time_delay(@currentval, UNIT_VBLANK);
161 writeln('After 4 seconds delay');
162
163 { sleep for 500,000 micro-seconds = 1/2 second }
164 currentval.tv_secs := 0;
165 currentval.tv_micro := 500000;
166 time_delay(@currentval, UNIT_MICROHZ);
167 writeln('After 1/2 second delay');
168
169 writeln('DOS Date command shows: ');
170 Execute('date', 0, 0);
171
172 { save what system thinks is the time....we'll advance it temporarily }
173 get_sys_time(@oldtimeval);
174 writeln('Original system time is:');
175 show_time(oldtimeval.tv_secs );
176
177 writeln('Setting a new system time');
178
179 seconds := 1000 * SECSPERDAY + oldtimeval.tv_secs;
180
181 set_new_time( seconds );
182 { (if user executes the AmigaDOS DATE command now, he will}
183 { see that the time has advanced something over 1000 days }
184
185 write('DOS Date command now shows: ');
186 Execute('date', 0, 0);
187
188 get_sys_time(@mytimeval);
189 writeln('Current system time is:');
190 show_time(mytimeval.tv_secs);
191
192 { Added the microseconds part to show that time keeps }
193 { increasing even though you ask many times in a row }
194
195 writeln('Now do three TR_GETSYSTIMEs in a row (notice how the microseconds increase)');
196 writeln;
197 get_sys_time(@mytimeval);
198 writeln('First TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro);
199 get_sys_time(@mytimeval);
200 writeln('Second TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro);
201 get_sys_time(@mytimeval);
202 writeln('Third TR_GETSYSTIME ',mytimeval.tv_secs,'.', mytimeval.tv_micro);
203 writeln;
204 writeln('Resetting to former time');
205 set_new_time(oldtimeval.tv_secs);
206
207 get_sys_time(@mytimeval);
208 writeln('Current system time is:');
209 show_time(mytimeval.tv_secs);
210
211 end.
212