home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / programming / pascal_programming / ansi.pas < prev    next >
Pascal/Delphi Source File  |  2001-02-10  |  8KB  |  306 lines
  1. UNIT Ansi;
  2.  
  3. INTERFACE
  4.  
  5.  
  6. USES Crt, Dos;
  7.  
  8. CONST
  9.      RecANSI : BOOLEAN = FALSE;
  10.  
  11. PROCEDURE AnsiWrite (ch : CHAR);
  12. PROCEDURE AnsiWriteLn (S : STRING);
  13.  
  14. IMPLEMENTATION
  15.  
  16.  
  17. VAR
  18.     Escape, Saved_X,
  19.     Saved_Y               : BYTE;
  20.     Control_Code          : STRING;
  21.  
  22. FUNCTION GetNumber (VAR LINE : STRING) : INTEGER;
  23.  
  24.    VAR
  25.      i, j, k         : INTEGER;
  26.      temp0, temp1   : STRING;
  27.  
  28.   BEGIN
  29.        temp0 := LINE;
  30.        VAL (temp0, i, j);
  31.       IF j = 0 THEN temp0 := ''
  32.        ELSE
  33.       BEGIN
  34.          temp1 := COPY (temp0, 1, j - 1);
  35.          DELETE (temp0, 1, j);
  36.          VAL (temp1, i, j);
  37.       END;
  38.     LINE := temp0;
  39.     GetNumber := i;
  40.   END;
  41.  
  42.  PROCEDURE loseit;
  43.     BEGIN
  44.       escape := 0;
  45.       control_code := '';
  46.       RecANSI := FALSE;
  47.     END;
  48.  
  49.  PROCEDURE Ansi_Cursor_move;
  50.  
  51.      VAR
  52.       x, y       : INTEGER;
  53.  
  54.     BEGIN
  55.      y := GetNumber (control_code);
  56.      IF y = 0 THEN y := 1;
  57.      x := GetNumber (control_code);
  58.      IF x = 0 THEN x := 1;
  59.      IF y > 25 THEN y := 25;
  60.      IF x > 80 THEN x := 80;
  61.      GOTOXY (x, y);
  62.     loseit;
  63.     END;
  64.  
  65. PROCEDURE Ansi_Cursor_up;
  66.  
  67.  VAR
  68.    y, new_y, offset          : INTEGER;
  69.  
  70.    BEGIN
  71.      Offset := getnumber (control_code);
  72.         IF Offset = 0 THEN offset := 1;
  73.       y := WHEREY;
  74.       IF (y - Offset) < 1 THEN
  75.              New_y := 1
  76.           ELSE
  77.              New_y := y - offset;
  78.        GOTOXY (WHEREX, new_y);
  79.   loseit;
  80.   END;
  81.  
  82. PROCEDURE Ansi_Cursor_Down;
  83.  
  84.  VAR
  85.    y, new_y, offset          : INTEGER;
  86.  
  87.    BEGIN
  88.      Offset := getnumber (control_code);
  89.         IF Offset = 0 THEN offset := 1;
  90.       y := WHEREY;
  91.       IF (y + Offset) > 25 THEN
  92.              New_y := 25
  93.           ELSE
  94.              New_y := y + offset;
  95.        GOTOXY (WHEREX, new_y);
  96.   loseit;
  97.   END;
  98.  
  99. PROCEDURE Ansi_Cursor_Left;
  100.  
  101.  VAR
  102.    x, new_x, offset          : INTEGER;
  103.  
  104.    BEGIN
  105.      Offset := getnumber (control_code);
  106.         IF Offset = 0 THEN offset := 1;
  107.       x := WHEREX;
  108.       IF (x - Offset) < 1 THEN
  109.              New_x := 1
  110.           ELSE
  111.              New_x := x - offset;
  112.        GOTOXY (new_x, WHEREY);
  113.   loseit;
  114.   END;
  115.  
  116. PROCEDURE Ansi_Cursor_Right;
  117.  
  118.  VAR
  119.    x, new_x, offset          : INTEGER;
  120.  
  121.    BEGIN
  122.      Offset := getnumber (control_code);
  123.         IF Offset = 0 THEN offset := 1;
  124.       x := WHEREX;
  125.       IF (x + Offset) > 80 THEN
  126.              New_x := 1
  127.           ELSE
  128.              New_x := x + offset;
  129.        GOTOXY (New_x, WHEREY);
  130.   loseit;
  131.   END;
  132.  
  133.  PROCEDURE Ansi_Clear_Screen;
  134.  
  135.    BEGIN                         {   0J = cusor to Eos           }
  136.      CLRSCR;                      {  1j start to cursor           }
  137.      loseit;                       { 2j entie screen/cursor no-move}
  138.    END;
  139.  
  140.  PROCEDURE Ansi_Clear_EoLine;
  141.  
  142.    BEGIN
  143.      CLREOL;
  144.      loseit;
  145.    END;
  146.  
  147.  
  148.  PROCEDURE Reverse_Video;
  149.  
  150.  VAR
  151.       tempAttr, tblink, tempAttrlo, tempAttrhi : BYTE;
  152.  
  153.  BEGIN
  154.             LOWVIDEO;
  155.             TempAttrlo := (TextAttr AND $7);
  156.             tempAttrHi := (textAttr AND $70);
  157.             tblink     := (textattr AND $80);
  158.             tempattrlo := tempattrlo * 16;
  159.             tempattrhi := tempattrhi DIV 16;
  160.             TextAttr   := TempAttrhi + TempAttrLo + TBlink;
  161.   END;
  162.  
  163.  
  164.  PROCEDURE Ansi_Set_Colors;
  165.  
  166.  VAR
  167.     temp0, Color_Code   : INTEGER;
  168.  
  169.     BEGIN
  170.         IF LENGTH (control_code) = 0 THEN control_code := '0';
  171.            WHILE (LENGTH (control_code) > 0) DO
  172.            BEGIN
  173.             Color_code := getNumber (control_code);
  174.                 CASE Color_code OF
  175.                    0          :  BEGIN
  176.                                    LOWVIDEO;
  177.                                    TEXTCOLOR (LightGray);
  178.                                    TEXTBACKGROUND (Black);
  179.                                  END;
  180.                    1          : HIGHVIDEO;
  181.                    5          : TextAttr := (TextAttr OR $80);
  182.                    7          : Reverse_Video;
  183.                    30         : textAttr := (TextAttr AND $F8) + black;
  184.                    31         : textattr := (TextAttr AND $f8) + red;
  185.                    32         : textattr := (TextAttr AND $f8) + green;
  186.                    33         : textattr := (TextAttr AND $f8) + brown;
  187.                    34         : textattr := (TextAttr AND $f8) + blue;
  188.                    35         : textattr := (TextAttr AND $f8) + magenta;
  189.                    36         : textattr := (TextAttr AND $f8) + cyan;
  190.                    37         : textattr := (TextAttr AND $f8) + Lightgray;
  191.                    40         : TEXTBACKGROUND (black);
  192.                    41         : TEXTBACKGROUND (red);
  193.                    42         : TEXTBACKGROUND (green);
  194.                    43         : TEXTBACKGROUND (yellow);
  195.                    44         : TEXTBACKGROUND (blue);
  196.                    45         : TEXTBACKGROUND (magenta);
  197.                    46         : TEXTBACKGROUND (cyan);
  198.                    47         : TEXTBACKGROUND (white);
  199.                  END;
  200.              END;
  201.        loseit;
  202.   END;
  203.  
  204.  
  205.  PROCEDURE Ansi_Save_Cur_pos;
  206.  
  207.     BEGIN
  208.       Saved_X := WHEREX;
  209.       Saved_Y := WHEREY;
  210.       loseit;
  211.     END;
  212.  
  213.  
  214.  PROCEDURE Ansi_Restore_cur_pos;
  215.  
  216.     BEGIN
  217.       GOTOXY (Saved_X, Saved_Y);
  218.       loseit;
  219.     END;
  220.  
  221.  
  222.  PROCEDURE Ansi_check_code ( ch : CHAR);
  223.  
  224.    BEGIN
  225.        CASE ch OF
  226.             '0'..'9', ';'     : control_code := control_code + ch;
  227.             'H', 'f'          : Ansi_Cursor_Move;
  228.             'A'              : Ansi_Cursor_up;
  229.             'B'              : Ansi_Cursor_Down;
  230.             'C'              : Ansi_Cursor_Right;
  231.             'D'              : Ansi_Cursor_Left;
  232.             'J'              : Ansi_Clear_Screen;
  233.             'K'              : Ansi_Clear_EoLine;
  234.             'm'              : Ansi_Set_Colors;
  235.             's'              : Ansi_Save_Cur_Pos;
  236.             'u'              : Ansi_Restore_Cur_pos;
  237.         ELSE
  238.           loseit;
  239.         END;
  240.    END;
  241.  
  242.  
  243. PROCEDURE AnsiWrite (ch : CHAR);
  244.  
  245. VAR
  246.   temp0      : INTEGER;
  247.  
  248. BEGIN
  249.        IF escape > 0 THEN
  250.           BEGIN
  251.               CASE Escape OF
  252.                 1    : BEGIN
  253.                          IF ch = '[' THEN
  254.                             BEGIN
  255.                               escape := 2;
  256.                               Control_Code := '';
  257.                             END
  258.                          ELSE
  259.                              escape := 0;
  260.                        END;
  261.                 2    : Ansi_Check_code (ch);
  262.               ELSE
  263.                 BEGIN
  264.                    escape := 0;
  265.                    control_code := '';
  266.                    RecANSI := FALSE;
  267.                 END;
  268.               END;
  269.           END
  270.        ELSE
  271.          BEGIN
  272.           CASE Ch OF
  273.              #27       : Escape := 1;
  274.              #9        : BEGIN
  275.                             temp0 := WHEREX;
  276.                             temp0 := temp0 DIV 8;
  277.                             temp0 := temp0 + 1;
  278.                             temp0 := temp0 * 8;
  279.                             GOTOXY (temp0, WHEREY);
  280.                          END;
  281.              #12       : CLRSCR;
  282.           ELSE
  283.                  BEGIN
  284.                     IF ( (WHEREX = 80) AND (WHEREY = 25) ) THEN
  285.                       BEGIN
  286.                         windmax := (80 + (24 * 256) );
  287.                         WRITE (ch);
  288.                         windmax := (79 + (24 * 256) );
  289.                       END
  290.                     ELSE
  291.                       WRITE (ch);
  292.                     escape := 0;
  293.                  END;
  294.            END;
  295.          END;
  296.   RecANSI := (Escape <> 0);
  297.   END;
  298.  
  299. PROCEDURE AnsiWriteLn (S : STRING);
  300. VAR I : BYTE;
  301. BEGIN
  302. FOR I := 1 TO LENGTH (S) DO Ansiwrite (S [i]);
  303. END;
  304.  
  305. END.
  306.