Columbia Kermit/kermit.zip/os2pm/screen.mod

Text File | 2020-01-01 | 7KB | 327 lines

IMPLEMENTATION MODULE Screen;
(* module to perform "low level" screen functions (via AVIO) *)

   IMPORT ASCII;

   FROM SYSTEM IMPORT
      ADR;

   FROM Strings IMPORT
      Length;

   FROM Conversions IMPORT
      IntToString;

   FROM KH IMPORT
      IDM_GREEN;

   FROM Vio IMPORT
      VioSetCurPos, VioGetCurPos, VioScrollUp,
      VioWrtNCell, VioWrtTTY, VioCell;


   CONST
      GREY = 07H;
      WHITE = 0FH;
      REV_GY = 70H;
      GREEN = 02H;
      LITE_GRN = 0AH;
      REV_GRN = 20H;
      AMBER = 06H;
      LITE_AMB = 0EH;
      REV_AMB = 60H;
      RED = 0CH;
      CY_BK = 0B0H;
      CY_BL = 0B9H;
      REV_RD = 0CFH;
      REV_BL = 9FH;
      MAGENTA = 05H;


   VAR
      (* From Definition Module
      NORMAL : CARDINAL;
      HIGHLIGHT : CARDINAL;
      REVERSE : CARDINAL;
        attribute : CARDINAL;
      hvps : HVPS;
      *)
       x, y : CARDINAL;
       bCell : VioCell;


   PROCEDURE White;
   (* Sets up colors: Monochrome White *)
      BEGIN
         NORMAL := GREY;
         HIGHLIGHT := WHITE;
         REVERSE := REV_GY;
         attribute := NORMAL;
      END White;


   PROCEDURE Green;
   (* Sets up colors: Monochrome Green *)
      BEGIN
         NORMAL := GREEN;
         HIGHLIGHT := LITE_GRN;
         REVERSE := REV_GRN;
         attribute := NORMAL;
      END Green;


   PROCEDURE Amber;
   (* Sets up colors: Monochrome Amber *)
      BEGIN
         NORMAL := AMBER;
         HIGHLIGHT := LITE_AMB;
         REVERSE := REV_AMB;
         attribute := NORMAL;
      END Amber;


   PROCEDURE Color1;
   (* Sets up colors: Blue, Red, Green *)
      BEGIN
         NORMAL := GREEN;
         HIGHLIGHT := RED;
         REVERSE := REV_BL;
         attribute := NORMAL;
      END Color1;


   PROCEDURE Color2;
   (* Sets up colors: Cyan Background; Black, Blue, White-on-Red *)
      BEGIN
         NORMAL := CY_BK;
         HIGHLIGHT := CY_BL;
         REVERSE := REV_RD;
         attribute := NORMAL;
      END Color2;


   PROCEDURE HexToString (num : INTEGER;
                          size : CARDINAL;
                          VAR buf : ARRAY OF CHAR;
                          VAR I : CARDINAL;
                          VAR Done : BOOLEAN);
   (* Local Procedure to convert a number to a string, represented in HEX *)

      CONST
         ZERO = 30H;   (* ASCII code *)
         A = 41H;

      VAR
         i : CARDINAL;
         h : CARDINAL;
         t : ARRAY [0..10] OF CHAR;

      BEGIN
         i := 0;
         REPEAT
            h := num MOD 16;
            IF h <= 9 THEN
               t[i] := CHR (h + ZERO);
            ELSE
               t[i] := CHR (h - 10 + A);
            END;
            INC (i);
            num := num DIV 16;
         UNTIL num = 0;

         IF (size > HIGH (buf)) OR (i > HIGH (buf)) THEN
            Done := FALSE;
            RETURN;
         ELSE
            Done := TRUE;
         END;

         WHILE size > i DO
            buf[I] := '0';   (* pad with zeros *)
            DEC (size);
            INC (I);
         END;

         WHILE i > 0 DO
            DEC (i);
            buf[I] := t[i];
            INC (I);
         END;

         buf[I] := 0C;
      END HexToString;


   PROCEDURE ClrScr;
   (* Clear the screen, and home the cursor *)
      BEGIN
         bCell.ch := ' ';     (* space = blank screen *)
         bCell.attr := CHR (NORMAL);    (* Normal Video Attribute *)
         VioScrollUp (0, 0, 24, 79, 25, bCell, hvps);
         GotoXY (0, 0);
      END ClrScr;



   PROCEDURE ClrEol;
   (* clear from the current cursor position to the end of the line *)
      BEGIN
         GetXY (x, y);     (* current cursor position *)
         bCell.ch := ' ';    (* space = blank *)
         bCell.attr := CHR (NORMAL);   (* Normal Video Attribute *)
         VioScrollUp (y, x, y, 79, 1, bCell, hvps);
      END ClrEol;


   PROCEDURE Right;
   (* move cursor to the right *)
      BEGIN
         GetXY (x, y);
         INC (x);
         GotoXY (x, y);
      END Right;


   PROCEDURE Left;
   (* move cursor to the left *)
      BEGIN
         GetXY (x, y);
         DEC (x);
         GotoXY (x, y);
      END Left;


   PROCEDURE Up;
   (* move cursor up *)
      BEGIN
         GetXY (x, y);
         DEC (y);
         GotoXY (x, y);
      END Up;


   PROCEDURE Down;
   (* move cursor down *)
      BEGIN
         GetXY (x, y);
         INC (y);
         GotoXY (x, y);
      END Down;


   PROCEDURE GotoXY (col, row : CARDINAL);
   (* position cursor at column, row *)
      BEGIN
         IF (col <= 79) AND (row <= 24) THEN
            VioSetCurPos (row, col, hvps);
         END;
      END GotoXY;


   PROCEDURE GetXY (VAR col, row : CARDINAL);
   (* determine current cursor position *)
      BEGIN
         VioGetCurPos (row, col, hvps);
      END GetXY;


   PROCEDURE Write (c : CHAR);
   (* Write a Character *)
      BEGIN
         WriteAtt (c);
      END Write;


   PROCEDURE WriteString (str : ARRAY OF CHAR);
   (* Write String *)

      VAR
         i : CARDINAL;
         c : CHAR;

      BEGIN
         i := 0;
         c := str[i];
         WHILE c # 0C DO
            Write (c);
            INC (i);
            c := str[i];
         END;
      END WriteString;


   PROCEDURE WriteInt (n : INTEGER; s : CARDINAL);
   (* Write Integer *)

      VAR
         i : CARDINAL;
         b : BOOLEAN;
         str : ARRAY [0..6] OF CHAR;

      BEGIN
         i := 0;
         IntToString (n, s, str, i, b);
         WriteString (str);
      END WriteInt;


   PROCEDURE WriteHex (n, s : CARDINAL);
   (* Write a Hexadecimal Number *)

      VAR
         i : CARDINAL;
         b : BOOLEAN;
         str : ARRAY [0..6] OF CHAR;

      BEGIN
         i := 0;
         HexToString (n, s, str, i, b);
         WriteString (str);
      END WriteHex;


   PROCEDURE WriteLn;
   (* Write <cr> <lf> *)
      BEGIN
         Write (ASCII.cr);   Write (ASCII.lf);
      END WriteLn;


   PROCEDURE WriteAtt (c : CHAR);
   (* write character and attribute at cursor position *)

      VAR
         s : ARRAY [0..1] OF CHAR;

      BEGIN
         GetXY (x, y);
         IF (c = ASCII.ht) THEN
            bCell.ch := ' ';
            bCell.attr := CHR (attribute);
            REPEAT
               VioWrtNCell (bCell, 1, y, x, hvps);
               Right;
            UNTIL (x MOD 8) = 0;
         ELSIF (c = ASCII.cr) OR (c = ASCII.lf)
          OR (c = ASCII.bel) OR (c = ASCII.bs) THEN
            s[0] := c;    s[1] := 0C;
            VioWrtTTY (ADR (s), 1, hvps);
            IF c = ASCII.lf THEN
               ClrEol;
            END;
         ELSE
            bCell.ch := c;
            bCell.attr := CHR (attribute);
            VioWrtNCell (bCell, 1, y, x, hvps);
            Right;
         END;
      END WriteAtt;

BEGIN     (* module initialization *)
   ColorSet := IDM_GREEN;
   NORMAL := GREEN;
   HIGHLIGHT := LITE_GRN;
   REVERSE := REV_GRN;
   attribute := NORMAL;
END Screen.