home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 12 / dc / dcpsptos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-21  |  4.0 KB  |  92 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                               DCPSPTOS.PAS                              *)
  3. (*     Maschinen-/Compilerabhaengiger Teil des didaktischen Computers      *)
  4. (*                     Version: Pascal ST +  & Atari ST                    *)
  5. (* Die Prozeduren "RevOn", "RevOff", "CrsOn" und "CrsOff" koennen bei an-  *)
  6. (* deren Rechnern z.B. durch die entspr. Escape-Sequenzen realisiert wer-  *)
  7. (* den. Gleiches gilt fuer "GotoXY".                                       *)
  8.  
  9. PROCEDURE ClrScr;  BEGIN  Write(esc, 'E');  END;
  10.  
  11. PROCEDURE GotoXY (x,y: INTEGER);
  12. BEGIN  Write(esc, 'Y', Chr(31+y), Chr(31+x));  END;
  13.  
  14. PROCEDURE RevOn;                   (* reverse (inverse) Textdarstellung an *)
  15. BEGIN  Write(esc, 'p');  END;
  16.  
  17. PROCEDURE RevOff;                 (* reverse (inverse) Textdarsetllung aus *)
  18. BEGIN  Write(esc, 'q');  END;
  19.  
  20. PROCEDURE CrsOn;                                     (* Cursor einschalten *)
  21. BEGIN  Write(esc, 'e');  END;
  22.  
  23. PROCEDURE CrsOff;                                    (* Cursor ausschalten *)
  24. BEGIN  Write(esc, 'f');  END;
  25.  
  26. PROCEDURE Bell;                           (* einen Piepser ertoenen lassen *)
  27. BEGIN  Write(Chr(7));  END;
  28.  
  29. PROCEDURE Exit_DC;  (* alles wieder beim alten, wenn Programm beendet wird *)
  30. BEGIN  ClrScr;  GotoXY(1,1);  RevOff;  CrsOn;  END;
  31.  
  32. FUNCTION ReadKeyboard: CHAR; (* von der Tastatur ohne Bildschirmecho lesen *)
  33. VAR  ch: CHAR;  Kbd: TEXT;
  34. BEGIN  ReSet(Kbd, 'CON:');  Read(Kbd, ch);  ReadKeyboard := ch;  END;
  35.  
  36. FUNCTION KeyEntered: BOOLEAN;              (* wurde eine Taste gedrueckt ? *)
  37. BEGIN  KeyEntered := KeyPress;  END;
  38.  
  39. (* eine Datei zum Lesen oeffnen. Die I/O-Ueberwachung durch das Laufzeit-  *)
  40. (* system wird dazu kurzzeitig deaktiviert (I- bzw. I+). Konnte die Datei  *)
  41. (* geoeffnet werden, ist "Open_File" = TRUE, sonst FALSE.                  *)
  42. FUNCTION Open_File (filename: lines): BOOLEAN;
  43. PROCEDURE IO_Check (a: BOOLEAN);  EXTERNAL;
  44. FUNCTION IO_Result: INTEGER; EXTERNAL;
  45. BEGIN
  46.   IO_Check(FALSE);  ReSet(inp_file, filename);  IO_Check(TRUE);
  47.   Open_File := (IO_Result = null);
  48. END;
  49.  
  50. PROCEDURE Init_Sys;
  51. (*  hier notfalls die entsprechenden ASCII-Codes Ihres Systems einsetzen:  *)
  52. BEGIN                                   (* Grafiksymbole, einfache Linien: *)
  53.   ve := '|';        he := '-';         (* senkrechter, waagerechter Strich *)
  54.   ce := '+';                                                      (* Kreuz *)
  55.   dle := '+';       dre := '+';        (* rechte untere, linke untere Ecke *)
  56.   ule := '+';       ure := '+';        (* rechte obere, linke obere Ecke   *)
  57.   uhe := '+';       dhe := '+';        (* T-Stueck: nach oben, nach unten  *)
  58.   rve := '+';       lve := '+';        (* T-Stueck: nach rechts,nach links *)
  59.   vd := '|';                            (* senkrechte, doppelte Linien     *)
  60.   bar := '|';       sl := '!';          (* senkr. Strich: einfach, doppelt *)
  61.   u_arrow := '^';      d_arrow := 'v';      (* Pfeil nach oben, nach unten *)
  62.   led_on := 'X';       led_off := 'O';       (* voller Kreis, leerer Kreis *)
  63.   time := 1000;    (* Zeitverzoegerung bei Prog-Ausfuehrung im Delay-Modus *)
  64. END;
  65.  
  66. PROCEDURE Val (st: lines; VAR value, code: INTEGER);
  67. VAR i: INTEGER;  minus: BOOLEAN;
  68. BEGIN
  69.   value := 0;  i := 1;  code := 0;  minus := st[1] = '-';
  70.   IF minus THEN i := Succ(i);
  71.   WHILE i <= Length(st) DO BEGIN
  72.     IF st[i] IN ['0'..'9'] THEN
  73.       value := value * 10 + (Ord(st[i]) - Ord('0'))
  74.     ELSE BEGIN  code := i;  i := Length(st);  END;
  75.     i := Succ(i);
  76.   END;
  77.   IF minus THEN value := -1 * value;
  78. END;
  79.  
  80. PROCEDURE Delay (time: INTEGER);
  81. VAR i: INTEGER;  j: REAL;
  82. BEGIN j := 1.0; FOR i := 0 TO time DO j := j*j/j/j;  END;
  83.  
  84. FUNCTION UpCase (ch: CHAR): CHAR;
  85. BEGIN
  86.   IF ch IN ['a'..'z'] THEN ch := Chr(Ord(ch)-32);
  87.   UpCase := ch;
  88. END;
  89. (* ----------------------------------------------------------------------- *)
  90. (*                               DCPSPTOS.PAS                              *)
  91.  
  92.