Category : Pascal Source Code
Archive   : INTCLK.ZIP
Filename : INTCLOCK.PAS
{$O-} {Never overlay a unit with an Interrupt Service Routine!}
{$S-} {stack-checking off}
{$R-} {range-checking off}
{$V-} {var-param checking off}
(***************************************************************************>
INTCLOCK.PAS
Interrupt-driven clock/timer/ticker services for TurboPascal 4.0-5.5
Ver. 2.1c
Copyright 1987,1989 Steve Sneed
Hereby released to the public domain, 11/19/89 Steve Sneed
LEGEND: You may use this code in any program for personal use or public
release, including commercial or "shareware" programs. This copy originally
provided to TurboPower Software without license or fee, for their use and/or
release.
WHAT IT IS: IntClock provides both an interrupt-driven display clock and
two types of timers. Timers are either "Tickers" (LongInt vars incremented
at each system timer tick and used to guage passing ticks or seconds) or
"Timers" (String vars incremented every whole second and used as a clock time
counter, following clock time display conventions.) Tickers are most commonly
used for timing relatively short-duration events or in wait_for_timeout cases:
{example}
ResetTicker(1);
REPEAT
{do something...}
UNTIL ElapsedSeconds(1) < 10;
while timers are most often used for duration display (example: a display of
how long a communications program has been connected) or where you need to
wait until a certain time-of-day to execute a program or program part:
{example}
{...}
InitTimer(1,True,1,1,$07);
while TimerReport(1) <> '21:00:00' do {something};
{...}
Display of the clock and each display timer is fully controllable. Timers
can be started either from the current clock time or from '00:00:00'.
A procedure pointer is provided to call an external procedure on each timer
tick; however, some ground rules are in order:
1) the procedure *must* follow re-entrancy guidelines just like any other
ISR - in other words, no DOS calls, keep it small and fast, etc.
2) the procedure *must* be declared using the FAR model (under the {$F+}
directive) - failing to do so will lead directly to hyperspace at Warp IX.
3) see page 6-16 of the TurboPower Software "Turbo Professional Library"
manual for the nessessary calling conventions on any TimerEvent procedure.
4) the default alternate stack size is 512 bytes. This value fit the need
I had at the time I added the capability to the code, but it is probably
insufficent if your TimerEvent does any string manipulation or otherwise
pushes vars of any size onto the stack. Juggle the "ClockStack" constant
value as nessessary to fit your called TimerEvent. Remember to allow for
the alternate stack's allocation in your program's {$M} directive's min/max
heap values.
VERSION HISTORY:
1.0 - Original version. Used only TP4 services.
1.1 - Added ticker code based on some by N. Arley Dealy (thanks, Arley!)
2.0 - Converted to use TPro "TpInt" services for greater reliability, and
use the "TpDate" unit for raw clock time & time strings.
2.1 - Added "TimerEvent" procedure call, modified so unit "starts the clock"
during program init.
I hope you find the code useful.
Steve Sneed - Ozarks West Software
CIS 70007,3574
>***************************************************************************)
UNIT IntClock;
{interrupt-driven clock/timer/ticker routines}
(*************************************************************************)
INTERFACE
(*************************************************************************)
USES DOS, TpCrt, TpInt, TpDate;
VAR
TimerEvent : Pointer;
PROCEDURE InitClock(X,Y,Attr : Byte);
{-start clock/timer/ticker processing, provide screen addr/attr for clock}
PROCEDURE KillClock;
{-stop clock/timer/ticker processing}
PROCEDURE ResetClock;
{-reset clock time}
PROCEDURE InitTimer(Num : integer; UseCurrTime : boolean; X,Y,Attr : Byte);
{-initialize a timer}
PROCEDURE KillTimer(Num : integer; Era : Boolean);
{-disable a timer}
PROCEDURE StartTimer(Num : integer);
{-restart an initialized but stopped timer}
FUNCTION TimerReport(Num : integer) : string;
{-retrieve the display string from a timer}
PROCEDURE EndTimer(Num : integer);
{-stop timer display but leave running}
PROCEDURE ResetTicker(Num : Integer);
{-reset a ticker to 0}
FUNCTION ElapsedTicks(Num : Integer) : LongInt;
{-returns total system clock ticks (18.2 per sec) since last reset}
FUNCTION ElapsedSeconds(Num : Integer) : LongInt;
{-returns total elapsed seconds since last reset}
PROCEDURE ClockColor(Attr : Byte);
{-change the clock's display attribute}
PROCEDURE ClockAddr(X,Y : Byte);
{-change the clock's display location}
PROCEDURE TimerColor(Num : Integer; Attr : Byte);
{-change a timer's display attribute}
PROCEDURE TimerAddr(Num : Integer; X,Y : Byte);
{-change a timer's display location}
PROCEDURE ShowClocks;
{-turn on clock display}
PROCEDURE HideClocks;
{-turn off clock display}
PROCEDURE ShowTimers;
{-turn on timers display}
PROCEDURE HideTimers;
{-turn off timers display}
(*************************************************************************)
IMPLEMENTATION
(*************************************************************************)
TYPE
ClockRec = record
InUse : Boolean;
Ticker : integer;
CX,CY,A : Byte;
CTime : String[9];
END;
CONST
ClockHandle = 20;
ShowClocksF : boolean = FALSE;
ShowTimersF : Boolean = FALSE;
ClockStackSize : Word = 512; { change to fit your needs }
VAR
Clocks : array[0..3] of ClockRec;
Ticker : Array[1..3] of LongInt;
ClockInUse : boolean;
ExitClock : pointer;
ClockStack : pointer;
{-------------------------------------------------------------------------}
{------------------------ Internal Functions & ISR -----------------------}
{-------------------------------------------------------------------------}
PROCEDURE ClockExit;
BEGIN
ExitProc := ExitClock;
ShowClocksF := false;
ShowTimersF := false;
if ClockInUse then
RestoreVector(ClockHandle);
END;
PROCEDURE DisplayClock(VAR Regs : IntRegisters);
BEGIN
if ShowClocksF then with Clocks[0] do
FastWrite(CTime,CY,CX,A);
IntReturn(Regs);
END;
PROCEDURE DisplayTimer(N : Integer);
BEGIN
if ShowTimersF then with Clocks[N] do
FastWrite(CTime,CY,CX,A);
END;
PROCEDURE UpdateClockString(VAR CT : String);
BEGIN
Inc(CT[8]);
if CT[8] > '9' then
BEGIN
CT[8] := '0';
Inc(CT[7]);
if CT[7] > '5' then
BEGIN
CT[7] := '0';
Inc(CT[5]);
if CT[5] > '9' then
BEGIN
CT[5] := '0';
Inc(CT[4]);
if CT[4] > '5' then
BEGIN
CT[4] := '0';
Inc(CT[2]);
if CT[2] > '9' then
BEGIN
CT[2] := '0';
Inc(CT[1]);
END;
if (CT[1] = '2') and (CT[2] >= '4') then CT := '00:00:00';
END;
END;
END;
END;
END;
PROCEDURE ClockInt(BP : word); interrupt;
var Regs : IntRegisters ABSOLUTE BP;
I : Integer;
BEGIN
{ chain to original ISR }
EmulateInt(Regs,ISR_Array[ClockHandle].OrigAddr);
{ call any specified event }
SwapStackAndCall(TimerEvent,ClockStack,Regs);
for I := 1 to 3 do
BEGIN
{ update ticker counts }
Inc(Ticker[i]);
{ update timers }
with Clocks[i] do if InUse then
BEGIN
Inc(Ticker,247); {expand divisor for greater accuracy}
if Ticker >= 4495 then
BEGIN
Dec(Ticker,4495);
UpdateClockString(CTime);
DisplayTimer(i);
END;
END;
END;
{ update main clock }
with Clocks[0] do
BEGIN
Inc(Ticker,247);
if Ticker >= 4495 then
BEGIN
Dec(Ticker,4495);
UpdateClockString(CTime);
DisplayClock(Regs);
END;
END;
END;
{-------------------------------------------------------------------------}
{------------------------ Exported Clock Functions -----------------------}
{-------------------------------------------------------------------------}
PROCEDURE InitClock(X,Y,Attr : Byte);
BEGIN
InterruptsOff;
ShowClocksF := FALSE; { start off with displays turned off }
ShowTimersF := FALSE;
with Clocks[0] do { init clock vars }
BEGIN
CX := X; CY := Y; A := Attr;
Ticker := 0;
CTime := TimeToTimeString('hh:mm:ss',CurrentTime);
if (X <> 0) and (Y <> 0) then FastWrite(CTime,CY,CX,A);
END;
if NOT ClockInUse then
BEGIN
{ allocate alternate stack for TimerProc }
if NOT AllocateStack(ClockStack,ClockStackSize) then
BEGIN
WriteLn('Error allocating clock stack - aborting');
Halt(1);
END;
{ set up exit handler }
ExitClock := ExitProc;
ExitProc := @ClockExit;
{ set up the ISR }
ClockInUse := InitVector($1C,ClockHandle,@ClockInt); {install ISR}
END;
InterruptsOn;
END;
PROCEDURE KillClock;
BEGIN
if ClockInUse then
BEGIN
DeallocateStack(ClockStack);
RestoreVector(ClockHandle);
ExitProc := ExitClock;
ClockInUse := FALSE;
END;
END;
PROCEDURE ResetClock;
VAR S : String[9];
BEGIN
S := TimeToTimeString('hh:mm:ss',CurrentTime);
InterruptsOff;
Clocks[0].CTime := S;
InterruptsOn;
END;
{-------------------------------------------------------------------------}
{------------------------ Display Timer FUNCTIONs ------------------------}
{-------------------------------------------------------------------------}
PROCEDURE InitTimer(Num : integer; UseCurrTime : boolean; X,Y,Attr : Byte);
BEGIN
if NOT ClockInUse then exit;
with Clocks[Num] do
BEGIN
CX := X;
CY := Y;
A := Attr;
Ticker := 0;
if UseCurrTime then
CTime := TimeToTimeString('hh:mm:ss',CurrentTime)
else
CTime := '00:00:00';
InUse := true;
END;
END;
PROCEDURE KillTimer(Num : integer; Era : Boolean);
BEGIN
with Clocks[Num] do
BEGIN
InUse := false;
if Era then
FastWrite(' ',CY,CX,A);
END;
END;
PROCEDURE StartTimer(Num : integer);
BEGIN
Clocks[Num].InUse := true;
END;
PROCEDURE EndTimer(Num : integer);
BEGIN
Clocks[Num].InUse := false;
END;
FUNCTION TimerReport(Num : integer) : string;
BEGIN
TimerReport := Clocks[Num].CTime;
END;
{-------------------------------------------------------------------------}
{----------------------- Exported Ticker Functions -----------------------}
{-------------------------------------------------------------------------}
PROCEDURE ResetTicker(Num : Integer);
BEGIN
InterruptsOff;
Ticker[Num] := 0;
InterruptsOn;
END;
FUNCTION ElapsedTicks(Num : Integer) : LongInt;
BEGIN
InterruptsOff;
ElapsedTicks := Ticker[Num];
InterruptsOn;
END;
FUNCTION ElapsedSeconds(Num : Integer) : LongInt;
VAR L : LongInt;
BEGIN
L := ElapsedTicks(Num);
ElapsedSeconds := Trunc((L * 1.0) / 18.2333);
END;
{-------------------------------------------------------------------------}
{------------------------ Exported Misc. Functions -----------------------}
{-------------------------------------------------------------------------}
PROCEDURE ClockColor(Attr : Byte);
BEGIN
Clocks[0].A := Attr;
END;
PROCEDURE ClockAddr(X,Y : Byte);
BEGIN
with Clocks[0] do
BEGIN
CX := X;
CY := Y;
END;
END;
PROCEDURE TimerColor(Num : Integer; Attr : Byte);
BEGIN
Clocks[Num].A := Attr;
END;
PROCEDURE TimerAddr(Num : Integer; X,Y : Byte);
BEGIN
with Clocks[Num] do
BEGIN
CX := X;
CY := Y;
END;
END;
PROCEDURE ShowClocks;
BEGIN
ShowClocksF := TRUE;
END;
PROCEDURE HideClocks;
BEGIN
ShowClocksF := FALSE;
END;
PROCEDURE ShowTimers;
BEGIN
ShowTimersF := TRUE;
END;
PROCEDURE HideTimers;
BEGIN
ShowTimersF := FALSE;
END;
PROCEDURE NullTimerEvent(VAR Regs : IntRegisters);
BEGIN
{do-nothing procedure}
END;
BEGIN
FillChar(Ticker,SizeOf(Ticker),0);
FillChar(Clocks,SizeOf(Clocks),0);
TimerEvent := @NullTimerEvent;
ClockInUse := FALSE;
InitClock(0,0,$07);
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/