{   Computer Systems Research Institute
    University of Toronto

    Module: TI PRO BIOS CRT Interface   V1.00
    Author:     James R. Cordy, C. B. Hall
    Date:       9 May 1984  (Rev 4 Nov 1985) }

{ Copyright 1984, 1985  The University of Toronto }


{ Cursor Types - Choose one from group A and one from group B,
		 as in "CRblock + CRblink" }

{ Group A - Cursor Shape }
pervasive const CRblock := 0000B#16
pervasive const CRunderline := 00B0B#16

{ Group B - Cursor Attributes }
pervasive const CRoff := 02000#16
pervasive const CRnoblink := 00000#16
pervasive const CRblink := 06000#16
pervasive const CRfastblink := 04000#16

pervasive type CursorType = SignedInt


{ Character Attributes - May be OR'ed Together }
pervasive type AttributeType = set of 0..7

{ Character Colours; form others by OR'ing primaries }
pervasive const ATblack : AttributeType := AttributeType ()
pervasive const ATblue : AttributeType := AttributeType (0, 3)
pervasive const ATred : AttributeType := AttributeType (1, 3)
pervasive const ATgreen : AttributeType := AttributeType (2, 3)
pervasive const ATwhite : AttributeType := AttributeType (0, 1, 2, 3)

pervasive const ATnormal : AttributeType := AttributeType ()
pervasive const ATreverse : AttributeType := AttributeType (4)
pervasive const ATunderline : AttributeType := AttributeType (5)
pervasive const ATblink : AttributeType := AttributeType (6)


var CRT : module

    imports (var BIOS, byteregs)
    exports (SetCursorType, SetCursorPosition, ReadCursorPosition,
	ReadCharacter, ReadCharacterAndAttribute,
	WriteCharacter, WriteCharacterAndAttribute, 
	MoveLines, CopyLines, ClearScreen, SetAttributeLatch)

    { BIOS Registers }
    var inregs : REGS := ZEROREGS
    var outregs : REGS 
    var outflags : FLAGS

    procedure SetCursorType (ctype : CursorType) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTSETCURTYPE
	    inregs (CXREG) := ctype
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end SetCursorType

    procedure SetCursorPosition (line : SignedInt, column : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTSETCURPOSN
	    byteregs (inregs) (DHREG) := column
	    byteregs (inregs) (DLREG) := line
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end SetCursorPosition

    procedure ReadCursorPosition (var line : SignedInt,
	    var column : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTREADCURPOSN
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	    column := byteregs (outregs) (DHREG)
	    line := byteregs (outregs) (DLREG)
	end ReadCursorPosition

    procedure ReadCharacter (var c : Char) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTREADCHARANDATTR
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	    c := chr (byteregs (outregs) (ALREG))
	end ReadCharacter

    procedure ReadCharacterAndAttribute (var c : Char,
	    var a : AttributeType) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    converter ShortIntToAttributeType (ShortInt) returns AttributeType
	    byteregs (inregs) (AHREG) := CRTREADCHARANDATTR
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	    c := chr (byteregs (outregs) (ALREG))
	    a := ShortIntToAttributeType (byteregs (outregs) (AHREG))
	end ReadCharacterAndAttribute

    procedure WriteCharacter (c : Char, n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTWRITECHAR
	    byteregs (inregs) (ALREG) := ord (c)
	    inregs (CXREG) := n
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end WriteCharacter

    procedure WriteCharacterAndAttribute (c : Char, a : AttributeType,
	    n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    converter AttributeTypeToShortInt (AttributeType) returns ShortInt
	    byteregs (inregs) (AHREG) := CRTWRITECHARANDATTR
	    byteregs (inregs) (ALREG) := ord (c)
	    inregs (BXREG) := AttributeTypeToShortInt (a)
	    inregs (CXREG) := n
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end WriteCharacterAndAttribute

    procedure MoveLines (ls : SignedInt, ld : SignedInt, n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTSCROLLTEXTBLOCK
	    byteregs (inregs) (ALREG) := 0 { Blanking on }
	    inregs (DXREG) := ls
	    inregs (BXREG) := ld
	    byteregs (inregs) (CHREG) := 80
	    byteregs (inregs) (CLREG) := n
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end MoveLines

    procedure CopyLines (ls : SignedInt, ld : SignedInt, n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTSCROLLTEXTBLOCK
	    byteregs (inregs) (ALREG) := 1 { Blanking off }
	    inregs (DXREG) := ls
	    inregs (BXREG) := ld
	    byteregs (inregs) (CHREG) := 80
	    byteregs (inregs) (CLREG) := n
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end CopyLines

    procedure ClearScreen =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTCLRSCREEN
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end ClearScreen

    procedure SetAttributeLatch (a : AttributeType) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    converter AttributeTypeToShortInt (AttributeType) returns ShortInt
	    byteregs (inregs) (AHREG) := CRTSETATTR
	    inregs (BXREG) := AttributeTypeToShortInt (a)
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end SetAttributeLatch
end module
