home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 04 / scrtimer / scrtimer.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-01-25  |  4.3 KB  |  122 lines
  1. (* ----------------------------------------------------- *)
  2. (*                        SCRTIMER.PAS                   *)
  3. (*   Bildschirm nach n Sekunden löschen und bei Tasten-  *)
  4. (*                  druck wieder herstellen.             *)
  5. (* System: Turbo Pascal/MS-DOS                           *)
  6. (* Aufruf: SCRTIMER            Wartezeit ca. 4 Minuten   *)
  7. (*         SCRTIMER 1.5           "      ca. 1.5 Minuten *)
  8. (* ----------------------------------------------------- *)
  9.  
  10. PROGRAM ScrTimer;
  11.  
  12.   {$K-}        (* die Compiler-Optionen müssen unbedingt *)
  13.   {$U-}        (* wie hier gesetzt werden !!!!           *)
  14.   {$R-}
  15.   {$V-}
  16.   {$I-}
  17.   {$C-}
  18.  
  19.   {$I REGS8088.INC}   (* die Include-Dateien aus PASCAL  *)
  20.   {$I CRITICAL.INC}   (* 6/87, "Interrupts - oder warum  *)
  21.   {$I MAKEINT.INC}    (* die Milch in Ihrem Rechener..." *)
  22.  
  23. CONST
  24.   (* die benutzten Interrupt-Vektoren, zu finden eigent- *)
  25.   (* lich in MAKEINT.INC:                                *)
  26.   IntHardwareTimer     = $08;
  27.   IntHardwareKeyboard  = $09;
  28.   TimerOldInterrupt    : IntEntry_ = (Offset:0; Segment:0);
  29.   KeyBoardOldInterrupt : IntEntry_ = (Offset:0; Segment:0);
  30.   Count     : INTEGER = 0;
  31.   Warte     : BOOLEAN = FALSE;
  32.   gedrueckt : BOOLEAN = FALSE;
  33.  
  34. TYPE
  35.   ScrBuff = ARRAY[0..16383] OF BYTE;
  36.  
  37. VAR
  38.   ColorScreen : ScrBuff ABSOLUTE $B800:0000;
  39.   MonoScreen  : ScrBuff ABSOLUTE $B000:0000;
  40.   Video       : BYTE    ABSOLUTE $0040:$0049;
  41.   Screen      : ^ScrBuff;
  42.   OldScreen   : ARRAY[0..16383] OF BYTE;
  43.   Dauer       : REAL;
  44.   error       : INTEGER;
  45.  
  46. (* ----------------------------------------------------- *)
  47. (* neue Tastatur-Interrupt-Routine - setzt lediglich das *)
  48. (* Flag "gedrueckt" und geht weiter zur Original-Routine *)
  49.  
  50.   PROCEDURE KeyBoardInterrupt;
  51.  
  52.   {$I BEGININT.INC}
  53.     gedrueckt := TRUE;
  54.     {$I EXITINT.INC}
  55.        KeyBoardOldInterrupt);
  56.   END;
  57.  
  58. (* ----------------------------------------------------- *)
  59. (* neue Timer-Interrupt-Routine. Wird 18 mal in der Se-  *)
  60. (* kunde ausgeführt und bildet das Herz des Ganzen.      *)
  61. (* "Warte" zeigt an, ob der Bildschirm schon gelöscht    *)
  62. (* ist und nun auf eine Taste zur Wiederherstellung des- *)
  63. (* selben gewartet wird. Ist "Warte" FALSE, wird ent-    *)
  64. (* weder der Zeitzähler erhöht und bei überschreiten der *)
  65. (* Wartezeit der Bildschirm gelöscht oder, wenn eine     *)
  66. (* Taste gedrückt wurde, der Zeitzähler zurückgesetzt.   *)
  67.  
  68.   PROCEDURE TimerInterrupt;
  69.  
  70.   {$I BEGININT.INC}
  71.     CASE Warte OF
  72.       FALSE : BEGIN
  73.                 IF NOT gedrueckt THEN
  74.                   Count := Succ(Count)
  75.                 ELSE BEGIN
  76.                   gedrueckt := FALSE; Count := 0;
  77.                 END;
  78.                 IF Count > Dauer THEN BEGIN
  79.                   Move (Screen^,OldScreen,SizeOf(ScrBuff));
  80.                   FillChar(Screen^,SizeOf(ScrBuff),0);
  81.                   Warte := TRUE;
  82.                 END;
  83.               END;
  84.       TRUE  : IF gedrueckt THEN BEGIN
  85.                 Move (OldScreen,Screen^,SizeOf(ScrBuff));
  86.                 Count := 0;
  87.                 gedrueckt := FALSE;
  88.                 Warte := FALSE;
  89.               END;
  90.     END; { case }
  91.     {$I EXITINT.INC}
  92.        TimerOldInterrupt);
  93.     END;
  94.  
  95. (* ----------------------------------------------------- *)
  96.  
  97. BEGIN
  98.   IF Video = 7 THEN              { Monochrom-Bildschirm ? }
  99.     Screen := Ptr(Seg(MonoScreen),OFs(MonoScreen))
  100.   ELSE
  101.     Screen := Ptr(Seg(ColorScreen),OFs(ColorScreen));
  102.   Dauer := 4400.0;   { c.a. 4 Min. warten, Voreinstellung }
  103.   IF ParamCount > 0 THEN BEGIN      (* neue Warte-Zeit ? *)
  104.     Val(Paramstr(1),Dauer,error);
  105.     IF error = 0 THEN
  106.       Dauer := Dauer*60*18 { da die Proz. "TimerInterupt" }
  107.                            { 18 mal in der Sekunde auf-   }
  108.                            { gerufen wird !               }
  109.     ELSE
  110.       Dauer := 4400.0;  (* Fehler, wieder Voreinstellung *)
  111.     IF Dauer > MaxInt THEN Dauer := MaxInt-1;
  112.   END;
  113.   WITH TimerOldInterrupt DO  (* die Interrupts verbiegen *)
  114.     IntGet (IntHardwareTimer,Segment, Offset);
  115.   IntSet (IntHardwareTimer, Cseg, OFs(TimerInterrupt));
  116.   WITH KeyBoardOldInterrupt DO
  117.     IntGet (IntHardwareKeyBoard,Segment, Offset);
  118.   IntSet (IntHardwareKeyBoard,Cseg,OFs(KeyBoardInterrupt));
  119.   WriteLn; WriteLn('SCRTIMER resident...'); WriteLn;
  120.   MakeResident;      (* Programm beenden u. aktiv lassen *)
  121. END.
  122.