Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : IBMSCR.DEF

 
Output of file : IBMSCR.DEF contained in archive : MLIFE.ZIP
DEFINITION MODULE IBMSCR;
(*
Title : IBMSCR.DEF

Author : Randall A. Maddox
12209 M Peach Crest Drive
Germantown, MD 20874
(301) 428-9581

System : LOGITECH MODULA-2, Rel. 3.00, AUGUST 1987

Description: This module contains several screen-handling procedures for
the IBM PC/XT/AT and compatible computers. These procedures use the
ROM BIOS video driver services, so compatibility to this level is a MUST!
They have been tested on both the IBM ROM BIOS and the Phoenix ROM BIOS.
Results with a ROM BIOS that is less than 100% compatible are unpredictable.
For further reference on ROM BIOS services see "Advanced MSDOS", Ray Duncan,
1986, Microsoft Press, Redmond, WA. This is where I got my information.

The only restriction on use or distribution of this code is the stipulation
that as the original author my name not be removed from the text of
IBMSCR.DEF or IBMSCR.MOD.

The procedures fall into the following categories:
1) Cursor handling -
PosCur - position the cursor to text coordinates
GetCur - return text coordinates and size of cursor
SetCurTyp - set cursor type
CurOff - hide the cursor
CurOn - restore the cursor
CurShown - return TRUE if cursor NOT hidden, FALSE otherwise
2) Read/write -
ReadCh - read character without echo from standard input
RdStr - read string with echo from standard input
ChAtCur - return character and attribute at cursor
GetFromScr - read characters from specified area of screen
WrtStr - write null-terminated string at current cursor position
WrtXY - write null-terminated string with attribute at X,Y
WNWrtXY - write embedded-null string with attribute at X,Y
WrtLst - write string to standard list device (printer)
PutToScr - write array of CHAR to box on screen with attribute
ClrScr - clear entire screen and home cursor (if shown)
Beep - make distinctive sounding beep
3) Window handling -
MkBox - put box around window
ClrBox - clear a window
GetScr - save contents of a window
PutScr - restore saved contents of window
ScrUp - scroll window up
ScrDn - scroll windown down
4) Check/set video display mode and page -
GetMode - return current display mode, columns, and video page
SetMode - set current display mode
SetPage - set current video page

Together, these procedures allow a simple window approach to screen
management that is very flexible and fast. All the PC/XT/AT video modes
are supported to some degree with restrictions as noted below.

Update History:
Originally written: 8/16/87
Added CurHid flag, GetScr and PutScr procedures: 8/25/87
Added CurOn procedure: 10/21/87
Moved initialization to module body: 10/21/87
Added CurShown procedure: 10/27/87
Added WNWrtXY procedure: 12/27/87
Added PutToScr procedure: 12/30/87
Added GetFromScr procedure, updated for 3.0 compiler: 1/2/88
Added Beep procedure: 1/7/88
Added RdStr and WrtStr procedures: 11/24/88
Added WrtLst procedure: 11/26/88

*)

FROM SYSTEM IMPORT
BYTE,WORD;

EXPORT QUALIFIED
(* video display attributes *)
Norm,Bold,Rev,Und,Blink,BoldUnd,BlinkUnd,BoldBlink,
RevBlink,BoldUndBlink,

(* video display modes *)
BW40X25,C40X25,BWT,CT,CGAmed,CGAmedBO,CGAhi,
MA,EGAmed,EGAhi,EGAmon,EGAhi2,

(* procedures *)
PosCur,GetCur,SetCurTyp,CurOff,CurOn,CurShown,
WrtStr,WrtXY,WNWrtXY,WrtLst,ReadCh,RdStr,ChAtCur,MkBox,ClrBox,ClrScr,
Beep,GetScr,PutScr,PutToScr,GetFromScr,GetMode,SetMode,SetPage,
ScrUp,ScrDn,

(* data types *)
COL,ROW,BOXTYP,ATTRTYP,PAGETYP,MODETYP;

TYPE
(* exported data types *)
COL = [0..79]; (* screen column *)
ROW = [0..24]; (* screen row *)
BOXTYP = [0..4]; (* type of box to draw *)
ATTRTYP = [1H..0F0H]; (* display attributes *)
PAGETYP = [0..7]; (* display pages *)
MODETYP = [0..16]; (* display modes *)

CONST
(* display attribute constants *)
Norm = 007H; (* normal *)
Bold = 00FH; (* high intensity *)
Rev = 070H; (* reversed *)
Und = 001H; (* underlined *)
Blink = 087H; (* normal, blinking *)
BoldUnd = 009H; (* high intensity, underlined *)
BlinkUnd = 081H; (* blinking, underlined *)
BoldBlink = 08FH; (* high intensity, blinking *)
RevBlink = 0F0H; (* reversed, blinking *)
BoldUndBlink = 089H; (* high intensity, underlined, blinking *)

(* video mode constants *)
BW40X25 = 00H; (* 40 X 25 B&W text, color adapter *)
C40X25 = 01H; (* 40 X 25 color text *)
BWT = 02H; (* 80 X 25 B&W text *)
CT = 03H; (* 80 X 25 color text *)
CGAmed = 04H; (* 320 X 200 4-color graphics *)
CGAmedBO = 05H; (* 320 X 200 4-color graphics, color burst off *)
CGAhi = 06H; (* 640 X 200 2-color graphics *)
MA = 07H; (* Monochrome Adapter text display *)
EGAmed = 0DH; (* 320 X 200 16-color graphics *)
EGAhi = 0EH; (* 640 X 200 16-color graphics *)
EGAmon = 0FH; (* 640 X 350 monochrome graphics *)
EGAhi2 = 10H; (* 640 X 350 4- or 16-color graphics (RAM dependent) *)

(* Procedure definitions follow *)

(******************************************************************************)

PROCEDURE PosCur(X : COL; Y : ROW;
VAR Err : CARDINAL);

(* Position cursor on current page to text coordinates X,Y.
Error codes returned are:
0 = no error
1 = invalid X coordinate
2 = cursor is hidden
3 = not page 0 in graphics mode
>> All display modes are supported. Must use Page = 0 in graphics
modes.
*)

(******************************************************************************)

PROCEDURE GetCur(VAR X : COL; VAR Y : ROW;
VAR Start : CARDINAL;
VAR End : CARDINAL;
VAR Err : CARDINAL);

(* Return current text coordinate position of cursor on active page,
and Start and End lines for that cursor.
Error codes returned are:
0 = no error
1 = cursor is currently hidden
>> All display modes are supported.
*)

(******************************************************************************)

PROCEDURE SetCurTyp(Start,End : CARDINAL;
VAR Err : CARDINAL);

(* Set cursor Start and End lines. Valid values are:
Start - 0 to 11 in display mode 07H
- 0 to 6 in other modes
End - 1 to 12 in display mode 07H
- 1 to 7 in other modes
Error codes returned are:
0 = no error
1 = invalid Start for current display mode
2 = invalid End for current display mode
3 = Start > End
4 = not in text mode
>> Only text modes can be supported.
*)

(******************************************************************************)

PROCEDURE CurOff();

(* Turn off the cursor by moving it to a non-displayable location.
Cursor is restored by calling CurOn.
NOTE: Any other procedures that reposition the cursor during their
operation will restore the cursor to its hidden position when done.
No error codes are returned.
*)

(******************************************************************************)

PROCEDURE CurOn();

(* Restore cursor by resetting CurHid flag. Cursor position is NOT
changed by this procedure.
No error codes are returned.
*)

(******************************************************************************)

PROCEDURE CurShown() : BOOLEAN;

(* Return TRUE if cursor is shown, and FALSE if cursor is hidden.
No error codes are returned.
*)

(******************************************************************************)

PROCEDURE ReadCh(VAR Ch : CHAR;
VAR Ascii : BOOLEAN);

(* Read one character from standard input with no echo. If no character
is available, wait until one is. If extended ASCII code is detected
(first char is 0) then the following character is read and returned.
The variable Ascii is FALSE if the value returned in Ch is extended
ASCII. The procedure uses DOS interrupt 21H function 0CH to clear the
input buffer and then function 07H, unfiltered character input without
echo. No special action is taken on Ctrl-C or Ctrl-Break. Input may
be redirected. No error codes are returned.
*)

(******************************************************************************)

PROCEDURE RdStr(VAR Str : ARRAY OF CHAR);

(* Read string from standard input with echo, starting at current cursor
position. Editing characters during input are: BackSpace - if not on
first character of current input string move cursor one space left and
delete character there, Delete - delete character under cursor and move
any following characters one space left, Insert - insert single space
at current cursor position and move following characters one space
right dropping any characters that are pushed past the end of Str, Left
Arrow - move cursor one space left if not on first character of current
input string, Right Arrow - if not at last character of current input
string move cursor one space right, Enter/Return - terminate current
input. Terminating Enter/Return is not returned as part of string. All
characters past last entered prior to Enter/Return will be set to ASCII
null. Cursor is left at current position when terminating Enter/Return
is detected. The procedure uses DOS interrupt 21H function 0CH to clear
the input buffer and then function 07H, unfiltered character input
without echo to read each character. ROM BIOS Video Service, INT 10H
function 09H is used to echo each character, except for the terminating
Enter/Return, to the screen. No special action is taken on Ctrl-C or
Ctrl-Break. Input may be redirected. No error codes are returned.
*)

(******************************************************************************)

PROCEDURE ChAtCur(VAR Ch : CHAR;
VAR Attr : CARDINAL;
VAR Err : CARDINAL);

(* Return the character and attribute at current cursor position on
active display page.
Error codes returned are:
0 = no error
1 = cursor is not displayed
2 = not in Text mode
>> Only text modes are supported.
*)

(******************************************************************************)

PROCEDURE GetFromScr(ULX,LRX : COL; ULY,LRY : ROW;
VAR Scr : ARRAY OF BYTE;
VAR Err : CARDINAL);

(* Put into the Scr array what is the box specified by its upper left
and lower right corners. No attribute data is saved. Data is
from currently active screen page. The smallest box that may be
specified is one character, i.e., LRX = ULX and LRY = ULY.
Calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Scr - array of char to put screen data into
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid display mode
4 = array not large enough to hold specified box
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE WrtStr(Str : ARRAY OF CHAR);

(* Write an arbitrary string of characters; starting at current cursor
position to current video display page. No automatic wraparound at
screen edge and no automatic scroll at screen bottom. Output redirection
is ignored. Special characters such as Carriage Return or Line Feed
are printed as just their character representations and do not perform
any special functions. Cursor is left at position of last character
written, unless cursor is off. This procedure expects a null-terminated
string and will write out Str until the first null or until the end of
the array, whichever comes first. No error codes are returned.
*)

(******************************************************************************)

PROCEDURE WrtXY(X : COL; Y : ROW;
Str : ARRAY OF CHAR;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Write an arbitrary string of characters; starting at position X,Y;
with attribute Attr; to current video display page. No automatic
wraparound at screen edge and no automatic scroll at screen bottom.
Output redirection is ignored. Special characters such as Carriage
Return or Line Feed are printed as just their character representations
and do not perform any special functions. Cursor is left at position
of last character written, unless cursor is off. This procedure
expects a null-terminated string and will write out Str until the
first null or until the end of the array, whichever comes first.
Error codes returned are:
0 = no error
1 = invalid start column
2 = invalid attribute
3 = invalid display mode
>> Only text modes are supported.
*)

(******************************************************************************)

PROCEDURE WNWrtXY(X : COL; Y : ROW;
Str : ARRAY OF CHAR;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Write an arbitrary string of characters; starting at position X,Y;
with attribute Attr; to current video display page. No automatic
wraparound at screen edge and no automatic scroll at screen bottom.
Output redirection is ignored. Special characters such as Carriage
Return or Line Feed are printed as just their character representations
and do not perform any special functions. Cursor is left at position
of last character written, unless cursor is off. This procedure will
always write out all characters from Str[0] through and including
Str[HIGH(Str)] whether or not any null characters are present in
the string.
Error codes returned are:
0 = no error
1 = invalid start column
2 = invalid attribute
3 = invalid display mode
>> Only text modes are supported.
*)

(******************************************************************************)

PROCEDURE WrtLst(Str : ARRAY OF CHAR; VAR Err : CARDINAL);

(* This procedure writes out Str to the current DOS standard list device.
Error codes returned are:
0 = no error
1 = incomplete output
2 = Carry Flag set by DOS
*)

(******************************************************************************)

PROCEDURE PutToScr(ULX,LRX : COL; ULY,LRY : ROW;
VAR Scr : ARRAY OF BYTE;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Put what is in the Scr array into the box specified by its upper left
and lower right corners, each character having the display attribute
Attr. Output is to currently active screen page. The smallest box
that may be specified is one character, i.e., LRX = ULX and
LRY = ULY.
Calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Scr - array of char to put to screen
Attr - one of the exported display attribute values
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid display attribute
4 = invalid display mode
5 = array not large enough to fill specified box
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE ClrScr();

(* Clear the currently active display page and home the cursor. Cursor
can only be homed in text modes or page 0 of graphics modes. Cursor
will not be homed if it is hidden.
No error codes are returned.
>> All display modes are supported.
*)

(****************************************************************************)

PROCEDURE Beep(Count : CARDINAL);

(* Make distinctive sounding beep Count times.
*)

(******************************************************************************)

PROCEDURE MkBox(X : COL; Y : ROW;
Attr : ATTRTYP;
BType : BOXTYP;
Width,Height : CARDINAL;
VAR Err : CARDINAL);

(* Draw a box with all four corners on current display page. Output
redirection is ignored. Cursor is left at bottom of right side of box,
unless the cursor is hidden. The smallest box that may be drawn will
have a width and height of 3. This allows for each corner and one
side/top/bottom line per side. One character may be placed into this
smallest box.
The calling parameters are:
X - x-coordinate of upper left corner, 0 to 77
Y - y-coordinate of upper left corner, 0 to 23
Width - width of box in columns, 3 to 80
Height - height of box in rows, 3 to 26
Attr - display attribute to use
BType - type of box to draw. Possibilities are:
0 = use ASCII space for box characters
1 = draw single line box
2 = draw double line box
3 = draw box with single line sides and double
line top and bottom
4 = draw box using +, - and |
Error codes returned are:
0 = no error
1 = invalid X coordinate
2 = invalid Y coordinate
3 = invalid height
4 = invalid width
5 = invalid attribute
6 = not in Text mode
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE ClrBox(ULX,LRX : COL; ULY,LRY : ROW;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Clear box specified by its upper left and lower right corners. Attr is
attribute of cleared area. Box is cleared on currently active display
page. The smallest box that may be cleared is one character space,
i.e., LRX = ULX and LRY = ULY.
Calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Attr - display attribute of cleared area
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid attribute
4 = invalid display mode
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE GetScr(ULX,LRX : COL; ULY,LRY : ROW;
VAR Scr : ARRAY OF WORD;
Page : PAGETYP;
VAR Err : CARDINAL);

(* Get what is on the screen in the box specified by its upper left and
lower right corners. Page is the display page to get from and Scr
is an ARRAY OF WORD[] big enough to hold one WORD for each CHAR in the
specified box, since it gets both the character and attribute at each
location. The smallest box that may be specified is a single character,
i.e., LRX = ULX and LRY = ULY.
Calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Page - display page to use
Scr - starting address of buffer
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid page for current mode
4 = invalid display mode
5 = Scr not large enough to hold data
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE PutScr(ULX,LRX : COL; ULY,LRY : ROW;
VAR Scr : ARRAY OF WORD;
Page : PAGETYP;
VAR Err : CARDINAL);

(* Put what is in the buffer into the box specified by its upper left and
lower right corners. Page is the display page to put to and Scr
is an ARRAY OF WORD[] that has one WORD for each CHAR in the box,
since each word represents both the character and attribute at each
location. NOTE WELL, that should Scr contain something other than
screen data, it will still be written to the screen as character/
attribute pairs. Sometimes this may lead to interesting displays.
The smallest box that may be specified is one character, i.e.,
LRX = ULX and LRY = ULY.
Calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Page - display page to use
Scr - array of data to put to screen
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid page for current mode
4 = invalid display mode
5 = Scr not large enough to fill box
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE ScrUp(ULX,LRX : COL; ULY,LRY : ROW;
Lines : CARDINAL;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Scroll or blank an area of the screen. If Lines = 0 the specified area
is blanked with attribute Attr, otherwise the specified area is scrolled
up Lines lines with text scrolled beyond the top of the window being
lost and new blank lines being scrolled in having the attribute Attr.
The window is on the currently active display page. The smallest box
that may be specified is one character, i.e., LRX = ULX and LRY = ULY.
The calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Lines - number of lines to scroll
Attr - attribute to use for blank lines scrolled into area
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid attribute
4 = invalid display mode
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE ScrDn(ULX,LRX : COL; ULY,LRY : ROW;
Lines : CARDINAL;
Attr : ATTRTYP;
VAR Err : CARDINAL);

(* Scroll or blank an area of the screen. If Lines = 0 the specified area
is blanked with attribute Attr, otherwise the specified area is scrolled
down Lines lines with text scrolled below the bottom of the window being
lost and new blank lines being scrolled in having the attribute Attr.
The window is on the currently active display page. The smallest box
that may be specified is one character, i.e., LRX = ULX and LRY = ULY.
The calling parameters are:
ULX - X-coordinate of upper left corner (0 to 78)
ULY - Y-coordinate of upper left coordinate (0 to 24)
LRX - X-coordinate of lower right corner (1 to 79)
LRY - Y-coordinate of lower right corner (1 to 25)
Lines - number of lines to scroll
Attr - attribute to use for blank lines scrolled into area
Error codes returned are:
0 = no error
1 = coordinates do not specify UL and LR corners of rectangle
2 = one or both X-coordinates out of range
3 = invalid attribute
4 = invalid display mode
>> Only text display modes are supported.
*)

(******************************************************************************)

PROCEDURE GetMode(VAR Cols : CARDINAL;
VAR Mode : CARDINAL;
VAR Page : CARDINAL);

(* Return the number of character columns on the screen, the current
display mode, and the currently active display page. No error codes
are returned. See SetMode below for list of display modes.
*)

(******************************************************************************)

PROCEDURE SetMode(Mode : MODETYP;
Clear : BOOLEAN;
VAR NewMode : CARDINAL;
VAR Err : CARDINAL);

(* Set the current display mode as listed below. If Clear = TRUE,
the display buffer will be cleared when the new mode is selected.
If Clear = FALSE, it will not. The procedure may fail if you
select a mode that your hardware does not support. To check this,
the current display mode is tested after the set and the new display
mode is returned in NewMode. If NewMode <> Mode, then you know the
procedure failed. You may also discover this when strange things
happen after calling this procedure. Check the list below and make
sure you only call it with values that your hardware actually supports.
The display modes are:
00H = 40 X 25 B&W text, color adapter
01H = 40 X 25 color text
02H = 80 X 25 B&W text
03H = 80 X 25 color text
04H = 320 X 200 4-color graphics
05H = 320 X 200 4-color graphics, color burst off
06H = 640 X 200 2-color graphics
07H = Monochrome Adapter text display
08H - 0AH = PCjr modes not supported here
0DH = 320 X 200 16-color graphics, EGA
0EH = 640 X 200 16-color graphics, EGA
0FH = 640 X 350 monochrome graphics, EGA
10H = 640 X 350 4- or 16-color graphics, EGA (RAM size dependent)
Error codes returned are:
0 = no error
1 = invalid display mode
*)
(******************************************************************************)

PROCEDURE SetPage(Page : PAGETYP;
VAR Err : CARDINAL);

(* Select active display page. Valid Page selections are:
0 thru 7 for modes 00H, 01H and 0DH
0 thru 3 for modes 02H, 03H and 0EH
0 or 1 for modes 0FH and 10H
0 only for modes 04H thru 07H
Error codes returned are:
0 = no error
1 = invalid Page for current display mode
*)

(******************************************************************************)

END IBMSCR.

(* end of this file *)


  3 Responses to “Category : Modula II Source Code
Archive   : MLIFE.ZIP
Filename : IBMSCR.DEF

  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/