Category : Modula II Source Code
Archive   : CONSOLE.ZIP
Filename : CONSOLE.MOD

 
Output of file : CONSOLE.MOD contained in archive : CONSOLE.ZIP
IMPLEMENTATION MODULE Console;

(************************************************************************)
(* COPYRIGHT 1988 by David Albert *)
(* You may use this module in any of your work and distribute it freely *)
(* Provided that: 1) The copyright notice is not changed or removed *)
(* 2) The module is not modified *)
(* 3) Under NO conditions is this module to be sold *)
(************************************************************************)

IMPORT ASCII;
FROM SYSTEM IMPORT ASSEMBLER;
FROM TermBase IMPORT AssignWrite, UnAssignWrite;

CONST BIOSVidInt = 10H;
SetMode = 0000H; (* Set video mode 0-7 *)
GetMode = 0F00H; (* Get current video mode *)
SetCurSize = 0100H; (* Set cursor size 0-7 or 0-13 *)
MoveCursor = 0200H; (* Move cursor to position X,Y *)
CursorPos = 0300H; (* Get current cursor position *)
ReadLtPen = 0400H; (* Get light pen position and status *)
SetPage = 0500H; (* Set video page 0-7 or 0-3 *)
ScrlUp = 0600H; (* Scroll a window up N lines *)
ScrlDn = 0700H; (* Scroll a window down N lines *)
GetChAttr = 0800H; (* Get character and attribute at X,Y *)
PutChAttr = 0900H; (* Put character and attribute to X,Y *)
PutCh = 0A00H; (* Put character at X,Y leave cur. attr *)
SetColor = 0B00H; (* Set color in modes 1-4 *)
WritePixel = 0C00H; (* Set the color of a pixel X,Y *)
ReadPixel = 0D00H; (* Get the color of pixel X,Y *)
WriteTTY = 0E00H; (* Teletype character output *)

VAR WriteStolen : BOOLEAN;

PROCEDURE ClearScreen ();
BEGIN
ScrollUp(0); (* Clear Screen via BIOS *)
GotoXY(1,1); (* Home cursor *)
END ClearScreen;

PROCEDURE ClearEOL();
VAR NumSpaces : CARDINAL;
BEGIN
NumSpaces := CurWindow.X2 - WhereX();
PutChar(' ',NumSpaces);
END ClearEOL;

PROCEDURE GetVidCh() : CARDINAL;
VAR Char : CARDINAL;
BEGIN
ASM
MOV AH, 08H
MOV BX, 00H
PUSH BP
INT 10H
POP BP
MOV Char, AX
END;
RETURN Char;
END GetVidCh;

PROCEDURE GetVidMode() : CARDINAL;
VAR Mode : CARDINAL;
BEGIN
ASM
MOV AH, 0FH (* Setup to read video mode *)
PUSH BP
INT 10H (* Perform interrupt *)
POP BP
MOV Mode, AX (* Mode returned in AH (scr width in AL) *)
END;
Mode := Mode MOD 100H; (* Separate mode and screen width *)
RETURN Mode;
END GetVidMode;

PROCEDURE GotoXY (X,Y : CARDINAL);
VAR Position : CARDINAL;
BEGIN
X := X + CurWindow.X1 - 1; (* Adjust coordinates to *)
Y := Y + CurWindow.Y1 - 1; (* current window *)
WITH CurWindow DO
IF (X >= X1) AND (X <= X2) AND (* Test to see if point X,Y *)
(Y >= Y1) AND (Y <= Y2) (* falls within window *)
THEN (* If so, then *)
Position := (Y-1) * 100H + (X-1); (* Convert position to word *)
ASM
MOV AH, 02H
MOV BX, 00H (* Set video page to 0 *)
MOV DX, Position (* Store position in DX *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
END;
END;
END;
END GotoXY;

PROCEDURE Highlight();
BEGIN
CurWindow.Attribute := 15;
END Highlight;

PROCEDURE Inverse ();
BEGIN
CurWindow.Attribute := 112;
END Inverse;

PROCEDURE KeyPressed () : BOOLEAN;
VAR Result : CHAR;
BEGIN
ASM
MOV AH, 0BH
INT 21H
MOV Result, AL
END;
RETURN (Result <> 0C)
END KeyPressed;

PROCEDURE Normal();
BEGIN
CurWindow.Attribute := 7;
END Normal;

PROCEDURE PutChar (Ch : CHAR; Num : CARDINAL);
VAR Attr : CARDINAL;
BEGIN
IF (Num > 0) THEN
Attr := CurWindow.Attribute;
ASM
MOV AH, 09H (* Set up for function call *)
MOV AL, Ch (* Load character into AL *)
MOV BX, Attr (* Load vid page and attr into BX *)
MOV CX, Num (* CX gets number of characters to write *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
END;
END;
END PutChar;

PROCEDURE PutVidCh (ChAttr : CARDINAL);
VAR Char : CHAR;
Attr : CARDINAL;
BEGIN
Char := CHR(ChAttr MOD 100H);
Attr := ChAttr DIV 100H;
ASM
MOV AH, 09H (* Setup for BIOS call *)
MOV AL, Char (* Load character into AL *)
MOV BX, Attr (* Load video page and attribute into BX *)
MOV CX, 01H (* CX gets number of characters to write *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
END;
END PutVidCh;

PROCEDURE Read(VAR Ch : CHAR);
VAR Key : CHAR;
BEGIN
ASM
MOV AH, 08
INT 21H
MOV Key, AL
END;
Ch := Key;
END Read;

PROCEDURE ScrollDown(Lines : CARDINAL) ;
VAR TL,BR : CARDINAL;
BEGIN
WITH CurWindow DO
TL := Y1 * 100H + X1; (* calculate top left corner*)
BR := Y2 * 100H + X2; (* calculate bot rt. corner *)
END;
Lines := Lines + 0700H; (* Setup to scroll down *)
ASM
MOV AX, Lines (* Set lines to scroll *)
MOV BX, 0700H (* Set attr. for new lines *)
MOV CX, TL (* Store top left in CX *)
MOV DX, BR (* Store bottom right in DX *)
PUSH BP (* PUSH BP *)
INT 10H (* Call BIOS video interrupt*)
POP BP (* POP BP *)
END;
END ScrollDown ;

PROCEDURE ScrollUp(Lines : CARDINAL) ;
VAR TL,BR : CARDINAL;
BEGIN
WITH CurWindow DO
TL := (Y1-1) * 100H + (X1-1); (* calculate top left corner*)
BR := (Y2-1) * 100H + (X2-1); (* calculate bot rt. corner *)
END;
Lines := Lines + 0600H; (* Setup to scroll up *)
ASM
MOV AX, Lines (* Set lines to scroll *)
MOV BX, 0700H (* Set attr. for new lines *)
MOV CX, TL (* Store top left in CX *)
MOV DX, BR (* Store bottom right in DX *)
PUSH BP (* PUSH BP *)
INT 10H (* BIOS Video interrupt *)
POP BP (* POP BP *)
END;
END ScrollUp ;

PROCEDURE SetCursorSize(Top, Bottom : CARDINAL);
BEGIN
ASM
MOV AH, 01
MOV CH, BYTE Top
MOV CL, BYTE Bottom
PUSH BP
INT 10H
POP BP
END;
END SetCursorSize;

PROCEDURE SetVidMode (Mode : CARDINAL);
BEGIN
ASM
MOV AX, Mode (* Load AX with new video mode *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
END;
END SetVidMode;

PROCEDURE WhereX () : CARDINAL;
VAR Pos : CARDINAL;
BEGIN
ASM
MOV AH, 03H (* BIOS Call to read cursor position *)
MOV BX, 00H (* Set current video page to 0 *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
MOV Pos, DX (* Read cursor position from DX *)
END;
Pos := (Pos MOD 100H)+1; (* separate X position *)
WITH CurWindow DO
IF (Pos >= X1) AND (Pos <=X2)
THEN Pos := Pos - X1 + 1;
ELSE Pos := 0;
END;
END;
RETURN Pos;
END WhereX;

PROCEDURE WhereY () : CARDINAL;
VAR Pos : CARDINAL;
BEGIN
ASM
MOV AH, 03H (* Prepare to read cursor position *)
MOV BX, 00H (* Set current video page to 0 *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
MOV Pos, DX (* Read cursor position from DX *)
END;
Pos := (Pos DIV 100H)+1; (* separate Y position *)
WITH CurWindow DO
IF (Pos >= Y1) AND (Pos <= Y2)
THEN Pos := Pos - Y1 + 1;
ELSE Pos := 0;
END;
END;
RETURN Pos;
END WhereY;

PROCEDURE Window(X1, Y1, X2, Y2 : CARDINAL);
BEGIN
CurWindow.X1 := X1; CurWindow.Y1 := Y1;
CurWindow.X2 := X2; CurWindow.Y2 := Y2;
END Window;

PROCEDURE WriteChar (Ch : CHAR);
BEGIN
ASM
MOV AH, 0EH (* Use teletype output *)
MOV AL, Ch (* Char to be printed goes in AL *)
PUSH BP (* PUSH BP *)
INT 10H (* Perform interrupt *)
POP BP (* POP BP *)
END;
END WriteChar;

PROCEDURE Write (Ch : CHAR);
BEGIN
WITH CurWindow DO
CASE Ch OF
ASCII.EOL: IF (WhereY() < (Y2 - Y1) )
THEN GotoXY(1,(WhereY()+1));
ELSE ScrollUp(1);
GotoXY(1,Y2-Y1);
END;
| ASCII.CR : IF (WhereY() < (Y2 - Y1) )
THEN GotoXY(1,(WhereY()+1));
ELSE ScrollUp(1);
GotoXY(1,Y2-Y1);
END;
| ASCII.LF : IF (WhereY() < (Y2-Y1) )
THEN GotoXY(WhereX(),(WhereY() + 1));
ELSE ScrollUp(1);
GotoXY(WhereX(),Y2-Y1);
END;
| ASCII.BS : IF (WhereX() > 1)
THEN GotoXY((WhereX()-1),WhereY());
END;
| ASCII.BEL: WriteChar(07C);
ELSE PutChar(Ch,1);
IF (WhereX() >= (X2-X1+1))
THEN IF (WhereY() = (Y2-Y1+1))
THEN ScrollUp(1);
GotoXY(1,Y2-Y1+1);
ELSE GotoXY(1,(WhereY()+1));
END;
ELSE GotoXY((WhereX()+1),WhereY());
END;
END; (* Case statment *)
END; (* With CurWindow Do *)
END Write;

PROCEDURE WriteLn ();
BEGIN
Write(ASCII.CR);
END WriteLn;

PROCEDURE WriteString(S : ARRAY OF CHAR);
VAR Ndx : CARDINAL;
BEGIN
Ndx := 0;
WHILE (Ndx <= HIGH(S)) AND (S[Ndx] # 0C) DO
Write(S[Ndx]);
INC(Ndx);
END;
END WriteString;

PROCEDURE StealWrite ();
BEGIN
IF (NOT WriteStolen) THEN
AssignWrite(Write,WriteStolen);
END;
END StealWrite;

PROCEDURE ReturnWrite ();
BEGIN
IF WriteStolen THEN
UnAssignWrite(WriteStolen);
WriteStolen := NOT WriteStolen;
END;
END ReturnWrite;

BEGIN
WriteStolen := FALSE;
Window(1,1,ScreenSizeX,ScreenSizeY);
Normal();
StealWrite;
END Console.


  3 Responses to “Category : Modula II Source Code
Archive   : CONSOLE.ZIP
Filename : CONSOLE.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/