home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
modula2
/
library
/
tasking
/
screenbi.mod
< prev
next >
Wrap
Text File
|
1986-03-10
|
11KB
|
405 lines
IMPLEMENTATION MODULE ScreenBIOS;
FROM SYSTEM IMPORT SWI, SETREG, GETREG, AX, BX, CX, DX, CODE;
(*
This module will use screen coordinates as defined by Wirth (0,0 is the
lower left hand corner of the page), FOR GRAPHICS ONLY. Text coordinates
are defined with 0,0 in the upper left hand corner of the screen.
Page refers to page number defined as 0 to 7 for lowResText, 0 to 3 for
hiResText, and 0 for graphics.
*)
TYPE
aRegister = RECORD
CASE BOOLEAN OF
TRUE: reg: CARDINAL;
| FALSE: lo, hi : CHAR;
END;
END;
VAR
regA, regB, regC, regD: CARDINAL;
anyReg: aRegister;
initial: settings;
ch: CHAR;
PROCEDURE SetScreenMode(newMode: screenMode);
BEGIN
CASE newMode OF
mono40x25, col40x25:
current.window.rightMargin := 39;
current.maxGraphX := -1;
current.maxGraphY := -1;
| col320x200, mono320x200:
current.window.rightMargin := 39;
current.maxGraphX := 319;
current.maxGraphY := 199;
| bw80x25, mono80x25, col80x25:
current.window.rightMargin := 79;
current.maxGraphX := -1;
current.maxGraphY := -1;
| mono640x200:
current.window.rightMargin := 79;
current.maxGraphX := 639;
current.maxGraphY := 199;
END;
anyReg.lo := CHR(ORD(newMode));
anyReg.hi := 0C; (* Function Code 0 *)
regA := anyReg.reg;
SETREG(AX, regA);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
WITH current DO
GetVideoState(mode, numCols, page);
END;
END SetScreenMode;
PROCEDURE SetCursorType(startScan, endScan : CARDINAL);
BEGIN
anyReg.hi := CHR(1); (* Function Code 1 *)
regA := anyReg.reg;
anyReg.lo := CHR(endScan);
anyReg.hi := CHR(startScan);
regC := anyReg.reg;
SETREG(AX,regA);
SETREG(CX,regC);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END SetCursorType;
PROCEDURE PutCursor(row, col, page : CARDINAL);
BEGIN
anyReg.hi := CHR(2); (* Function Code 2 *)
regA := anyReg.reg;
anyReg.hi := CHR(page);
regB := anyReg.reg;
anyReg.lo := CHR(col);
anyReg.hi := CHR(row);
regD := anyReg.reg;
SETREG(AX, regA);
SETREG(BX, regB);
SETREG(DX, regD);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END PutCursor;
PROCEDURE GetCursor(VAR row, column : CARDINAL;
page : CARDINAL;
VAR startScan, endScan : CARDINAL);
(* Returns both cursor position and cursor type. *)
BEGIN
anyReg.hi := CHR(3); (* Function Code 3 *)
regA := anyReg.reg;
anyReg.hi := CHR(page);
regB := anyReg.reg;
SETREG(AX, regA);
SETREG(BX, regB);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
GETREG(CX, regC);
GETREG(DX, regD);
anyReg.reg := regC;
endScan := ORD(anyReg.lo);
startScan := ORD(anyReg.hi);
anyReg.reg := regD;
column := ORD(anyReg.lo);
row := ORD(anyReg.hi);
END GetCursor;
PROCEDURE CursorOff;
BEGIN
WITH current DO (* save current settings for cursor on *)
GetCursor(cursY,cursX, page, cursorStart, cursorEnd);
END;
SetCursorType(26H,7H);
END CursorOff;
PROCEDURE CursorOn;
BEGIN
SetCursorType(current.cursorStart, current.cursorEnd);
END CursorOn;
PROCEDURE RestoreScreen; (* Restore screen to initial entry params *)
BEGIN
WITH initial DO
SelectActivePage(page);
SetScreenMode(mode);
ClearScreen(attrib);
SetCursorType(cursorStart, cursorEnd);
END;
END RestoreScreen;
PROCEDURE ReadLightPenPosition(VAR x, y: CARDINAL);
(* Not implemented *)
BEGIN
(*
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
*)
END ReadLightPenPosition;
PROCEDURE SelectActivePage(page : CARDINAL);
BEGIN
anyReg.lo := CHR(page);
anyReg.hi := CHR(5); (* Function Code 5 *)
regA := anyReg.reg;
SETREG(AX, regA);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END SelectActivePage;
PROCEDURE ScrollUp(lines: CARDINAL; window: area; attr: CARDINAL);
BEGIN
WITH anyReg DO
lo := CHR(lines);
hi := CHR(6); (* Function Code 6 *)
regA := reg;
hi := CHR(attr);
regB := reg;
WITH window DO
lo := CHR(leftMargin);
hi := CHR(topMargin);
regC := reg; (* upper left *)
lo := CHR(rightMargin);
hi := CHR(bottomMargin);
regD := reg; (* lower right *)
END;
END;
SETREG(AX, regA);
SETREG(BX, regB);
SETREG(CX, regC);
SETREG(DX, regD);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END ScrollUp;
PROCEDURE ClearScreen(attr: CARDINAL);
BEGIN
WITH current DO
PutCursor(0,0,page);
ScrollUp(0, window, attr);
END;
END ClearScreen;
PROCEDURE ScrollDown(lines: CARDINAL; window: area; attr: CARDINAL);
BEGIN
WITH anyReg DO
lo := CHR(lines);
hi := CHR(7); (* Function Code 7 *)
regA := reg;
hi := CHR(attr);
regB := reg;
WITH window DO
lo := CHR(leftMargin);
hi := CHR(topMargin);
regC := reg; (* upper left *)
lo := CHR(rightMargin);
hi := CHR(bottomMargin);
regD := reg; (* lower right *);
END;
END;
SETREG(AX, regA);
SETREG(BX, regB);
SETREG(CX, regC);
SETREG(DX, regD);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END ScrollDown;
PROCEDURE GetChar(VAR ch: CHAR; VAR attr: CARDINAL; page: CARDINAL);
(* Reads the character at the current cursor position *)
BEGIN
anyReg.hi := CHR(8); (* Function Code 8 *)
regA := anyReg.reg;
anyReg.hi := CHR(page);
regB := anyReg.reg;
SETREG(AX, regA);
SETREG(BX, regB);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
GETREG(AX, regA);
anyReg.reg := regA;
ch := anyReg.lo;
attr := ORD(anyReg.hi);
END GetChar;
PROCEDURE PutCharAttr(ch : CHAR; attr: CARDINAL; count, page: CARDINAL);
(* Writes the character at the current cursor position with attribute
for text or colour in graphics, count times *)
BEGIN
anyReg.lo := ch;
anyReg.hi := CHR(9); (* Function Code 9 *)
regA := anyReg.reg;
anyReg.lo := CHR(attr);
anyReg.hi := CHR(page);
regB := anyReg.reg;
regC := count;
SETREG(AX, regA);
SETREG(BX, regB);
SETREG(CX, regC);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END PutCharAttr;
PROCEDURE PutChar(ch : CHAR; count, page: CARDINAL);
(* Writes the character at the current cursor position count times *)
BEGIN
anyReg.lo := ch;
anyReg.hi := CHR(10); (* Function Code 10 *)
regA := anyReg.reg;
anyReg.hi := CHR(page);
regB := anyReg.reg;
regC := count;
SETREG(AX, regA);
SETREG(BX, regB);
SETREG(CX, regC);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END PutChar;
PROCEDURE SetPalette(ID, colour : CARDINAL);
(* medResGraphics ONLY *)
(* colour is 0 or 1 *)
BEGIN
IF current.mode = col320x200 THEN
anyReg.hi := CHR(11); (* Function Code 11 *)
regA := anyReg.reg;
anyReg.lo := CHR(colour);
anyReg.hi := CHR(ID);
regB := anyReg.reg;
SETREG(AX, regA);
SETREG(BX, regB);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END;
END SetPalette;
PROCEDURE WritePixel(row, column, colour: CARDINAL);
BEGIN
IF (current.mode = col320x200) OR (current.mode = mono640x200) THEN
anyReg.lo := CHR(colour);
anyReg.hi := CHR(12); (* Function Code 12 *)
regA := anyReg.reg;
regC := column;
regD := 199 - row;
SETREG(AX, regA);
SETREG(CX, regC);
SETREG(DX, regD);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END;
END WritePixel;
PROCEDURE ReadPixel(row, column: CARDINAL; VAR colour: CARDINAL);
BEGIN
IF (current.mode = col320x200) OR (current.mode = mono640x200) THEN
anyReg.hi := CHR(13); (* Function Code 13 *)
regA := anyReg.reg;
regC := column;
regD := 199 - row;
SETREG(AX, regA);
SETREG(CX, regC);
SETREG(DX, regD);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
GETREG(AX, regA);
anyReg.reg := regA;
colour := ORD(anyReg.lo);
END;
END ReadPixel;
PROCEDURE WriteChDTD(ch: CHAR; colour: CARDINAL; page: CARDINAL);
(* Checks for bs, cr, lf, bel and executes as commands. *)
BEGIN
WITH anyReg DO
lo := ch;
hi := CHR(14); (* Function Code 14 *)
regA := reg;
lo := CHR(colour);
hi := CHR(page);
regB := reg;
END;
SETREG(AX, regA);
SETREG(BX, regB);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END WriteChDTD;
PROCEDURE GetVideoState( VAR mode : screenMode; VAR col: CARDINAL;
VAR page: CARDINAL);
BEGIN
anyReg.hi := CHR(15); (* Function Code 15 *)
regA := anyReg.reg;
SETREG(AX, regA);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
GETREG(AX, regA);
GETREG(BX, regB);
anyReg.reg := regA;
mode := VAL(screenMode,ORD(anyReg.lo));
col := ORD(anyReg.hi);
anyReg.reg := regB;
page := ORD(anyReg.hi);
END GetVideoState;
PROCEDURE SetScrollMode(mode: CARDINAL);
(* FOR Heath MS-DOS BIOS ONLY
0 = normal software, 1 = jump scroll (hardware), 2 = smooth *)
BEGIN
anyReg.lo := CHR(mode);
anyReg.hi := CHR(100); (* Function Code 100 *)
regA := anyReg.reg;
SETREG(AX, regA);
CODE (55H); (* Push BP *)
SWI(10H); (* Video I/O Functions *)
CODE (5DH); (* Pop BP *)
END SetScrollMode;
BEGIN
WITH initial DO
GetVideoState(mode, numCols, page);
GetCursor(cursY, cursX, page, cursorStart, cursorEnd);
GetChar(ch, attrib, page);
CASE mode OF
mono40x25, col40x25:
window.rightMargin := 39;
maxGraphX := -1;
maxGraphY := -1;
| col320x200, mono320x200:
window.rightMargin := 39;
maxGraphX := 319;
maxGraphY := 199;
| bw80x25, mono80x25, col80x25:
window.rightMargin := 79;
maxGraphX := -1;
maxGraphY := -1;
| mono640x200:
window.rightMargin := 79;
maxGraphX := 639;
maxGraphY := 199;
END;
window.topMargin := 0;
window.bottomMargin := 24;
window.leftMargin := 0;
END;
current := initial;
END ScreenBIOS.