Category : Files from Magazines
Archive   : TSR.ZIP
Filename : CLKDEM.420

{------------------------------------------------------------------}
{ C L O C K D E M O }
{------------------------------------------------------------------}
(* file CLOCKDEM.414

TO convert your stayres demo to a TIMER,
a) comment out the line "Procedure Get_File"
b) replace STAYDEM.400 with CLOCKDEM.400
c) just before the $I STAYI8.OBJ, insert the line "{$I clock_I8.inl}"

13-Jun-86 12:11 PDT
Sb: CLOCKDEM.400
Fm: Neil J. Rubenking [72267,1531]
To: 70357,2716

*)

VAR
hiclock : Integer ABSOLUTE $40 : $6E; {High Word of Bios Timer Count}
Loclock : Integer ABSOLUTE $40 : $6C; {Low Wrod of Bios Timer Count}
const
timer_hi : integer = 0;
timer_lo : integer = 0;
timer_message : string[80] = '';
timer_on = 4; { The Demo timer is active (running) }
from_timer = 8; { The Demo timer has finished (posted)}

function get_integer(MAX : integer) : integer;
VAR CH : char;
temp : real;
BEGIN
temp := 0;
repeat
repeat read(Kbd,CH) until CH in ['0'..'9',#8,#13];
case CH of
#8 : IF temp > 0 THEN
BEGIN
temp := INT(temp/10);
write(#8,' ',#8);
END;
#13:;
ELSE
temp := temp * 10 + ord(CH) - ord('0');
IF temp > MAX THEN
BEGIN
write(#7);
temp := INT(temp/10);
END
ELSE write(CH);
END; {case}
until CH = #13;
get_integer := trunc(temp);
END;

procedure BeBeep;
VAR N : byte;
BEGIN
nosound;
FOR N := 1 to 3 do
BEGIN
sound(800); delay(50);
sound(400); delay(50);
END;
nosound;
END;


procedure Clock_Demo;
CONST
ampm : ARRAY[0..1] OF STRING[2] = ('am', 'pm');

VAR
tics, HiWord, LoWord : Real;
hours, mins, secs : STRING[2];
time : STRING[10];
am_or_pm : Integer;
timer_time : Integer;
countDown : Integer;

{-------------------------------------------------------------}
{ D o u b l e to R e a l number conversion }
{-------------------------------------------------------------}
function double_to_real(I,J : integer):real;
var temp : real;
BEGIN
temp := I; IF temp < 0 THEN temp := temp + 65536.0;
temp := temp * 65536.0;
IF J < 0 THEN temp := temp + 65536.0 + J ELSE temp := temp + J;
double_to_real := temp;
END;

{-------------------------------------------------------------}
{ R e a l t o D o u b l e number conversion }
{-------------------------------------------------------------}
procedure Real_to_double(R : real; VAR I, J : integer);
var It, Jt : real;
BEGIN
It := Int(R/65536.0);
Jt := R - It*65536.0;
IF It > MaxInt THEN I := trunc(It - 65536.0) ELSE I := trunc(It);
IF Jt > MaxInt THEN J := trunc(Jt - 65536.0) ELSE J := trunc(Jt);
END;

{-------------------------------------------------------------}
{ S e t T i m e Turn timer on }
{-------------------------------------------------------------}
PROCEDURE Set_Timer(the_time : integer);
BEGIN
tics := double_to_real(HiClock, LoClock);
tics := tics + 60*the_time*18.206481934;
real_to_double(tics, timer_hi, timer_lo);
Status := status or Timer_On;

END;

begin
While Keypressed DO read(Kbd,KeyChr); {clear any waiting keys}
GotoXY(1,1);
tics := double_to_real(HiClock, LoClock) /18.206481934; {current timer tics}
Str(Trunc(tics/3600.0) MOD 12, hours); {Get Hour of Day }
am_or_pm := Trunc(tics/3600.0); {pm if > 12 }
IF hours = '0' THEN hours := '12'; {adjust for noon }
IF hours[0] = #1 THEN hours := '0'+hours; {right justify hours}
Str(Trunc(tics/60.0) MOD 60, mins); {Get minutes in hour}
IF mins[0] = #1 THEN mins := '0'+mins; {Right justify minutes}
Str(Trunc(tics-Int(tics/60)*60), secs); {Get partial minutes}
IF secs[0] = #1 THEN secs := '0'+secs; {Right justify seconds}
time := hours+':'+mins+':'+secs {concatenate all elements}
+ampm[am_or_pm DIV 12]; {get index to ampm array }
WriteLn('THE CURRENT TIME is ',time); {What time is it Prez ? }

IF (status AND timer_on) = timer_on THEN {If our timer is ticking ..}
BEGIN
IF (status AND from_timer) = from_timer THEN {and the timer has finished..}
BEGIN {then clear the timer request }
status := status and not (timer_on + from_timer);
bebeep; {Beep the user and pass the msg}
writeLn(timer_message);
END
ELSE {If timer is active but not finished ..}
BEGIN {then the user the time. }
tics := double_to_real(timer_Hi, timer_Lo) -
double_to_real(HiClock, LoClock);
tics := tics / 18.206481934;
Str(Trunc(tics/60.0) MOD 60, mins);
IF mins[0] = #1 THEN mins := '0'+mins;
Str(Trunc(tics-Int(tics/60)*60), secs);
IF secs[0] = #1 THEN secs := '0'+secs;
WriteLn(mins,':',secs,' to go on timer.');
END;
END
ELSE {If timer is not active then get info }
BEGIN {to set it running }
Write('How many minutes should timer run (0..60)? : ');
timer_time := Get_Integer(60);writeLn;
IF timer_time > 0 THEN
BEGIN
write('MESSAGE: ');
ReadLn(Timer_Message);
set_timer(timer_time);
END;
END;

Get_Abs_Cursor(x,y); { Get Absolute Cursor Position }
MkWin(x,y,x+16,y+1,Cyan,Black,0); { Put Window at Cursor }
GotoXY(1,1);
Write('Press a key ...'); { Wait for user key or time out period }
countDown := 10000;
repeat
countDown := countDown - 1;
until (CountDown = 0) or keypressed;
IF countDOwn = 0 THEN set_timer(1); { If no user input, set one minute timer}
KeyChr := #0; { Clear any residual key code }
While Keypressed do { Get terminate key maybe }
Keychr := Keyin; { Read the users Key }
If Keychr = Quit_key then Terminate := true;
RmWin ; { Remove "press a key" Window }
end;

{----------------------------------------------------------------------}
{ D E M O }
{----------------------------------------------------------------------}
Procedure Demo ; { Give Demonstration of Code }

begin
KeyChr := #0; { Clear any residual krap }
MkWin(5,5,75,11,Bright+Cyan,Black,3); { Make a Biiiiiiig window}
Clrscr; { Clear screen out }
Clock_Demo; { Set the clock }
RmWin; { Remove the big window }
end; { Demo }