home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1986-03-11 | 11.1 KB | 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.
-