home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / ansi / ansicrt / anscrt.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-05-28  |  12.5 KB  |  333 lines
  1.   Unit AnsCrt;
  2.   {By Rick Housh - CIS PIN 72466,212}
  3.   {ANSI Alternate to CRT unit}
  4.   {Uses standard ANSI calls for all cursor placement, color attribute }
  5.   {changes, etc., and Interrupt 21h DOS calls for everything else. }
  6.   {No ROM BIOS calls at all.  Should work on any MS-DOS computer with ANSI}
  7.   {support.}
  8. (**************************************************************************)
  9. { The variable TextAttr is maintained, although not used.  Just for the
  10.   curious.  It serves no purpose.  The variable CheckBreak is supported.
  11.   None of the other variables are supported, as almost all have to do
  12.   with various aspects of direct screen writing, which is not supported.
  13.  
  14.   None of the Crt Mode constants are supplied.  All of the Text Color
  15.   constants are supported.
  16.  
  17.   It is possible to do much more with ANSI actually, than with many of
  18.   Turbo's standard CRT procedures, but no extras were implemented, in
  19.   the interest of compatibility with Turbo.
  20.  
  21.   There is one major limitation.  The window procedure is not supported.
  22.   In the interest of universal compatibility Textmode is also not supported,
  23.   although it could be.
  24.  
  25.   The following CRT unit functions and procedures are supported as follows:
  26.     AssignCrt      :   Not supported
  27.     ClrEol         :   Fully supported
  28.     ClrScr         :   Fully supported
  29.     Delay          :   Not supported
  30.     DelLine        :   Not supported    (Could easily be, but never used it)
  31.     GotoXY         :   Fully supported
  32.     HighVideo      :   Fully supported
  33.     InsLine        :   Not Supported    (See DelLine)
  34.     LowVideo       :   Fully supported
  35.     NoSound        :   Not supported
  36.     Sound          :   Not supported
  37.     TextBackground :   Fully supported
  38.     TextColor      :   Fully supported
  39.     TextMode       :   Not supported
  40.     Window         :   Not supported
  41.     KeyPressed     :   Fully supported
  42.     NormVideo      :   Fully supported
  43.     ReadKey        :   Fully supported
  44.     WhereX         :   Fully supported
  45.     WhereY         :   Fully supported
  46.  
  47.   Those miscellaneous functions which are not supported are almost all
  48.   available in Carley Phillip's CRTI unit, available in this DL as
  49.   CRTI.ARC.  Combine some of these and some of those in one unit if you
  50.   need the Sound, NoSound, Delay, etc.  If you do this however, you will
  51.   lose some of the MS-DOS generic nature of these routines, which depend
  52.   only on DOS and ANSI, and require no IBM compatibility.  Under NO
  53.   circumstances may this unit be used in combination with the standard
  54.   CRT unit.  It is a replacement.  The Graph, Graph3 and Turbo3 units
  55.   are not compatible with this unit and should not be used either.
  56.  
  57.  This unit supplies one unit not available in CRT, the GetKey function.
  58.  Most of the time I just want a character returned.  I am not interested
  59.  in function keys, etc.  GetKey does just that.  It first flushes the
  60.  keyboard, in case you accidentally pressed something, ignores function
  61.  keys, and returns the value of the keypress as a character.  Where the
  62.  variable ch is a character, the appropriate syntax would be:
  63.     ch := GetKey;
  64.  It will then wait for the key.
  65.  
  66.         This program is dedicated to the public domain.
  67.         No copyright is claimed.
  68.         I would be interested in reports.
  69.                     Rick Housh
  70.                     5811 W. 85th Terr.
  71.                     Overland Park, KS 66207
  72.                     Tel. 913/341-7592
  73.                     Compuserve PIN #72466,212
  74.  
  75. }
  76.  
  77.  
  78.  
  79.  
  80.   Interface
  81.   Const
  82.     Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5;
  83.     Brown = 6; LightGray = 7; DarkGray = 8; LightBlue = 9;
  84.     LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13;
  85.     Yellow = 14; White = 15; Blink = 128;
  86.  
  87.   Var
  88.     CheckBreak, CheckEOF,
  89.      Blinking            : Boolean;
  90.     TextAttr, ForeColour,
  91.      BackColour          : Byte;
  92.     Function Keypressed  : Boolean;
  93.     Function GetKey      : Char;
  94.     Function ReadKey     : Char;
  95.     Function WhereX      : Byte;
  96.     Function WhereY      : Byte;
  97.     Procedure NormVideo;
  98.     Procedure LowVideo;
  99.     Procedure HighVideo;
  100.     Procedure ClrEol;
  101.     Procedure ClrScr;
  102.     Procedure GotoXY(X, Y : Byte);
  103.     Procedure TextBackGround(Back : Byte);
  104.     Procedure TextColor(Fore : Byte);
  105.  
  106.  
  107.   Implementation
  108.  
  109.   Function KeyPressed : boolean;   { Replacement for CRT.KeyPressed }
  110.                          {  ;Detects whether a key is pressed}
  111.                          {  ;Does nothing with the key}
  112.                          {  ;Returns true if key is pressed}
  113.                          {  ;Otherwise, false}
  114.                          {  ;Key remains in kbd buffer}
  115.     Var IsThere : Byte;
  116.     Begin
  117.       Inline(
  118.       $B4/$0B/               {    MOV AH,+$0B         ;Get input status}
  119.       $CD/$21/               {    INT $21             ;Call DOS}
  120.       $88/$86/>ISTHERE);     {    MOV >IsThere[BP],AL ;Move into variable}
  121.       If IsThere = $FF then Keypressed := True else keypressed := False;
  122.     end;
  123.  
  124.   Procedure  ClrEol;     { ANSI replacement for CRT.ClrEol }
  125.     Begin
  126.       Write(#27'[K');
  127.     end;
  128.  
  129.   Procedure ClrScr;     { ANSI replacement for CRT.ClrScr }
  130.     Begin
  131.       Write(#27'[2J');
  132.     end;
  133.  
  134.   Function GetKey : char;     { Additional function.  Not in CRT Unit }
  135.     Var CH : char;
  136.     Begin
  137.       Inline(
  138.                      {; Function GetKey : Char}
  139.                      {; Clears the keyboard buffer then waits until}
  140.                      {; a key is struck.  If the key is a special, e.g.}
  141.                      {; function key, goes back and reads the next}
  142.                      {; byte in the keyboard buffer.  Thus does}
  143.                      {; nothing special with function keys.}
  144.       $B4/$0C        {       MOV  AH,$0C      ;Set up to clear buffer}
  145.       /$B0/$08       {       MOV  AL,8        ;then to get a char}
  146.       /$CD/$21       {SPCL:  INT  $21         ;Call DOS}
  147.       /$3C/$00       {       CMP  AL,0        ;If it's a 0 byte}
  148.       /$75/$04       {       JNZ  CHRDY       ;is spec., get second byte}
  149.       /$B4/$08       {       MOV  AH,8        ;else set up for another}
  150.       /$EB/$F6       {       JMP  SHORT SPCL  ;and get it}
  151.       /$88/$46/>CH   {CHRDY: MOV  >CH[BP],AL  ;else put into function return}
  152.        );
  153.       If CheckBreak and (Ch = #3) then
  154.         Begin        {If CheckBreak is true and it's a ^C}
  155.           Inline(    {then execute Ctrl_Brk}
  156.           $CD/$23);
  157.         end;
  158.       GetKey := Ch;
  159.     end; {Inline function GetKey}
  160.  
  161.  
  162.   Function ReadKey : char;  { Replacement for CRT.ReadKey }
  163.     Var chrout : char;
  164.     Begin
  165.                          {  ;Just like ReadKey in CRT unit}
  166.       Inline(
  167.       $B4/$07/               {  MOV AH,$07          ;Char input w/o echo}
  168.       $CD/$21/               {  INT $21             ;Call DOS}
  169.       $88/$86/>CHROUT);      {  MOV >chrout[bp],AL  ;Put into variable}
  170.       If CheckBreak and (chrout = #3) then  {If it's a ^C and CheckBreak true}
  171.         Begin                             {then execute Ctrl_Brk}
  172.           Inline(
  173.           $CD/$23);           {     INT $23}
  174.         end;
  175.       ReadKey := chrout;                    {else return character}
  176.     end;
  177.  
  178.  
  179.   Function WhereX : byte;       { ANSI replacement for CRT.WhereX }
  180.     var                         { Cursor position report. This is column or }
  181.       ch  : char;               { X axis report.}
  182.       st  : String;
  183.       st1 : String[2];
  184.       x   : byte;
  185.       i   : integer;
  186.  
  187.     begin
  188.       Write(#27'[6n');          { Ansi string to get X-Y position }
  189.       st := '';                 { We will only use X here }
  190.       ch := #0;                 { Make sure character is not 'R' }
  191.       While ch <> 'R' do        { Return will be }
  192.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  193.           ch := #0;
  194.           ch := readkey;        { Get one }
  195.           st := st + ch;        { Build string }
  196.         end;
  197.         St1 := copy(St,6,2);    { Pick off substring having number in ASCII}
  198.         Val(St1,x,i);           { Make it numeric }
  199.         WhereX := x;            { Return the number }
  200.     end;
  201.  
  202.   Function WhereY : byte;       { ANSI replacement for CRT.WhereY }
  203.     var                         { Cursor position report.  This is row or }
  204.       ch  : char;               { Y axis report.}
  205.       st  : String;
  206.       st1 : String[2];
  207.       y   : byte;
  208.       i   : integer;
  209.  
  210.     begin
  211.       Write(#27'[6n');          { Ansi string to get X-Y position }
  212.       st := '';                 { We will only use Y here }
  213.       ch := #0;                 { Make sure character is not 'R' }
  214.       While ch <> 'R' do        { Return will be }
  215.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  216.           ch := #0;
  217.           ch := readkey;        { Get one }
  218.           st := st + ch;        { Build string }
  219.         end;
  220.         St1 := copy(St,3,2);    { Pick off substring having number in ASCII}
  221.         Val(St1,y,i);           { Make it numeric }
  222.         WhereY := y;            { Return the number }
  223.     end;
  224.  
  225.  
  226.     Procedure GotoXY(x : byte ; y : byte); { ANSI replacement for CRT.GoToXY}
  227.       Begin
  228.         If (x < 1) or (y < 1) then exit;
  229.         If (x > 80) or (y > 25) then exit;
  230.         Write(#27'[',y,';',x,'H');
  231.       end;
  232.  
  233.    Procedure TextColor(Fore : Byte);
  234.      Begin
  235.        If not ((Fore in [0..15]) or (Fore in [128..143])) then exit;
  236.        ForeColour := Fore;
  237.        Blinking := False;
  238.        Write(#27'[0m');
  239.        TextBackGround(BackColour);
  240.        If Fore >  127 then
  241.          begin
  242.            If Fore > 128 then Fore := Fore - 128;
  243.            Blinking := True;
  244.            Write(#27'[5m');
  245.          end;
  246.        Case Fore of
  247.           0  :  Write(#27'[30m');
  248.           1  :  Write(#27'[34m');
  249.           2  :  Write(#27'[32m');
  250.           3  :  Write(#27'[36m');
  251.           4  :  Write(#27'[31m');
  252.           5  :  Write(#27'[35m');
  253.           6  :  Write(#27'[33m');
  254.           7  :  Write(#27'[37m');
  255.           8  :  Write(#27'[1;30m');
  256.           9  :  Write(#27'[1;34m');
  257.          10  :  Write(#27'[1;32m');
  258.          11  :  Write(#27'[1;36m');
  259.          12  :  Write(#27'[1;31m');
  260.          13  :  Write(#27'[1;35m');
  261.          14  :  Write(#27'[1;33m');
  262.          15  :  Write(#27'[1;37m');
  263.        end;  { Case }
  264.  
  265.        TextAttr := (TextAttr AND $70) + Fore;
  266.      end;
  267.  
  268.    Procedure TextBackGround(Back : Byte);{Replacement for CRT.TextBackground}
  269.      Begin
  270.        If Back > 7 then exit;     { No illegal values allowed }
  271.        BackColour := Back;
  272.        Case Back of
  273.            0  :  Write(#27'[40m');
  274.            1  :  Write(#27'[44m');
  275.            2  :  Write(#27'[42m');
  276.            3  :  Write(#27'[46m');
  277.            4  :  Write(#27'[41m');
  278.            5  :  Write(#27'[45m');
  279.            6  :  Write(#27'[43m');
  280.            7  :  Write(#27'[47m');
  281.          end;  { Case }
  282.        TextAttr := (TextAttr AND $8F) + Back * 16;
  283.      end;
  284.  
  285.  
  286.    Procedure NormVideo;   { ANSI Replacement for CRT.NormVideo }
  287.      Begin
  288.        Write(#27'[0m');
  289.        ForeColour := LightGray;
  290.        BackColour := Black;
  291.        TextAttr := $07;   { Just to maintain it }
  292.      end;
  293.  
  294.    Procedure LowVideo;    { Replacement for CRT.LowVideo }
  295.      Begin
  296.        If ForeColour > 7 then ForeColour := ForeColour - 8;
  297.        Write(#27'[0m');
  298.        TextBackGround(BackColour);
  299.        If not Blinking then TextColor(ForeColour)
  300.           else TextColor(ForeColour + 128);
  301.        TextAttr := TextAttr AND $0F;  {Just to maintain it}
  302.      end;
  303.  
  304.    Procedure HighVideo;   { Replacement for CRT.HighVideo }
  305.      Begin
  306.        If ForeColour < 8 then ForeColour := ForeColour + 8;
  307.        If Not Blinking then TextColor(ForeColour)
  308.            else TextColor(ForeColour + 128);
  309.        TextAttr := TextAttr OR $0F;
  310.      end;
  311.  
  312.  
  313.    var Dummy : char;        {Local variable to eat characters}
  314.  
  315.    Begin    { Setup }
  316.     CheckBreak := True;
  317.     CheckEOF := False;
  318.     TextAttr := 7;
  319.     BackColour := Black;
  320.     ForeColour := LightGray;
  321.     Blinking   := False;
  322.     Write(#27'[6n');               { Ask for cursor position report via }
  323.       If not keypressed then       { the ANSI driver.  If it returns }
  324.           begin                    { nothing in the keyboard buffer }
  325.             WriteLn(               { then no ANSI, so abort }
  326.  #13#7'This program requires the ANSI driver and it is not loaded.  Aborting.');
  327.             Halt;
  328.           end
  329.             else                   { If ANSI is loaded then }
  330.           Repeat                   { just empty the keyboard buffer }
  331.             Dummy := Readkey;
  332.           until not keypressed;
  333.    end.