Category : Modula II Source Code
Archive   : MODULA-2.ZIP
Filename : PCSCREEN.MOD

 
Output of file : PCSCREEN.MOD contained in archive : MODULA-2.ZIP
IMPLEMENTATION MODULE PcScreen;

(*
Author: John Tal
Inspired by John Beidler & Paul Jockowitz

Last Edit: 04/02/1986
based on changes made by Donald Dumitru to run on ITC's M2SDS
*)

FROM Strings IMPORT Length;
FROM MachDep IMPORT Locate;
FROM SYSTEM IMPORT ADDRESS;

CONST
RowMx = 25;
ColMx = 80;
ColorScreen = 0B800H;
MonoScreen = 0B000H;


TYPE
ChRecord = RECORD
Code, Attr : CHAR
END;


VAR
Screen : POINTER TO ARRAY[1..RowMx], [1..ColMx] OF ChRecord;
ScreenAdr,equipCheckAdr : ADDRESS;
equipCheck : POINTER TO BITSET;


PROCEDURE RowAdj(Row:CARDINAL) : CARDINAL;
BEGIN
RETURN(Row-1) MOD RowMx+1
END RowAdj;

PROCEDURE ColAdj(Col:CARDINAL) : CARDINAL;
BEGIN
RETURN(Col-1) MOD ColMx+1
END ColAdj;

PROCEDURE Cls();
VAR r,c : CARDINAL;
BEGIN
Locate(1,1);
FOR r := 25 TO 1 BY -1 DO (* clear by scrolling up / not trad. down *)
FOR c := 1 TO 80 DO
Screen^[r,c].Code := ' ';
Screen^[r,c].Attr := CHR(119);
END
END
END Cls;

PROCEDURE EraseLine(Row : CARDINAL);
VAR c : CARDINAL;
BEGIN
Row := RowAdj(Row);
FOR c := 1 TO 80 DO
Screen^[Row,c].Code := ' ';
Screen^[Row,c].Attr := CHR(119);
END
END EraseLine;

PROCEDURE ColorAdj( Color : CARDINAL) : CARDINAL;
BEGIN
CASE Color OF
1 : RETURN 113 | (* underline *)
7 : RETURN 119 | (* normal *)
9 : RETURN 121 | (* bright/underline *)
15 : RETURN 127 | (* bright *)
17 : RETURN 241 | (* blink/underline *)
23 : RETURN 247 | (* blink *)
25 : RETURN 249 | (* bright/blink/underline *)
31 : RETURN 255 | (* bright/blink *)
112 : RETURN 112 (* inverse *)
ELSE
RETURN 7
END;
END ColorAdj;

PROCEDURE DisplayString(Row,Col,Color : CARDINAL; Str : ARRAY OF CHAR);
VAR I : CARDINAL;
BEGIN
IF Length(Str) > 0 THEN
Color := ColorAdj(Color);
Row := RowAdj(Row); Col := ColAdj(Col);
FOR I := 0 TO (Length(Str)-1) DO
Screen^[Row,Col+I].Code := Str[I];
Screen^[Row,Col+I].Attr := CHR(Color);
END;
END;
END DisplayString;

PROCEDURE DisplayStringMid(Row,Col,Color : CARDINAL; Str : ARRAY OF CHAR;
beg,len : CARDINAL);
VAR
I : CARDINAL;
BEGIN
Color := ColorAdj(Color);
Row := RowAdj(Row); Col := ColAdj(Col);
FOR I := beg TO (beg+len-1) DO
Screen^[Row,Col+I-beg].Code := Str[I];
Screen^[Row,Col+I-beg].Attr := CHR(Color);
END; (* for i *)
END DisplayStringMid;

PROCEDURE WriteScreenChar(Row,Col,Color : CARDINAL; Letter : CHAR);
BEGIN
Color := ColorAdj(Color);
Row := RowAdj(Row); Col := ColAdj(Col);
Screen^[Row,Col].Code := Letter;
Screen^[Row,Col].Attr := CHR(Color);
END WriteScreenChar;

PROCEDURE ReadScreenChar(Row,Col : CARDINAL) : CHAR;
BEGIN
Row := RowAdj(Row); Col := ColAdj(Col);
RETURN(Screen^[Row,Col].Code);
END ReadScreenChar;

PROCEDURE WriteScreenCol(Row,Col,Color : CARDINAL);
BEGIN
Row := RowAdj(Row); Col := ColAdj(Col);
Screen^[Row,Col].Attr := CHR(Color);
END WriteScreenCol;

PROCEDURE ReadScreenCol(Row,Col : CARDINAL) : CARDINAL;
BEGIN
Row := RowAdj(Row); Col := ColAdj(Col);
RETURN(ORD(Screen^[Row,Col].Attr));
END ReadScreenCol;

BEGIN
equipCheckAdr.SEGMENT := 0H;
equipCheckAdr.OFFSET := 0410H;

equipCheck := equipCheckAdr;

(* IF [0:0410H] AND 30H <> 30H then color else mono *)

IF (equipCheck^ * {5,4}) <> {5,4} THEN
ScreenAdr.SEGMENT := ColorScreen;
ELSE
ScreenAdr.SEGMENT := MonoScreen;
END;

ScreenAdr.OFFSET := 0H;

Screen := ScreenAdr;
END PcScreen.


  3 Responses to “Category : Modula II Source Code
Archive   : MODULA-2.ZIP
Filename : PCSCREEN.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/