home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ALTCRT.ZIP / ALTCRT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-05-11  |  14.9 KB  |  354 lines
  1. Unit AltCrt;
  2.   {By Rick Housh - CIS PIN 72466,212}
  3.   {Alternate to CRT unit}
  4.   {Does all it can without memory mapped screen writing}
  5.   {Uses DOS rather than Video ROM where possible}
  6. (**************************************************************************)
  7. {
  8.  I started this Unit because I couldn't read a single keystroke with
  9.  just the System or the Dos Units.  ReadKey is in the CRT unit.  Many of
  10.  the programs I write do not need the memory mapped screen writes used in
  11.  the Crt unit, but if you use it at all, you get them, and about 2k
  12.  additional size to your .EXE file.  Well, I started with just a simple
  13.  inline function to read a keystroke and return its character.  It's in
  14.  here, called GetKey.
  15.  
  16.  But, while I was at it, I ended up replacing most of the Crt unit, using
  17.  only DOS (Interrupt 21H) calls and Video ROM BIOS (Interrupt 10H) calls.
  18.  There is no memory mapped video writing, and the write routines have not
  19.  been replaced.  TP version 4's regular Write and WriteLn routines are
  20.  used, and they use DOS, which places a number of limitations on what
  21.  one can do.  However, most of the useful functions are retained.
  22.  
  23.  There is one major limitation.  The window procedure is not supported,
  24.  and the Unit will not work on anything other than an 80 column screen.
  25.  It aborts with a semi-polite message if asked to do otherwise.
  26.  
  27.  The following CRT unit functions are supported as follows:
  28.     AssignCrt      :   Not supported
  29.     ClrEol         :   Fully supported
  30.     ClrScr         :   Fully supported
  31.     Delay          :   Not supported
  32.     DelLine        :   Not supported    (Could easily be, but never used it)
  33.     GotoXY         :   Fully supported
  34.     HighVideo      :   Limited support
  35.     InsLine        :   Not Supported    (See DelLine)
  36.     LowVideo       :   Limited support
  37.     NoSound        :   Not supported
  38.     Sound          :   Not supported
  39.     TextBackground :   Limited support
  40.     TextColor      :   Limited support
  41.     TextMode       :   Not supported
  42.     Window         :   Not supported
  43.     KeyPressed     :   Fully supported
  44.     NormVideo      :   Limited support
  45.     ReadKey        :   Fully supported
  46.     WhereX         :   Fully supported
  47.     WhereY         :   Fully supported
  48.  
  49.  From the above you can see that most of the important CRT Unit functions
  50.  are available.  The video attribute functions which are only partially
  51.  supported are because using the DOS Write and WriteLn functions does
  52.  not make it possible.  However if you use TextBackground and/or
  53.  TextColor (or NormVideo, HighVideo, or LowVideo) just before a ClrXxx
  54.  call, they will work.  Ordinarily, DOS functions cannot do that.  For
  55.  example, consider the following:
  56.    TextBackground(Blue);
  57.    TextColor(Yellow);
  58.    ClrScr;
  59.  This little bit of code will clear the screen and everything will there-
  60.  after be yellow on blue.  ClrEol will do that also, but only on the
  61.  line on which it is used.
  62.  
  63.  Those miscellaneous functions which are not supported are almost all
  64.  available in Carley Phillip's CRTI unit, available in this DL as
  65.  CRTI.ARC.  Combine some of these and some of those in one unit if you
  66.  need the Sound, NoSound, Delay, etc.
  67.  
  68.  This unit supplies one unit not available in CRT, the GetKey function.
  69.  Most of the time I just want a character returned.  I am not interested
  70.  in function keys, etc.  GetKey does just that.  It first flushes the
  71.  keyboard, in case you accidentally pressed something, ignores function
  72.  keys, and returns the value of the keypress as a character.  Where the
  73.  variable ch is a character, the appropriate syntax would be:
  74.     ch := GetKey;
  75.  It will then wait for the key.
  76.  
  77.         This program is dedicated to the public domain.
  78.         No copyright is claimed.
  79.         I would be interested in reports.
  80.                     Rick Housh
  81.                     5811 W. 85th Terr.
  82.                     Overland Park, KS 66207
  83.                     Tel. 913/341-7592
  84.                     Compuserve PIN #72466,212
  85.  
  86. }
  87.  
  88.  
  89.  
  90.  
  91.   Interface
  92.   Const
  93.     Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5;
  94.     Brown = 6; LightGray = 7; DarkGray = 8; LightBlue = 9;
  95.     LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13;
  96.     Yellow = 14; White = 15; Blink = 128;
  97.  
  98.     BW40 = 0; BW80 = 1; Mono = 7; CO40 = 1; CO80 = 3; Font8x8 = 256;
  99.     C40 = CO40; C80 = CO80;
  100.  
  101.   Var
  102.     CheckBreak, CheckEOF : Boolean;
  103.     TextAttr             : Byte;
  104.     LastMode             : Word;
  105.     Function GetKey      : Char;
  106.     Function ReadKey     : Char;
  107.     Function WhereX      : Byte;
  108.     Function WhereY      : Byte;
  109.     Function Keypressed  : Boolean;
  110.     Procedure NormVideo;
  111.     Procedure LowVideo;
  112.     Procedure HighVideo;
  113.     Procedure ClrEol;
  114.     Procedure ClrScr;
  115.     Procedure GotoXY(XPos, YPos : Byte);
  116.     Procedure TextBackGround(Back : Byte);
  117.     Procedure TextColor(Fore : Byte);
  118.  
  119.  
  120.   Implementation
  121.  
  122.   {There are two ClrEol procedures here, the first of which is
  123.    commented out.  The second, currently operative, is a little
  124.    slower, but can reset the video attribute on the line it
  125.    clears.  The first is faster, but incapable of doing that.
  126.    Use whichever you like, but remember to comment out the unused
  127.    one.}
  128.  
  129. (*
  130.   Procedure ClrEol;  {Just write spaces to EOL and put cursor back}
  131.   Begin
  132.   Inline(
  133.    $B4/$03/               {MOV AH,$03    ;Set for read curs. pos.}
  134.    $30/$FF/               {XOR BH,BH     ;Set page zero}
  135.    $CD/$10/               {INT $10       ;Call ROM BIOS}
  136.    $52/                   {PUSH DX       ;save cursor pos}
  137.    $31/$C9/               {XOR CX,CX     ;Zero CX}
  138.    $B1/$4F/               {MOV CL,$79    ;put column 79 in CL}
  139.    $28/$D1/               {SUB CL,DL     ;subtract current curs. column}
  140.                           {              ;CX now has count of}
  141.                           {              ;columns to EOL}
  142.    $80/$F9/$00/           {CMP CL,$0     ;Is the cursor at EOL?}
  143.    $75/$03/               {JNZ  AGAIN    ;If not clreol}
  144.    $5A/                   {POP  DX       ;else get DX}
  145.    $EB/$0F/               {JMP short GETOUT ;and exit}
  146.                           {AGAIN:}
  147.    $B4/$02/               {MOV AH,$02    ;Set for write a char}
  148.    $B2/$20/               {MOV DL,$20    ;make it a space}
  149.    $CD/$21/               {INT $21       ;and write it}
  150.    $E2/$F8/               {LOOP AGAIN    ;until at EOL}
  151.    $5A/                   {POP DX        ;get original cursor pos.}
  152.    $30/$FF/               {XOR BH,BH     ;Set at page zero}
  153.    $B4/$02/               {MOV AH,$02    ;Set for position curs.}
  154.    $CD/$10);              {INT $10       ;Call ROM BIOS}
  155.                           {GETOUT:       ;Finished}
  156.    end; {Inline procedure ClrEol}
  157. *)
  158.  
  159.   Procedure ClrEol;  { Replacement for CRT.ClrEol }
  160.    Var ATR : Byte;
  161.    Begin
  162.      ATR := TextAttr;
  163.       Inline(
  164.       $B4/$03/               {MOV   AH,$03      ;Set up for curs. pos. report}
  165.       $31/$DB/               {XOR   BX,BX       ;Page to zero}
  166.       $CD/$10/               {INT   $10         ;Call Video ROM}
  167.       $31/$C9/               {XOR   CX,CX       ;CX to 0}
  168.       $52/                   {PUSH  DX          ;Y in DH, X in CL, Savem}
  169.                              {AGAIN:            ;Label for loop}
  170.       $B4/$09/               {MOV   AH,$09      ;Set to write char w/attribute}
  171.       $B0/$20/               {MOV   AL,$20      ;Char will be a space}
  172.       $8A/$5E/<ATR/          {MOV   BL,<ATR[BP] ;Attribute is TextAttr}
  173.       $B1/$50/               {MOV   CL,$50      ;80 column line}
  174.       $28/$D1/               {SUB   CL,DL       ;Count is 80 - Curs. Pos.}
  175.       $CD/$10/               {INT   $10         ;Call Video ROM, write 1st space}
  176.       $B4/$02/               {MOV   AH,$02      ;Set cursor position}
  177.       $B7/$00/               {MOV   BH,$00      ;on page zero}
  178.       $80/$C2/$01/           {ADD   DL,$01      ;increment by one}
  179.       $CD/$10/               {INT   $10         ;call Video ROM to mov it}
  180.       $E2/$E8/               {LOOP  AGAIN       ;Do it again, until CX = 0}
  181.       $5A/                   {POP   DX          ;Recover original cursor pos.}
  182.       $31/$DB/               {XOR   BX,BX       ;Set to page zero}
  183.       $CD/$10);              {INT   $10         ;Call Video ROM to put it back}
  184.    end;  {Inline Procedure ClrEol}
  185.  
  186. Procedure ClrScr;    {Replacement for CRT.ClrScr}
  187.   Var ATR : Byte;
  188.   Begin
  189.     ATR := TextAttr;
  190.     Inline(
  191.       $B8/$00/$07/           {MOV  AX,$0700   ;Ready to clear screen}
  192.       $8A/$7E/<ATR/          {MOV  BH,<ATR[BP] ;Assigned attribute}
  193.       $31/$C9/               {XOR  CX,CX      ;Whole Screen}
  194.       $BA/$4F/$18/           {MOV  DX,$184F   ;clear to bottom right}
  195.       $CD/$10/               {INT  $10        ;Call ROM BIOS}
  196.       $B4/$02/               {MOV  AH,$02     ;Ready to pos. cursor}
  197.       $B7/$00/               {MOV  BH,$00     ;Page zero}
  198.       $31/$D2/               {XOR  DX,DX      ;Cursor top left}
  199.       $CD/$10);              {INT  $10        ;Call ROM BIOS}
  200.   end;
  201.  
  202.   Function GetKey : char;     { Additional function.  Not in CRT Unit }
  203.     Var CH : char;
  204.     Begin
  205.       Inline(
  206.                      {; Function GetKey : Char}
  207.                      {; Clears the keyboard buffer then waits until}
  208.                      {; a key is struck.  If the key is a special, e.g.}
  209.                      {; function key, goes back and reads the next}
  210.                      {; byte in the keyboard buffer.  Thus does}
  211.                      {; nothing special with function keys.}
  212.       $B4/$0C        {       MOV  AH,$0C      ;Set up to clear buffer}
  213.       /$B0/$08       {       MOV  AL,8        ;then to get a char}
  214.       /$CD/$21       {SPCL:  INT  $21         ;Call DOS}
  215.       /$3C/$00       {       CMP  AL,0        ;If it's a 0 byte}
  216.       /$75/$04       {       JNZ  CHRDY       ;is spec., get second byte}
  217.       /$B4/$08       {       MOV  AH,8        ;else set up for another}
  218.       /$EB/$F6       {       JMP  SHORT SPCL  ;and get it}
  219.       /$88/$46/<CH   {CHRDY: MOV  <CH[BP],AL  ;else put into function return}
  220.        );
  221.       If CheckBreak and (Ch = #3) then
  222.         Begin        {If CheckBreak is true and it's a ^C}
  223.           Inline(    {then execute Ctrl_Brk}
  224.           $CD/$23);
  225.         end;
  226.       GetKey := Ch;
  227.     end; {Inline function GetKey}
  228.  
  229.  
  230.   Function ReadKey : char;  { Replacement for CRT.ReadKey }
  231.     Var chrout : char;
  232.     Begin
  233.                          {  ;Just like ReadKey in CRT unit}
  234.       Inline(
  235.       $B4/$07/               {  MOV AH,$07          ;Char input w/o echo}
  236.       $CD/$21/               {  INT $21             ;Call DOS}
  237.       $88/$86/<CHROUT);      {  MOV <chrout[bp],AL  ;Put into variable}
  238.       If CheckBreak and (chrout = #3) then  {If it's a ^C and CheckBreak true}
  239.         Begin                             {then execute Ctrl_Brk}
  240.           Inline(
  241.           $CD/$23);           {     INT $23}
  242.         end;
  243.       ReadKey := chrout;                    {else return character}
  244.     end;
  245.  
  246.   Function WhereX : Byte;  {Returns x coordinate of cursor}
  247.   Var XVAL : Byte;         { Replacement for CRT.WhereX }
  248.   Begin
  249.     Inline(
  250.       $B4/$03/               { MOV     AH,+$03       ;Set for GetCursPos}
  251.       $B7/$00/               { MOV     BH,+$00       ;page zero}
  252.       $CD/$10/               { INT     $10           ;Call Video ROM}
  253.       $88/$D0/               { MOV     AL,DL         ;Move x coordinate}
  254.       $04/$01/               { ADD     AL,$01        ;increment by one}
  255.       $88/$46/<XVAL);        { MOV     <XVAL[BP],AL  ;to adjust for TP}
  256.       WhereX := XVAL;        {                        And return it}
  257.   end;
  258.  
  259.   Function WhereY : Byte;  {Returns Y coordinate of cursor}
  260.   Var YVAL : Byte;         { Replacment for CRT.WhereY }
  261.   Begin
  262.     Inline(
  263.       $B4/$03/               {      MOV     AH,+$03  ;Same as WhereX}
  264.       $B7/$00/               {      MOV     BH,+$00  ;except returns DH}
  265.       $CD/$10/               {      INT     $10      ;rather then DL}
  266.       $88/$F0/               {      MOV     AL,DH}
  267.       $04/$01/               {      ADD     AL,$01}
  268.       $88/$86/>YVAL);        {      MOV     [BP+>YVAL],AL}
  269.       WhereY := YVAL;
  270.   end;
  271.  
  272.  
  273.   Function KeyPressed : boolean;   { Replacement for CRT.KeyPressed }
  274.                          {  ;Detects whether a key is pressed}
  275.                          {  ;Does nothing with the key}
  276.                          {  ;Returns true if key is pressed}
  277.                          {  ;Otherwise, false}
  278.                          {  ;Key remains in kbd buffer}
  279.     Var IsThere : Byte;
  280.     Begin
  281.       KeyPressed := False;
  282.       Inline(
  283.       $B4/$0B/               {    MOV AH,+$0B         ;Get input status}
  284.       $CD/$21/               {    INT $21             ;Call DOS}
  285.       $88/$86/<ISTHERE);     {    MOV <IsThere[BP],AL ;Move into variable}
  286.       If IsThere = $FF then Keypressed := True;
  287.     end;
  288.  
  289.   Procedure GoToXY(Xpos, Ypos : Byte);    { Replacement for CRT.GoToXY }
  290.     Begin
  291.       If (Xpos > 80) or (Xpos < 1) then exit;  {If impossible do nothing}
  292.       If (Ypos > 25) or (Ypos < 1) then exit;
  293.       dec(Xpos);                               {Convert to DOS format}
  294.       dec(Ypos);
  295.       Inline(
  296.         $B4/$02/               {MOV  AH,$02        ;Ready to move cursor}
  297.         $B7/$00/               {MOV  BH,$00        ;on page zero}
  298.         $8A/$76/<YPOS/         {MOV  DH,<YPOS[BP]  ;Set Y coordinate}
  299.         $8A/$56/<XPOS/         {MOV  DL,<XPOS[BP]  ;Set X coordinate}
  300.         $CD/$10);              {INT  $10           ;and call ROM BIOS}
  301.     end; {Procedure GoToXY}
  302.  
  303.    Procedure TextBackGround(Back : Byte);{Replacement for CRT.TextBackground}
  304.      Begin
  305.        If Back > 7 then exit;     { No illegal values allowed }
  306.        TextAttr := (TextAttr AND $8F) + Back * 16;
  307.      end;
  308.  
  309.    Procedure TextColor(Fore : Byte);
  310.      Begin
  311.        If not ((Fore in [0..15]) or (Fore in [128..143])) then exit;
  312.        TextAttr := (TextAttr AND $70) + Fore;
  313.      end;
  314.  
  315.    Procedure NormVideo;   { Replacement for CRT.NormVideo }
  316.      Begin
  317.        TextAttr := $07;
  318.      end;
  319.  
  320.    Procedure LowVideo;    { Replacement for CRT.LowVideo }
  321.      Begin
  322.        TextAttr := TextAttr AND $0F;
  323.      end;
  324.  
  325.    Procedure HighVideo;   { Replacement for CRT.HighVideo }
  326.      Begin
  327.        TextAttr := TextAttr OR $0F;
  328.      end;
  329.  
  330.   Function GetCols : Byte;    { Return number of screen columns }
  331.     Var COL : Byte;
  332.     Begin
  333.       Inline(
  334.       $B4/$0F/           {    MOV  AH,$0F        ;Setup to get Video Mode}
  335.       $CD/$10/           {    INT  $10           ;Call Video ROM}
  336.       $88/$A6/>COL);     {    MOV  >COL[BP],AH   ;Interested only in columns}
  337.       GetCols := COL;
  338.     end;  {Procedure GetCols}
  339.  
  340.    Begin    { Setup }
  341.     If GetCols <> 80 then
  342.       Begin
  343.         WriteLn(#7);
  344.         WriteLn('You must be in an 80 column mode to run this program');
  345.         WriteLn('Aborting...');
  346.         Halt;
  347.       end;
  348.     CheckBreak := True;
  349.     CheckEOF := False;
  350.     TextAttr := 7;
  351.    end.
  352.  
  353.  
  354.