[net.micro.6809] 80 column screen driver for CoCo3 Level I OS9 version 2.00.

draco@chinet.UUCP (Kent D. Meyers) (11/09/86)

* COCO3 80 Column Screen Driver for OS9.
* Full Emulation of the Version 2.00.00
* OS9 CO80 80 column video card driver.
* November 2, 1986.
* Kent D. Meyers.

* Special Credit to Kevin Darling for his CO80 disassembly.

* If assembled correctly, the ident is:
*
*    Header for:  CO80 
*    Module size: $029D    #669
*    Module CRC:  8634A3 (Good) 
*    Hdr parity:  $64 
*    Edition:     $07      #7
*    Ty/La At/Rv: $C1 $81 
*    System mod, 6809 obj, re-en 

* This Version has the Color Set Selection Optimized
* For Display on a Monochrome Monitor. Output is set
* to Monochrome to further enhance the display.

 NAM CO80 for COCO3 Level I OS9.

 IFP1
 USE DEFSFILE
 ENDC

 TTL CO80 Emulator for HiRes Text Screen.

 MOD LEN,NAME,SYSTM+OBJCT,REENT+1,ENTRY,0

* Special Definitions.

BACKGND EQU $0000 default background palette
BLACK EQU $0000 color number
FOREGND EQU $0000 default foreground palette
BACKINVS EQU $0001 inverse background palette
FOREINVS EQU $0001 inverse foreground palette
MONO EQU $0010 $10 for mono $00 for color
BUFF EQU $003F color number

* Cursor Type Attributes.

UNDERLIN EQU $0040
FLASH EQU $0080

* Customizable Setup Options.

BORDER EQU BUFF default border color
CURSOR EQU UNDERLIN default cursor type
CRSRATTR EQU FLASH+UNDERLIN cursor attributes
DEFAULT EQU BUFF*256+BLACK default color set
FOREBACK EQU FOREGND*8+BACKGND default character color attributes
INVERSE EQU FOREINVS*8+BACKINVS default inverse color attributes

* General Constants

ROWS EQU 24
SPACE EQU $20
COLUMNS EQU 80

* Offsets into CCIO's Static Memory Area

PARMCNT EQU $0025
PARMVEC EQU $0026
PARM0 EQU $0028
PARM EQU $0029

CURSRPOS EQU $0054 current absolute cursor position
COLMPTR EQU $0056 current column (0-79)
ROWPTR EQU $0057 current row (0-23)
ATTRIBS EQU $0058 default color attributes
CURSRTYP EQU $0059 current cursor type
VIDEO EQU $005A inverse/normal switch

COMODTYP EQU $0070 term type for CCIO

DSPLYMEM EQU $E000
DSPLYEND EQU DSPLYMEM+(ROWS*COLUMNS*2)

 NAM CO80

 FCB 6
NAME FCS "CO80"
 FCB 7 version

ENTRY
 LBRA INIT
 LBRA WRITE
 LBRA GETSTT
 LBRA SETSTT
 LBRA TERM

* ------------------------------------------------
* Do Special Codes:

CODE LEAX HRESEXIT,PCR
 PSHS X
 LEAX >CODES,PCR point to cmd table
 ASLA index
 LDD A,X get offset
 LEAX D,X plus table begin
 PSHS X make return address
 LDX CURSRPOS,U
 RTS do special code

* ------------------------------------------------
* Code Table:

CODES FDB CODE00-CODES null
 FDB CODE01-CODES home alpha cursor
 FDB CODE02-CODES goto x,y
 FDB CODE03-CODES erase line
 FDB CODE04-CODES erase to end of line
 FDB CODE05-CODES cursor change
 FDB CODE06-CODES right
 FDB CODE07-CODES null
 FDB CODE08-CODES left
 FDB CODE09-CODES up
 FDB CODE0A-CODES down
 FDB CODE0B-CODES erase to end of scrn
 FDB CODE0C-CODES cls
 FDB CODE0D-CODES <cr>

* ------------------------------------------------
* INITIALIZE

INIT BSR SETMAP
 LDD #FOREBACK*256+CURSOR
 STD ATTRIBS,U
 
 BSR WIPETEXT
 LEAX TXT80X24,PCR
 LDA #$E0
 STA $FF90
 LDA #8
 STA $FF92
 SYNC
 LDA ,X+
 STA $FF90
 LDY #$FF98

NEXTVREG LDA ,X+
 STA ,Y+
 CMPY #$FFA0
 BLO NEXTVREG
 LEAY 16,Y
 LDD #DEFAULT
 STD ,Y
 EXG A,B
 STD 8,Y
 LDB COMODTYP,U make term type
 ORB #$04 = 80-column
 BSR SETYPE for CCIO.
 LBRA HRESEXIT

* ------------------------------------------------
* TERMINATE

TERM
 LDB COMODTYP,U get 32/80 flag
 ANDB #$FB make it 32
SETYPE STB COMODTYP,U save
 CLRB and
 RTS good-bye.

* ------------------------------------------------

TXT80X24 FCB $4C,MONO+3,$15,BORDER,$00,$00,$6E*2,$00
 FCB $00

SETMAP ORCC #INTMASKS
 STB $FFD9
 LDB #$37
 STB $FFA7
 RTS

WIPETEXT LDX #DSPLYMEM
 STX CURSRPOS,U
 LDA #SPACE
 LDB ATTRIBS,U

WIPENEXT STD ,X++
 CMPX #DSPLYEND
 BLO WIPENEXT
CLERPTRS CLR COLMPTR,U
 CLR ROWPTR,U
 RTS

* ------------------------------------------------
* GETSTAT

GETSTT CMPA #SS.CURSR cursor info?
 BNE SETSTT ..no, can't do
 LDX PD.RGS,Y else X=user stack
 LDD COLMPTR,U
 ADDD #SPACE*256+SPACE
 PSHS A
 CLRA msb=00
 STD R$Y,X return it.
 PULS B
 STD R$X,X return it.
 BSR SETMAP
 LDX CURSRPOS,U
 LDA ,X get char
 LDX PD.RGS,Y
 STA R$A,X return char under cursor
 BRA HRESEXIT

* ------------------------------------------------
* SETSTAT


SETSTT LDB #E$UNKSVC 'Unknown Service Call'
 COMA

CODE00
CODE07
 RTS

* ------------------------------------------------
* WRITE CHAR

WRITE BSR SETMAP
 LDX CURSRPOS,U
 CMPA #$0E control code?
 LBLO CODE ..yes, go do
 CMPA #$1E
 BLO HRESEXIT
 CMPA #SPACE
 LBLO CHANGVID
 CMPA #$9F normal ASCII?
 BLS PRINTCHR
 LDA #$9F

PRINTCHR LDB ATTRIBS,U
 TST VIDEO,U
 BEQ NOINVERT
 LDB VIDEO,U

NOINVERT STD ,X
 BSR MVCURSOR

 CMPX #DSPLYEND
 BLO HRESEXIT
 BSR SCROLLUP

HRESEXIT LDA #$3F
 STA $FFA7
 STA $FFD8
 ANDCC #^INTMASKS-CARRY
RTSEXIT RTS

* Cursor Left. (Backspace)

CODE08 CMPX #DSPLYMEM
 BEQ RTSEXIT
 LBSR BLOTCRSR
 LEAX -2,X
 BSR MAKECRSR
 DEC COLMPTR,U
 BPL BAKSEXIT
 DEC ROWPTR,U
 LDA #COLUMNS-1
 STA COLMPTR,U
BAKSEXIT RTS

MVCURSOR BSR BLOTCRSR
 LEAX 2,X
 BSR MAKECRSR
 LDA COLMPTR,U
 INCA
 CMPA #COLUMNS
 BLO MOVEXIT
 INC ROWPTR,U
 CLRA

MOVEXIT STA COLMPTR,U
 RTS

* Carriage Return.

CODE0D LDA COLMPTR,U
 BEQ RTSEXIT
 CLR COLMPTR,U
 BSR BLOTCRSR
 NEGA
 LEAX A,X
 LEAX A,X
 BRA MAKECRSR

* Cursor Down. (Line Feed)

CODE0A BSR BLOTCRSR
 LEAX COLUMNS*2,X
 CMPX #DSPLYEND
 BHS SCROLLF
 INC ROWPTR,U
 BRA MAKECRSR

SCROLLF LDX CURSRPOS,U
 PSHS X
 BSR SCROLL2
 BSR BLOTCRSR
 PULS X
 BRA MAKECRSR

SCROLLUP CLR COLMPTR,U

SCROLL2 LDX #DSPLYMEM

SCROLL80 LDD COLUMNS*2,X
 STD ,X++
 CMPX #DSPLYMEM+((ROWS-1)*(COLUMNS*2))
 BLO SCROLL80

 LDA #ROWS-1
 STA ROWPTR,U

* Erase to End of Screen.

CODE0B LDA #SPACE
 LDB ATTRIBS,U
 PSHS X

CLERNEXT STD ,X++
 CMPX #DSPLYEND
 BNE CLERNEXT
 PULS X

MAKECRSR STX CURSRPOS,U
 LDB CURSRTYP,U
 ORB 1,X
 STB 1,X
 RTS

BLOTCRSR LDB #^CRSRATTR
 ANDB 1,X
 STB 1,X
BLOTEXIT RTS


* Home Cursor.

CODE01 BSR BLOTCRSR
 LDX #DSPLYMEM
 BSR MAKECRSR
 LBRA CLERPTRS

* Erase Line.

CODE03 BSR CODE0D
 PSHS X
 LEAX COLUMNS*2,X
 LDA #SPACE

EOL.HOOK LDB ATTRIBS,U

CLERMORE STD ,--X
 CMPX ,S
 BHI CLERMORE
 STA ,X
 PULS X,PC

* Erase to End of Line.

CODE04 LDA #SPACE 
 STA ,X
 LDB #COLUMNS-1
 CMPB COLMPTR,U
 BEQ BLOTEXIT
 INCB
 PSHS X
 SUBB COLMPTR,U
 LSLB
 ABX
 BRA EOL.HOOK

* Cursor Right.

CODE06 LDA #COLUMNS-1
 CMPA COLMPTR,U
 BEQ BLOTEXIT
 LBRA MVCURSOR

* Cursor Up.

CODE09 TST ROWPTR,U
 BEQ BLOTEXIT
 BSR BLOTCRSR
 LEAX -(COLUMNS*2),X
 DEC ROWPTR,U
 BRA MAKECRSR

* Clear Screen.

CODE0C LBSR WIPETEXT
 LDX #DSPLYMEM
 BRA MAKECRSR

* Cursor X,Y

CODE02 LEAX >MOVEVEC,PCR get return addrss
 LDB #2 need two parms (x,y)

GETPARMS STX PARMVEC,U set return
 STB PARMCNT,U and parm count
 RTS do it:

MOVEVEC LDD PARM0,U
 SUBA #SPACE drop protocol
 BLO BLOTEXIT ..ignore if bad
 CMPA #COLUMNS-1 column too high?
 BHI BLOTEXIT ..ignore
 SUBB #SPACE drop protocol
 BLO BLOTEXIT ..ignore
 CMPB #ROWS-1 row too high?
 BHI BLOTEXIT ..ignore
 STD COLMPTR,U else set new cursor x,y
 LBSR SETMAP
 LDX CURSRPOS,U
 LBSR BLOTCRSR
 LDD COLMPTR,U
 LSLA
 PSHS A
 LDA #COLUMNS*2
 MUL
 ADDB ,S+
 ADCA #$00
 LDX #DSPLYMEM
 LEAX D,X
 LBSR MAKECRSR
EXITHOOK LBRA HRESEXIT

* Normal/Inverse Video Switch

CHANGVID CMPA #$1F is code video type?
 BNE ERR.WRIT ..no, err
 LDA PARM,U yes, get parm
 CLRB
 EORA #SPACE
 BEQ SETVIDEO
 DECA
 BNE ERR.WRIT
 LDB #INVERSE
SETVIDEO STB VIDEO,U
 BRA EXITHOOK

ERR.WRIT LBSR HRESEXIT

ERR.WRI2 COMB
 LDB #E$WRITE 'Write Error'
 RTS

* Change Cursor

CODE05 LEAX >CHANGE,PCR return address
 LDB #1 need one parm
 BRA GETPARMS get it:

CHANGE LDA PARM,U get new cursor type
 CLRB
 SUBA #SPACE none?
 BLO ERR.WRI2 ..err
 BEQ CURSOFF yes, kill
 CMPA #$A too high?
 BHI GOODEXIT ..ignore
 LDB #CURSOR

CURSOFF STB CURSRTYP,U

GOODEXIT CLRB
 RTS

 EMOD
LEN EQU *
 END