language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/textvide.mod
IMPLEMENTATION MODULE TextVideo;
(********************************************************)
(* *)
(* Low-level screen functions *)
(* *)
(* The function of this module is to look after *)
(* the low-level screen initialisation needed *)
(* by the text-mode modules GlassTTY and Windows. *)
(* This reduces the likelihood of conflicts *)
(* arising in programs which import both of those *)
(* modules. *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 30 January 1995 *)
(* Status: Working *)
(* *)
(********************************************************)
FROM LowLevel IMPORT
(* proc *) SEGMENT, Virtual, OutByte, HighByte, LowByte;
FROM MiscPMOS IMPORT
(* type *) RegisterPacket,
(* proc *) BIOS, EnterCriticalSection, LeaveCriticalSection;
IMPORT Screen;
FROM TerminationControl IMPORT
(* proc *) SetTerminationProcedure;
(************************************************************************)
CONST
VideoInt = 16; (* Interrupt number for BIOS calls *)
PageSize = 4096; (* Size of a hardware page buffer *)
BytesPerChar = 2;
VAR
(* A flag to say whether we have a monochrome adaptor. *)
Monochrome: BOOLEAN;
(* ScreenSeg is a segment selector for the hardware video buffer, *)
(* and CRTCport is the port number to use when addressing the CRT *)
(* controller chip. They are variables because their values depend *)
(* on whether a colour or monochrome interface is installed. *)
ScreenSeg: CARDINAL;
CRTCport: CARDINAL;
(************************************************************************)
(* CURSOR CONTROL *)
(************************************************************************)
PROCEDURE SetCursorShape (startline, endline: CARDINAL);
(* Sets the start and end scan lines for the cursor. This has to *)
(* be done with a BIOS call, rather than by programming the CRTC *)
(* registers directly, to ensure correct treatment over the variety *)
(* of different video interfaces which could be present. *)
VAR BIOSframe: RegisterPacket;
BEGIN
WITH BIOSframe DO
AH := 1; CH := SHORTCARD(startline);
CL := SHORTCARD(endline);
END (*WITH*);
BIOS (VideoInt, BIOSframe);
END SetCursorShape;
(************************************************************************)
PROCEDURE PositionCursor (visible: BOOLEAN; position: CARDINAL;
blockcursor: BOOLEAN);
(* Displays a blinking screen cursor at the specified position. *)
(* Note that this procedure actually has to halve the specified *)
(* argument to take account of the fact that attribute bytes take *)
(* space in the character buffer but are not counted by the cursor *)
(* setting hardware. *)
VAR start, end: CARDINAL;
BEGIN
position := position DIV BytesPerChar;
OutByte (CRTCport, 14); (* the "cursor position higher" register *)
OutByte (CRTCport+1, HighByte(position));
OutByte (CRTCport, 15); (* the "cursor position lower" register *)
OutByte (CRTCport+1, LowByte(position));
IF Monochrome THEN end := 12 ELSE end := 7 END (*IF*);
IF blockcursor THEN start := 1 ELSE start := end-1 END(*IF*);
IF visible THEN SetCursorShape (start, end)
ELSE SetCursorShape (16, 0);
END (*IF*);
END PositionCursor;
(************************************************************************)
(* OPERATIONS ON THE VIDEO MODE *)
(************************************************************************)
PROCEDURE SetVideoMode (newmode: CARDINAL);
(* Sets the video mode, as defined in the BIOS. At present only *)
(* modes 3 (25*80 colour) and 7 (25*80 monochrome) are supported. *)
VAR Registers: RegisterPacket; dummy: BOOLEAN;
BEGIN
dummy := Screen.SetVideoMode (newmode, FALSE);
Screen.GetAddresses (ScreenSeg, CRTCport);
END SetVideoMode;
(************************************************************************)
PROCEDURE SetTextPage (page: SHORTCARD);
(* Changes the active display page. *)
VAR position: CARDINAL;
BEGIN
position := PageSize*VAL(CARDINAL,page) DIV BytesPerChar;
OutByte (CRTCport, 12); (* the "start address higher" register *)
OutByte (CRTCport+1, HighByte(position));
OutByte (CRTCport, 13); (* the "start address lower" register *)
OutByte (CRTCport+1, LowByte(position));
END SetTextPage;
(************************************************************************)
PROCEDURE RestoreCursor;
(* Makes the screen cursor visible at the top of the screen. *)
BEGIN
PositionCursor (TRUE, 0, FALSE);
END RestoreCursor;
(************************************************************************)
PROCEDURE RestoreOriginalMode;
(* Sets the video mode back to what it was before this program ran. *)
BEGIN
Screen.RestoreOriginalMode;
RestoreCursor;
END RestoreOriginalMode;
(************************************************************************)
PROCEDURE ShutDown;
(* Makes sure that the screen cursor is turned on at program *)
(* termination. Note that we're setting a termination procedure *)
(* inside a termination procedure, to ensure that the cursor is *)
(* turned on in pass 2 of the termination processing. *)
BEGIN
SetTerminationProcedure (RestoreCursor);
END ShutDown;
(************************************************************************)
(* EQUIPMENT KIND DETECTION *)
(************************************************************************)
PROCEDURE VideoKind (VAR (*OUT*) ScreenSegment: CARDINAL;
VAR (*OUT*) BlackAndWhite: BOOLEAN);
(* Returns the segment of the screen memory, and a flag saying *)
(* whether we are using a monochrome adaptor. *)
BEGIN
ScreenSegment := ScreenSeg; BlackAndWhite := Monochrome;
END VideoKind;
(************************************************************************)
(* INITIALISATION *)
(************************************************************************)
VAR Registers: RegisterPacket;
Adaptor: Screen.VideoAdaptorType;
BEGIN
Adaptor := Screen.VideoKind();
Monochrome := (Adaptor=Screen.MDA) OR (Adaptor=Screen.Hercules);
SetTerminationProcedure (ShutDown);
(* Set an appropriate text mode: 25*80 colour if possible, or *)
(* 25*80 monochrome for a monochrome adaptor. *)
IF Monochrome THEN
SetVideoMode (7);
ELSE
SetVideoMode (3);
END (*IF*);
END TextVideo.