home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
os2pm.tar.gz
/
os2pm.tar
/
screen.mod
< prev
next >
Wrap
Text File
|
1990-08-27
|
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.