[Back to TIMING SWAG index]  [Back to Main SWAG index]  [Original]

{ millisecond timer Unit }

Unit msecs;

Interface

Var
   timer:Word;                     { msec timer }
   idle:Procedure; {  you can change this to do something useful when Delaying}

Procedure Delay_ticks(t:Word);     { resume Until t clock ticks have elapsed }
Procedure start_clock;             { starts the 1 msec timer }
Procedure stop_clock;              { stops the 1 msec timer }

Implementation

Uses Dos;

Procedure Delay_ticks(t:Word);
begin
  inc(t,timer);
  Repeat idle Until Integer(timer - t) >= 0;
end;

Const clock_active:Boolean = False;
      one_msec = 1193;
Var   save_clock:Pointer;
      clocks:Word;

Procedure tick_int; Far; Assembler;
Asm
  push ax
  push ds
  mov ax,seg @data
  mov ds,ax
  mov al,$20
  out $20,al
  inc [timer]
  add [clocks],one_msec
  jnc @1
  pushf
  call [save_clock]
@1:
  pop ds
  pop ax
  iret
end;


Procedure start_clock;
begin
  if clock_active then Exit;
  inc(clock_active);
  timer := 0;
  clocks := 0;
  getintvec($08,save_clock);
  setintvec($08,@tick_int);
  port[$43] := $36;
  port[$40] := lo(one_msec);
  port[$40] := hi(one_msec);
end;

Procedure stop_clock;
begin
  if not clock_active then Exit;
  dec(clock_active);
  port[$43] := $36;
  port[$40] := 0;
  port[$40] := 0;
  setintvec($08,save_clock);
end;

Procedure nothing; Far;
begin
end;

Var saveexit:Pointer;

Procedure uninstall; Far;
begin
  Exitproc := saveexit;
  if clock_active then stop_clock;
end;

begin
  timer := 0;
  idle := nothing;
  saveexit := Exitproc;
  Exitproc := @uninstall;
end.

[Back to TIMING SWAG index]  [Back to Main SWAG index]  [Original]