home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / rtclock / timer.pas < prev   
Pascal/Delphi Source File  |  1995-07-28  |  3KB  |  143 lines
  1. program test_timer;
  2.  
  3. uses crt,dos;
  4.  
  5. Var OTimerInt    : pointer;
  6.     Timerfreq    : word;
  7.     Orig_freq    : word;
  8.     Sync_counter : word;
  9.     Ticounter    : word;
  10.  
  11. procedure SetColor (Nr, R, G, B : BYTE);
  12. begin;
  13.   asm
  14.     mov   al,Nr
  15.     mov   dx,03C8h
  16.     out   dx,al
  17.     mov   dx,03C9h
  18.     mov   al,r
  19.     out   dx,al
  20.     mov   al,g
  21.     out   dx,al
  22.     mov   al,b
  23.     out   dx,al
  24.   end;
  25. end;
  26.  
  27. procedure waitretrace;
  28. begin;
  29.   asm
  30.     MOV   DX,03dAh
  31. @WD_R:
  32.     IN    AL,DX
  33.     TEST  AL,8d
  34.     JZ    @WD_R
  35. @WD_D:
  36.     IN    AL,DX
  37.     TEST  AL,8d
  38.     JNZ   @WD_D
  39.   end;
  40. end;
  41.  
  42. procedure SetTimerOn(Proc : pointer; Freq : word);
  43. var icounter : word;
  44.     oldv : pointer;
  45. begin;
  46.  asm cli end;
  47.  icounter  := 1193180 DIV Freq;
  48.  Port[$43] := $36;
  49.  Port[$40] := Lo(ICounter);
  50.  Port[$40] := Hi(ICounter);
  51.  
  52.  Getintvec(8,OTimerInt);
  53.  SetIntVec(8,Proc);
  54.  asm sti end;
  55. end;
  56.  
  57. procedure New_Timerfreq(Freq : word);
  58. var icounter : word;
  59. begin;
  60.  asm cli end;
  61.  icounter  := 1193180 DIV Freq;
  62.  Port[$43] := $36;
  63.  Port[$40] := Lo(ICounter);
  64.  Port[$40] := Hi(ICounter);
  65.  asm sti end;
  66. end;
  67.  
  68. procedure SetTimerOff;
  69. var oldv : pointer;
  70. begin;
  71.   asm cli end;
  72.   port[$43] := $36;
  73.   Port[$40] := 0;
  74.   Port[$40] := 0;
  75.   SetIntVec(8,OTimerInt);
  76.   asm sti end;
  77. end;
  78.  
  79. procedure Syncro_interrupt; interrupt;
  80. begin;
  81.   inc(Sync_counter);
  82.   port[$20] := $20;
  83. end;
  84.  
  85. procedure Syncronize_timer;
  86. begin;
  87.   Timerfreq := 120;
  88.   SetTimerOn(@Syncro_interrupt,Timerfreq);
  89.   Repeat
  90.     dec(Timerfreq,2);
  91.     waitretrace;
  92.     New_timerfreq(Timerfreq);
  93.     Sync_counter := 0;
  94.     waitretrace;
  95.   until (Sync_counter = 0);
  96. end;
  97.  
  98. procedure Timer_Handling;
  99. begin;
  100.   setcolor(0,0,63,0);
  101. end;
  102.  
  103. procedure Timer_Proc; interrupt;
  104. begin;
  105.   Timer_Handling;
  106.   waitretrace;
  107.   Port[$43] := $34;                     { Mono - Flop  mode }
  108.   Port[$40] := Lo(TiCounter);
  109.   Port[$40] := Hi(TiCounter);
  110.  
  111.   setcolor(0,63,0,0);
  112.  
  113.   port[$20] := $20;
  114. end;
  115.  
  116. procedure Start_Syncrotimer(Proc : pointer);
  117. var calcl : longint;
  118. begin;
  119.  asm cli end;
  120.   port[$43] := $36;
  121.   Port[$40] := 0;
  122.   Port[$40] := 0;
  123.  
  124.   Ticounter := 1193180 DIV (Timerfreq+5);
  125.   setintvec(8,Proc);
  126.   waitretrace;
  127.   Port[$43] := $34;                     { Mono - Flop  mode }
  128.   Port[$40] := Lo(TiCounter);
  129.   Port[$40] := Hi(TiCounter);
  130.  asm sti end;
  131. end;
  132.  
  133. begin;
  134.   clrscr;
  135.   Syncronize_Timer;
  136.   writeln('The timer frequency is : ',Timerfreq);
  137.   Start_Syncrotimer(@Timer_Proc);
  138.   repeat until keypressed;
  139.   while keypressed do readkey;
  140.   SetTimerOff;
  141.   setcolor(0,0,0,0);
  142. end.
  143.