home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / suncom.zip / ANSIDRV.PAS next >
Pascal/Delphi Source File  |  1989-09-30  |  6KB  |  157 lines
  1. {***************************************************************************}
  2. {*                    <<< LiveSystems AnsiDriver >>>                       *}
  3. {*                                                                         *}
  4. {* Release date 19-3-89                                                    *}
  5. {* Written by   G.Hoogterp  (Fidonet  2:2/102.6)                           *}
  6. {*                          (BitNet   HoogterpG@Hentht51)                  *}
  7. {*                                                                         *}
  8. {* (c) CopyRight LiveSystems LiveSystems 1989,1990                         *}
  9. {*                                                                         *}
  10. {* ALL RIGHTS RESERVED, NO GARANTIES :USE IT AT YOURE ONE RISK !           *}
  11. {***************************************************************************}
  12.  
  13. {***************************************************************************}
  14. {* this ansi drive supports the following codes :                          *}
  15. {*                                                                         *}
  16. {*  Esc[nA   : Cursor up                                                   *}
  17. {*  Esc[nB   : Cursor Down                                                 *}
  18. {*  Esc[nC   : Cursor right                                                *}
  19. {*  Esc[nD   : Cursor Left                                                 *}
  20. {*                                                                         *}
  21. {*  Esc[y;xf                                                               *}
  22. {*  Esc[y;xH  Cursor at Y,X                                                *}
  23. {*                                                                         *}
  24. {*  Esc[2J    Clear Screen                                                 *}
  25. {*  Esc[K     Clear to end of line                                         *}
  26. {*                                                                         *}
  27. {*  Esc[p1;..;pnm  Set graphics parameters                                 *}
  28. {*                                                                         *}
  29. {*                                                                         *}
  30. {* It also knows the codes :                                               *}
  31. {*                                                                         *}
  32. {*  Esc[=nh    Set Screen type                                             *}
  33. {*  Esc[=nl    Reset Screen type                                           *}
  34. {*  Esc[6n     Report current cursor position                              *}
  35. {*  Esc[y;xR   Report current cursor as y,x                                *}
  36. {*  Esc[s      Save cursor position                                        *}
  37. {*  Esc[u      Restore cursor position                                     *}
  38. {*                                                                         *}
  39. {* But these codes are not used and not displayed...                       *}
  40. {*                                                                         *}
  41. {***************************************************************************}
  42.  
  43. Unit AnsiDrv;
  44. Interface
  45. Uses dos,Crt;
  46.  
  47. Procedure AnsiDriver(Key : Char);
  48.  
  49. Implementation
  50.  
  51. Const AnsiEndChars = 'ABCDfHhJKlmnpRsu';
  52.  
  53. Type Str10 = String[10];
  54.  
  55. Var AnsiBuffer  : Array[0..255] Of Char;
  56.     AnsiPtr     : Byte;
  57.     RecAnsi     : Boolean;
  58.     MemAttr     : Byte;
  59.  
  60. Procedure AnsiDriver(Key : Char);
  61. Var Tel      : Byte;
  62.     AnsiBeg  : Byte;
  63.     AnsiStr  : Str10;
  64.  
  65.  
  66. Procedure DoAnsiControle(AnsiNr : Byte;AnsiStr : Str10);
  67. Var Value : Byte;
  68.     XVal,
  69.     YVal  : Byte;
  70.     Err   : Word;
  71.  
  72. Const ForColors  : Array[0..7] Of Byte = (0,4,2,14,1,5,3,15);
  73.       BackColors : Array[0..7] Of Byte = (0,4,2,6,1,5,3,7);
  74.  
  75. Begin
  76. Case AnsiNr Of
  77.  1,
  78.  2,
  79.  3,
  80.  4   : Begin
  81.        If AnsiStr<>''
  82.           Then Val(AnsiStr,Value,Err)
  83.           Else Value:=1;
  84.        Case AnsiNr Of
  85.         1 : GotoXy(WhereX,WhereY-Value);
  86.         2 : GotoXy(WhereX,WhereY+Value);
  87.         3 : GotoXy(WhereX+Value,WhereY);
  88.         4 : GotoXy(WhereX-Value,WhereY);
  89.        End;
  90.        End;
  91.  5,
  92.  6   : Begin
  93.        Val(Copy(AnsiStr,1,Pos(';',AnsiStr)-1),YVal,Err);
  94.        Delete(AnsiStr,1,Pos(';',AnsiStr));
  95.        Val(AnsiStr,XVal,Err);
  96.        GotoXy(XVal,YVal);
  97.        End;
  98.  8   : ClrScr;
  99.  9   : ClrEol;
  100. 11   : Begin
  101.        Repeat
  102.         If Pos(';',AnsiStr)>0
  103.            Then Begin
  104.                 Val(Copy(AnsiStr,1,Pos(';',AnsiStr)-1),Value,Err);
  105.                 Delete(AnsiStr,1,Pos(';',AnsiStr));
  106.                 End
  107.            Else Begin
  108.                 Val(AnsiStr,Value,Err);
  109.                 AnsiStr:='';
  110.                 End;
  111.         Case Value Of
  112.          0       : TextAttr:=MemAttr;
  113.          1..3    :;
  114.          5,6     : TextAttr:=TextAttr Or $80;
  115.          7       : TextAttr:=TextAttr Xor $7F;
  116.          8       :;
  117.          30..37  : TextColor(ForColors[Value-30]);
  118.          40..47  : TextBackGround(Backcolors[Value-40]);
  119.          48,49   :;
  120.         End; {Case}
  121.        Until AnsiStr='';
  122.        End;
  123. End; {Case}
  124.  
  125. End;
  126.  
  127. Begin
  128. If Key=#27
  129.    Then Begin
  130.         AnsiPtr:=0;
  131.         RecAnsi:=True;
  132.         End;
  133. If Not RecAnsi
  134.    Then Write(Key);
  135. Ansibuffer[AnsiPtr]:=Key;
  136. If Boolean(Pos(Key,AnsiEndChars)) And (AnsiBuffer[0]=#27)
  137.    Then Begin
  138.         Move(AnsiBuffer[1],AnsiStr,AnsiPtr-1);
  139.         AnsiStr[0]:=Chr(AnsiPtr-2);
  140.         If Pos(Key,'lpnRsu')=0
  141.            Then DoAnsiControle(Pos(Key,AnsiEndChars),AnsiStr);
  142.         AnsiPtr:=0;
  143.         RecAnsi:=False;
  144.         End
  145.    Else Inc(AnsiPtr);
  146. End;
  147.  
  148. Var Inp : File Of Char;
  149.     Key : Char;
  150.  
  151. Begin
  152. MemAttr:=TextAttr;
  153. AnsiPtr:=0;
  154. RecAnsi:=False;
  155. Fillchar(AnsiBuffer,255,0);
  156. End.
  157.