home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / conio.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-09  |  2.3 KB  |  113 lines
  1. TYPE
  2.   Seite = ARRAY [1..25,1..80] OF INTEGER;
  3.   RegRec= RECORD CASE INTEGER OF
  4.             1:(AX,BX,CX,DX,BP,DI,SI,DS,ES,FL:INTEGER);
  5.             2:(AL,AH,BL,CL,CH,DL,DH:BYTE)
  6.           END;
  7. VAR
  8.   Screen : Seite ABSOLUTE $B800:$0000;
  9.   CharType,WhereX,WhereY : INTEGER;
  10.   Register : RegRec;
  11.  
  12. FUNCTION ConIn : CHAR;
  13. BEGIN
  14.   WITH Register DO
  15.   BEGIN
  16.     (* Hier wird noch das alte GotoXY *)
  17.     (* benutzt, weil der Compiler das *)
  18.     (* das neue noch nicht kennt      *)
  19.     GotoXY(WhereX,WhereY);
  20.     IF Screen[WhereY,WhereX] = 0 THEN
  21.       Screen [WhereX,WhereY] := $0F20;
  22.     AX := $0700;
  23.     MSDOS(Register);
  24.     ConIn := Chr(AL)
  25.   END;
  26. END;
  27.  
  28. PROCEDURE ClrEol;
  29. BEGIN
  30.   FillChar(Screen[WhereY,WhereX],
  31.            (81-WhereX) SHL 1,0);
  32. END;
  33.  
  34. PROCEDURE InsLine;
  35. BEGIN
  36.   IF WhereY < 25 THEN
  37.     Move(Screen[WhereY],Screen[Succ(WhereY)],
  38.          (25-WhereY)*160);
  39.   FillChar(Screen[25],160,0)
  40. END;
  41.  
  42.  
  43. PROCEDURE DelLine;
  44. BEGIN
  45.   IF WhereY < 25 THEN
  46.     Move(Screen[Succ(WhereY)],
  47.          Screen[WhereY],(25-WhereY)*160);
  48.   FillChar(Screen[25],160,0)
  49. END;
  50.  
  51. PROCEDURE ClrScr;
  52. BEGIN
  53.   FillChar(Screen,4000,0);
  54.   WhereY := 1;  WhereX := 1;
  55. END;
  56.  
  57. PROCEDURE GotoXY (X,Y : INTEGER); (* das neue *)
  58. BEGIN
  59.   WhereX := X;  WhereY := Y
  60. END;
  61.  
  62. PROCEDURE ConOut (CH : CHAR);
  63. BEGIN
  64.   IF CH < ' ' THEN
  65.     CASE CH OF
  66.       ^M : WhereX := 1;
  67.       ^J : WhereY := Succ(WhereY);
  68.       ^G : BEGIN
  69.              Sound(440); Delay(100); NoSound
  70.            END;
  71.       ^H:BEGIN
  72.            WhereX := Pred(WhereX);
  73.            IF WhereX < 1 THEN
  74.              IF WhereY = 1 THEN WhereX := 1
  75.              ELSE
  76.                BEGIN
  77.                  WhereX := 80;
  78.                  WhereY := Pred(WhereY)
  79.                END
  80.          END
  81.     END
  82.   ELSE
  83.     BEGIN
  84.       Screen[WhereY,WhereX] := Ord(CH) OR CharType;
  85.       WhereX := Succ(WhereX);
  86.     END;
  87.     IF WhereX > 80 THEN
  88.       BEGIN
  89.         WhereY := Succ(WhereY); WhereX := 1
  90.       END;
  91.     IF WhereY > 25 THEN
  92.       BEGIN
  93.         WhereY := 1;  DelLine;  WhereY := 25;
  94.       END
  95. END;
  96.  
  97. PROCEDURE LowVideo;
  98. BEGIN
  99.   CharType := $0A00
  100. END;
  101.  
  102. PROCEDURE NormVideo;
  103. BEGIN
  104.   CharType := $0F00
  105. END;
  106.  
  107. PROCEDURE InitContOut;
  108. BEGIN
  109.   ConOutPtr := Ofs(ConOut);
  110.   ConInPtr := Ofs(ConIn);
  111.   NormVideo
  112. END;
  113.