{   Computer Systems Research Institute
    University of Toronto

    Module: IBM-PC and PCjr BIOS CRT Interface   V1.12
    Author:     James R. Cordy, C. B. Hall
    Date:       9 May 1984  (Rev 4 Nov 1985) }

{ Copyright 1984, 1985  The University of Toronto }


{ 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)
pervasive const ATgreen : AttributeType := AttributeType (1)
pervasive const ATred : AttributeType := AttributeType (2)
pervasive const ATwhite : AttributeType := AttributeType (0, 1, 2)

{ Group A - Character Type }
pervasive const ATnormal : AttributeType := AttributeType ()
pervasive const ATunderline : AttributeType := AttributeType (0)
pervasive const ATbold : AttributeType := AttributeType (3) { modifies colour }
pervasive const ATblink : AttributeType := AttributeType (7)


var CRT : module

    imports (var BIOS, byteregs)
    exports (SetCursorPosition, ReadCursorPosition,
	ReadCharacter, ReadCharacterAndAttribute,
	WriteCharacter, WriteCharacterAndAttribute, 
	ScrollUp, ScrollDown, ClearScreen, SetAttributeLatch)
 
    { Current Attribute Latch }
    var curattr : AttributeType := ATnormal + ATwhite

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

    procedure SetCursorPosition (line : SignedInt, column : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTSETCURPOSN
	    byteregs (inregs) (BHREG) := 0
	    byteregs (inregs) (DLREG) := column
	    byteregs (inregs) (DHREG) := 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
	    byteregs (inregs) (BHREG) := 0
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	    column := byteregs (outregs) (DLREG)
	    line := byteregs (outregs) (DHREG)
	end ReadCursorPosition

    procedure ReadCharacter (var c : Char) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    byteregs (inregs) (AHREG) := CRTREADCHARANDATTR
	    byteregs (inregs) (BHREG) := 0
	    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
	    byteregs (inregs) (BHREG) := 0
	    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,  
	    curattr) 
	begin
	    converter AttributeTypeToShortInt (AttributeType) returns ShortInt
	    byteregs (inregs) (AHREG) := CRTWRITECHARANDATTR 
	    byteregs (inregs) (ALREG) := ord (c)
	    inregs (BXREG) := AttributeTypeToShortInt (curattr)
	    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 ScrollUp (l1 : SignedInt, lm : SignedInt, n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    converter AttributeTypeToShortInt (AttributeType) returns ShortInt
	    byteregs (inregs) (AHREG) := CRTSCROLLUP
	    byteregs (inregs) (ALREG) := n
	    byteregs (inregs) (CHREG) := l1
	    byteregs (inregs) (CLREG) := 0
	    byteregs (inregs) (DHREG) := lm
	    byteregs (inregs) (DLREG) := 79
	    byteregs (inregs) (BHREG) := AttributeTypeToShortInt (ATwhite)
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end ScrollUp

    procedure ScrollDown (l1 : SignedInt, lm : SignedInt, n : SignedInt) =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)
	begin
	    converter AttributeTypeToShortInt (AttributeType) returns ShortInt
	    byteregs (inregs) (AHREG) := CRTSCROLLDOWN         
	    byteregs (inregs) (ALREG) := n                   
	    byteregs (inregs) (CHREG) := l1                    
	    byteregs (inregs) (CLREG) := 0 
	    byteregs (inregs) (DHREG) := lm                   
	    byteregs (inregs) (DLREG) := 79 
	    byteregs (inregs) (BHREG) := AttributeTypeToShortInt (ATwhite)
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end ScrollDown

    procedure ClearScreen =
	imports (var BIOS, var inregs, var outregs, byteregs, var outflags)  
	begin
	    byteregs (inregs) (AHREG) := CRTSETMODE  
	    byteregs (inregs) (ALREG) := 3
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	    byteregs (inregs) (AHREG) := CRTSELECTPAGE 
	    byteregs (inregs) (ALREG) := 0
	    outflags := BIOS.int86 (outregs, inregs, CRTDSR)
	end ClearScreen

    procedure SetAttributeLatch (a : AttributeType) =
	imports (var curattr)  
	begin
	    curattr := a 
	end SetAttributeLatch
end module
