home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / ANSICRT2.ZIP / ANSICRT.PAS next >
Pascal/Delphi Source File  |  1993-03-21  |  7KB  |  231 lines
  1. UNIT AnsiCrt;
  2. {  Ian Hinson  using Turbo Pascal 6.0
  3.    3:633/357  18 March 1993                                 }
  4. { This Unit contains most functions & procedures in common use in the
  5.   CRT Unit. To that extent it is intended as a replacement to the CRT unit
  6.   and should not be used at the same time.
  7.   See the INTERFACE section for a list of constants, variables, functions
  8.   and procedures provided by this unit.
  9.  
  10.   DosCrt differs from the CRT Unit in that DOS is used for input and output.
  11.   This provides the following advantages:
  12.   1. Output can be redirected using DOS redirection
  13.   2. The routines should work on any 80x86 based machine using compatible
  14.      DOS (although non-IBMPC architectures have long since been driven from
  15.      consideration through programmers writing to the hardware environment
  16.      instead of the operating system.)
  17.   3. The use of DOS standard input/output and ANSI means that programs that
  18.      use this unit may feasibly be operated via a remote ANSI terminal.
  19.  
  20.   This unit has been adapted from the unit ANSCRT.PAS by Rick Housh.
  21.   However, a new approach used to implement most procedures (see below)
  22.   means the code is practically all new, except for the simplest procedures.
  23.   e.g. ClrScr, ClrEol, and most cursor functions.
  24.  
  25.   I have reworked the TextColor procedure by using a Decision Tree
  26.   implementation technique instead of conventional structured logic
  27.   programming; With the desired result that:
  28.   1) there is now only ONE Ansi sequence written to the output device
  29.      for each invocation of TextColor.
  30.   2) those sequences contain no redundancy e.g. (no) turning on bold when it
  31.      was already on, or (no) resetting all attributes when all that is needed
  32.      is to ADD an attribute.
  33.   The original ANSCrt Unit used a 'broad-brush' approach which simplified
  34.   the logic but caused redundancy of Ansi sequences.
  35.  
  36.   Ansi detection has been made into a separate user-available function.
  37.  
  38.   I have rewritten Keypressed and ReadKey. I don't believe that the speed
  39.   required for these routines is so great that ASM or INLINE code is
  40.   warranted, so I opted for the clearer DOS Unit 'Registers' method.
  41.  
  42.   User variables CheckEOF and TextAttr were abolished since they weren't
  43.   fully implemented anyway. }
  44.  
  45.  
  46. INTERFACE
  47.                                                                       
  48. CONST
  49.   Black = 0;     Blue = 1;          Green = 2;       Cyan = 3;
  50.   Red = 4;       Magenta = 5;       Brown = 6;       LightGray = 7;
  51.   DarkGray = 8;  LightBlue = 9;     LightGreen = 10; LightCyan = 11;
  52.   LightRed = 12; LightMagenta = 13; Yellow = 14;     White = 15;
  53.   Blink = 128;
  54.  
  55. VAR CheckBreak: BOOLEAN;
  56.  
  57. FUNCTION KeyPressed : BOOLEAN;
  58. FUNCTION ReadKey : CHAR;
  59. FUNCTION AnsiDetected: BOOLEAN;   { new to this unit }
  60. PROCEDURE TextColor(fore : Byte);
  61. PROCEDURE TextBackGround(back : BYTE);
  62. PROCEDURE NormVideo;
  63. PROCEDURE LowVideo;
  64. PROCEDURE HighVideo;
  65. PROCEDURE ClrEol;
  66. PROCEDURE ClrScr;
  67. PROCEDURE WhereXY(VAR x,y: BYTE); { new to this unit }
  68. FUNCTION WhereX: BYTE;
  69. FUNCTION WhereY: BYTE;
  70. PROCEDURE GotoXY(x,y: BYTE);
  71.  
  72. IMPLEMENTATION
  73. USES Dos;
  74.  
  75. CONST forestr: ARRAY[Black..LightGray] OF STRING[2]
  76.                = ('30','34','32','36','31','35','33','37');
  77.       backstr: ARRAY[Black..LightGray] OF STRING[2]
  78.                = ('40','44','42','46','41','45','43','47');
  79.       decisiontree: ARRAY[BOOLEAN, BOOLEAN, BOOLEAN, BOOLEAN] OF INTEGER =
  80.       ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));
  81.  
  82. VAR forecolour, backcolour: BYTE; { stores last colours set }
  83.     boldstate, blinkstate: BOOLEAN;
  84.  
  85. FUNCTION KeyPressed : BOOLEAN;
  86.   { Detects whether a key is pressed. Key remains in kbd buffer}
  87.   VAR r: REGISTERS;
  88.   BEGIN
  89.     r.AH := $0B;
  90.     MsDos(r);
  91.     Keypressed := (r.AL = $FF)
  92.   END;
  93.  
  94. FUNCTION ReadKey : CHAR;
  95.   { Will wait for key }
  96.   VAR r: REGISTERS;
  97.   BEGIN
  98.     r.AH := $07;
  99.     MsDos(r);
  100.     IF CheckBreak AND (r.AL = $03) THEN Intr($23,r);
  101.     ReadKey := Chr(r.AL)
  102.   END;
  103.  
  104. FUNCTION AnsiDetected: BOOLEAN;
  105. { Detects whether ANSI is installed. }
  106.   VAR dummy: CHAR;
  107.   BEGIN Write(#27'[6n'); { Ask for cursor position report via }
  108.     IF NOT keypressed    { the ANSI driver. }
  109.     THEN AnsiDetected := FALSE
  110.     ELSE BEGIN
  111.            AnsiDetected := TRUE;
  112.            { empty the keyboard buffer }
  113.            REPEAT Dummy := Readkey UNTIL NOT Keypressed
  114.          END
  115.   END;
  116.  
  117. PROCEDURE TextColor(fore : Byte);
  118.   VAR
  119.     blinknow, boldnow: BOOLEAN;
  120.     outstr: STRING;
  121.   BEGIN
  122.     blinknow := (fore AND $80) = $80;
  123.     boldnow := (fore AND $08) = $08;
  124.     fore := fore AND $07;  { mask out intensity and blink attributes }
  125.     forecolour := fore;
  126.     CASE decisiontree[blinknow, blinkstate, boldnow, boldstate] OF
  127.     0: outstr := Concat(#27,'[',forestr[fore],'m');
  128.     1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');
  129.     2: outstr := Concat(#27,'[1;',forestr[fore],'m');
  130.     3: outstr := Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');
  131.     4: outstr := Concat(#27,'[5;',forestr[fore],'m');
  132.     5: outstr := Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');
  133.     6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');
  134.     END; { CASE }
  135.     Write(outstr);
  136.     blinkstate := blinknow;
  137.     boldstate := boldnow;
  138.   END;
  139.  
  140. PROCEDURE TextBackGround(back: BYTE);
  141.   VAR outstring: STRING;
  142.   BEGIN
  143.     IF Back > 7 THEN Exit; { No such thing as bright or blinking backgrounds }
  144.     BackColour := Back;
  145.     outstring := Concat(#27,'[',backstr[back],'m');
  146.     Write(outstring)
  147.   END;
  148.  
  149. PROCEDURE NormVideo;
  150.   BEGIN
  151.     Write(#27'[0m');
  152.     forecolour := LightGray;
  153.     backcolour := Black;
  154.     boldstate := FALSE;
  155.     blinkstate := FALSE
  156.   END;
  157.  
  158. PROCEDURE LowVideo;
  159.   BEGIN
  160.     IF blinkstate THEN forecolour := forecolour OR $80;  { retain blinking }
  161.     TextColor(forecolour);   { stored forecolour never contains bold attr }
  162.   END;
  163.  
  164. PROCEDURE HighVideo;
  165.   BEGIN
  166.     IF NOT boldstate THEN
  167.     BEGIN
  168.       boldstate := TRUE;
  169.       Write(#27,'[1m')
  170.     END;
  171.   END;
  172.  
  173. PROCEDURE ClrEol;
  174.   BEGIN
  175.     Write(#27'[K')
  176.   END;
  177.  
  178. PROCEDURE ClrScr;
  179.   BEGIN
  180.     Write(#27'[2J');
  181.   END;
  182.  
  183. PROCEDURE WhereXY(VAR x,y: BYTE);
  184.   VAR
  185.     ch : char;
  186.     st : String;
  187.     st1: String[2];
  188.     i  : integer;
  189.   BEGIN
  190.     Write(#27'[6n');        { Ansi string to get X-Y position }
  191.     st := '';
  192.     REPEAT
  193.       ch := readkey;        { Get one }
  194.       st := st + ch;        { Build string }
  195.     UNTIL ch = 'R';
  196.     WHILE Keypressed DO ch := ReadKey; {clear kbd buffer}
  197.     St1 := copy(St,6,2);    { Pick off substring having number in ASCII}
  198.     Val(St1,x,i);           { Make it numeric }
  199.     St1 := copy(St,3,2);    { Pick off substring having number in ASCII}
  200.     Val(St1,y,i);           { Make it numeric }
  201.   END;
  202.  
  203. FUNCTION WhereX: BYTE;
  204.   VAR x,y: BYTE;
  205.   BEGIN
  206.     WhereXY(x,y);
  207.     WhereX := x
  208.   END;
  209.  
  210. FUNCTION WhereY: BYTE;
  211.   VAR x,y: BYTE;
  212.   BEGIN
  213.     WhereXY(x,y);
  214.     WhereY := y
  215.   END;
  216.  
  217. PROCEDURE GotoXY(x,y: BYTE);
  218.   BEGIN
  219.     IF (x < 1) OR (y < 1) THEN Exit;
  220.     IF (x > 80) OR (y > 25) THEN Exit;
  221.     Write(#27'[',y,';',x,'H');
  222.   END;
  223.  
  224. BEGIN
  225.   CheckBreak := TRUE;
  226.   forecolour := LightGray;
  227.   backcolour := Black;
  228.   boldstate := FALSE;
  229.   blinkstate := FALSE
  230. END.
  231.