CaChars Code

* CACHARS - GRAPHICS MODE CONSOLE I/O FOR THE TRS-80 COLOR COMPUTER
*
* COPYRIGHT (C) 2012-2014 JUAN CARLOS CASTRO Y CASTRO
*
* THIS PROGRAM REQUIRES AT LEAST 32 KB RAM, AND OCCUPIES AROUND 2 KB
* OF BASIC RAM.
*
* USAGE EXAMPLE:
* 10 CLEAR nnnn,&H6FFF
* 20 LOADM "CACHARS.BIN"
* 30 PMODE 4,1:SCREEN 1,0
* 40 EXEC
* 50 VA=USR8(0) 'VA POINTS TO CACHARS DATA AREA
* 60 POKE VA,18:POKE VA+1,12
* 70 PRINT "HELLO CENTERED!"
*
* COMMENT, SUGGESTIONS, AND CONTRIBUTIONS:
* jccyc[YEAR-JIM-CLARK-WON-SECOND-FORMULA-ONE-TITLE]@gmail.com
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as
* published by the Free Software Foundation, either version 2.1 of the
* License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this program.
* If not, see <http://www.gnu.org/licenses/>.

* COLOR BASIC VARIABLES
FRETOP		EQU $0021	* STRING AREA START
MEMSIZ		EQU $0027	* END OF BASIC RAM
DEVCFW		EQU $006A	* TAB WIDTH
DEVLCF		EQU $006B	* LAST TAB STOP
DEVPOS		EQU $006C	* PRINT POSITION
DEVWID		EQU $006D	* PRINT WIDTH
PRTDEV		EQU $006E	* PRINT DEVICE (0=NOT CASS; -1=CASS)
DEVNUM		EQU $006F	* DEVICE NUMBER
CINBFL		EQU $0070	* CONSOLE IN BUFFER EMPTY FLAG
USRADR		EQU $00B0	* POINTER TO ARRAY OF USR FUNCTIONS (0-9)
BEGGRP		EQU $00BA	* ADDRESS OF VIDEO RAM
HRWIDTH		EQU $00E7	* COCO 3 HI-RES TEXT MODE

* RAM VECTOR LOCATIONS
RVEC2		EQU $0164	* SET PRINT PARAMS
VEC2		EQU RVEC2+1
RVEC3		EQU $0167	* CONSOLE OUT
VEC3		EQU RVEC3+1
RVEC4		EQU $016A	* CONSOLE IN
VEC4		EQU RVEC4+1
RVEC12		EQU $0182	* LINE INPUT
VEC12		EQU RVEC12+1
RVEC22		EQU $01A0	* CLS
VEC22		EQU RVEC22+1

* COCO 3 PATCH JUMP LOCATIONS
PATCH23JMP	EQU $A910		* COCO 3 CLS PATCH JUMP
PATCH23ADDR	EQU PATCH23JMP+1
PATCHCLEARJSR	EQU $F75B		* CALL TO "LOW-RES" CLS WHEN
PATCHCLEARADDR	EQU PATCHCLEARJSR+1	* CLEAR KEY IS PRESSED

* ROM SUBROUTINE INDIRECT JUMPS
POLCAT		EQU $A000	* KEYBOARD CHARACTER INPUT

* ROM SUBROUTINE FIXED ADDRESSES
ALINK23		EQU $F6AD	* COCO 3 HI-RES CLS

* INTERRUPT VECTORS
RESETV		EQU $FFFE

* CHARACTERISTIC RESET VECTOR VALUES FOR MACHINE ID'ING
COCO2VEC	EQU $A027
COCO3VEC	EQU $8C1B
DRAGONVEC	EQU $B3B4

* MACHINE IDS
COCO2ID		EQU 2
COCO3ID		EQU 3
DRAGONID	EQU 64

* COCO I/O PORTS
PIA1		EQU $FF20

*
* MACROS
*

* LOGICAL SHIFT RIGHT ACCA BY ACCB BITS (TRASHES ACCB)
SHRABYB		MACRO
@L		LSRA
		DECB
		BNE @L
		ENDM

* LOGICAL SHIFT RIGHT X BY ACCB BITS
SHRXBYB		MACRO
		PSHS B
		EXG D,X
@L		LSRA
		RORB
		DEC ,S
		BNE @L
		EXG D,X
		LEAS 1,S
		ENDM
		
*
* MAIN CODE
*

		ORG $77D0

MSG		FCC	'Welcome to CaChars '
		INCLUDE	version.asm
		FCB	13
		FCC	'© 2012-2014 Juan Carlos Castro y Castro'
		FCB	13
		FCC	'Distributed under the terms of the GNU LGPL v2.1+'
		FCB	13,13
		FCB	0

* START: DISPLAY MESSAGE ONTO PMODE 4 SCREEN,
* THEN HOOK BASIC ROM, THEN RETURN

BEG		LDA #COCO2ID
		LDX RESETV
		CMPX #COCO2VEC
		BEQ THISISIT
		LDA #COCO3ID
		CMPX #COCO3VEC
		BEQ THISISIT
		LDA #DRAGONID
		CMPX #DRAGONVEC
		BEQ THISISDRAGON

		RTS		* NO RECOGNIZABLE MACHINE => GIVE UP

THISISDRAGON	LDX #$8427	* DRAGON HAS DIFFERENT ROM SUBROUTINE ADDRS
		STX CLEAR
		LDX #$8E51
		STX GETBYTEARG
		LDX #$8C37
		STX GIVABF
		LDX #$BA62
		STX CLSRETN

THISISIT	STA MACHINEID

		LBSR CLS	* STARTUP MESSAGE
		LBSR GETPARMS
		LDX #MSG
		LBSR PRINTSTR

* REDIRECT RAM VECTORS; SAVE OLD ONES FOR DAISYCHAINING

* IF JUMP VECTOR HAS A RTS OPCODE ($39) WE HAVE TO (1) NOT SAVE THE OLD
* RAM VECTOR BECAUSE IT'S INVALID, AND (2) SET THE OPCODE TO JMP.

		LDD #$397E	* A = RTS OPCODE; B = JMP OPCODE

		CMPA RVEC2
		BEQ NOSET2
		LDX VEC2	* SAVE ALL OLD RAM VECTORS
		STX OLDVEC2
NOSET2		CMPA RVEC3
		BEQ NOSET3
		LDX VEC3
		STX OLDVEC3
NOSET3		CMPA RVEC4
		BEQ NOSET4
		LDX VEC4
		STX OLDVEC4
NOSET4		CMPA RVEC12
		BEQ NOSET12
		LDX VEC12
		STX OLDVEC12
NOSET12		CMPA RVEC22
		BEQ RHOOKS
		LDX VEC22
		STX OLDVEC22
		
RHOOKS		LDX #NEWPRINTPARMS	* HOOK COMMON VECTORS
		STX VEC2
		STB RVEC2
		LDX #NEWCONIN
		STX VEC4
		STB RVEC4
		
		LDU USRADR		* POINT TO START OF USR ARRAY
		LEAU 16,U		* POINT TO USR8
		LDX #USRFUNC
		STX ,U

		LDA MACHINEID
		CMPA #COCO3ID		* ARE WE RUNNING IN A COCO 3?.
		BEQ COCO3SETUP		* IF SO, DO COCO 3 SPECIFIC INIT

COCO1AND2SETUP	LDX #NEWCONOUT		* DO COCO 1/2/DRAGON STUFF
		STX VEC3
		STB RVEC3
		LDX #NEWLINEINPUT
		STX VEC12
		STB RVEC12
		LDX #NEWCLS
		STX VEC22		
		STB RVEC22
		BRA SHEDINITCODE

COCO3SETUP	LDX #NEWCONOUTCOCO3	* IN COCO3, CONOUT HAS TO TEST
		STX VEC3		* FOR HI-RES TEXT MODES
		STB RVEC3
		LDX PATCH23ADDR		* PATCH BASIC BECAUSE RVEC22 IS
		STX OLDVEC22		* NONFUNCTIONAL IN A COCO 3
		LDX #NEWCLSCOCO3
		STX PATCH23ADDR
		LDX #NEWCLSCOCO3LI
		STX PATCHCLEARADDR
		
SHEDINITCODE	LDD FRETOP
		SUBD MEMSIZ	* ACCD = MINUS STRING AREA SIZE
		LDX #RESIDENT-1
		STX MEMSIZ
		LEAX D,X
		STX FRETOP
		JMP [CLEAR]	* PERFORM CLEAR WITH NEW RAM LIMITS

* START OF RESIDENT CODE

RESIDENT	EQU *

* CACHARS VARIABLES
DATAAREA	EQU *
CURX		FCB 0		* CURSOR COLUMN POSITION (0-50 OR 0-63)
CURY		FCB 0		* CURSOR ROW POSITION (0-23)
CURSORCHAR	FCB $8D		* $81 = BLOCK, $8D = THICK UL
CURSORDELAY	FDB $240
REVERSE		FCB 255		* 0 = GREEN ON BLACK; 255 = BLACK ON GREEN
CURSORENABLE	FCB 2		* 0 = NO TEXT CURSOR; 1 = FIXED; 2 = BLINK
TEXTMODE	FCB 0		* 0 = 51x24; 1 = 64x24
MACHINEID	FCB 0
FONTLOCATION	FDB CHARSET
CLEARKEYCLEARS	FCB 0		* NEXT PRESS OF CLEAR KEY DOES CLS

* ROM SUBROUTINE POINTERS
CLSRETN		FDB $A913	* ROM CLS RETURN ADDRESS ($BA62 ON DRAGON)
CLEAR		FDB $AD26	* ERASE ALL VARIABLES ($8427 ON DRAGON)
GETBYTEARG	FDB $B70B	* PARSE A BYTE ARG FROM BASIC ($8E51 ON DRAGON)
GIVABF		FDB $B4F4	* CONVERT ACCD TO FLOATING POINT ($8C37 ON DRAGON)

* PREVIOUS RAM VECTOR STORAGE & JUMP TABLE

OLDRVEC2	JMP DONOTHING
OLDVEC2		EQU OLDRVEC2+1	* PREVIOUS PRINT PARAMS VECTOR
OLDRVEC3	JMP DONOTHING
OLDVEC3		EQU OLDRVEC3+1	* PREVIOUS CONSOLE OUT VECTOR
OLDRVEC4	JMP DONOTHING
OLDVEC4		EQU OLDRVEC4+1	* PREVIOUS CONSOLE IN VECTOR
OLDRVEC12	JMP DONOTHING
OLDVEC12	EQU OLDRVEC12+1	* PREVIOUS LINE INPUT VECTOR
OLDRVEC22	JMP DONOTHING
OLDVEC22	EQU OLDRVEC22+1	* PREVIOUS CLS VECTOR

* LOOKUP TABLES FOR BYTE POSITION AND BIT DISPLACEMENTS
* OF A 5-BIT STRING WITHIN A 40-BIT BLOCK

BITDISPS	FCB 1,6,3,0,5,2,7,4
BYTEDISPS	FCB 0,0,1,2,2,3,3,4	

EEMSG		FCC 'Good Idea'
		FCB 13,0

USRFUNC		LDD #DATAAREA
		JMP [GIVABF]

* OBTAIN MEMORY LOCATION FOR CHARACTER COORDINATES
*
* INPUT:   ACCA = LINE NUMBER (0-23)
*          ACCB = COLUMN NUMBER (0-63)
*                 (NOT TESTED FOR OUT OF RANGE)
* OUTPUT:  Y    = MEMORY LOCATION
*          ACCB = BIT DISPLACEMENT
* TRASHES: ACCA, X

GETMEMPOSXY	TST TEXTMODE
		BEQ GETMEMPOSXY51

		PSHS B
		CLRB
		LDY BEGGRP
		LEAY D,Y	* 256 BYTES/LINE. SO CONVENIENT,
		LDB ,S		* SO NOT PORTABLE.
		LSRB		* HALF THE COLUMN NUMBER IS HOW MANY
		LEAY B,Y	* WE HAVE TO MOVE FORWARD IN THIS MODE
		PULS B		* GET COLUMN NUMBER AGAIN
		ANDB #$01
		LSLB
		LSLB		* IF ODD, BIT DISPLACEMENT IS 4
DONOTHING	RTS

GETMEMPOSXY51	PSHS B
		CLRB
		LDY BEGGRP
		LEAY D,Y	* 256 BYTES/LINE. SO CONVENIENT,
		LDB ,S		* SO NOT PORTABLE.
		LSRB		* PUSH LINE POS
		LSRB
		LSRB		* B = # OF 5-BYTE ADVS
		LEAY B,Y	* ADD 1X IT
		LSLB
		LSLB
		LEAY B,Y	* PLUS 4X IT
		PULS B
		ANDB #7		* REMAINDER OF ADVANCEMENT
		LDX #BYTEDISPS	* WE GET FROM TABLE
		LDA B,X
		LEAY A,Y	* Y IS IN CORRECT BYTE POS
		LDX #BITDISPS
		LDB B,X		* GOT BIT DISPLACEMENT
RTS01		RTS

* CONSOLE OUT RAM HOOK
NEWCONOUTCOCO3	TST HRWIDTH
		BNE OLDRVEC3
NEWCONOUT	BSR TSTHIRES
		BNE OLDRVEC3
		TST DEVNUM
		BNE OLDRVEC3
		LEAS 2,S	* BLEED INTO CHAROUT

* OUTPUT ASCII CHARACTER
* INPUT:   ACCA = ASCII CHARACTER
* OUTPUT:  NONE
* TRASHES: NONE

CHAROUT		PSHS D,X,Y
		CMPA #$0D
		BEQ OUTEOL
		CMPA #$0A
		BEQ OUTLF
		CMPA #$08
		BEQ OUTBS
		LDB CURX
		LDA CURY
		BSR GETMEMPOSXY
		LDA ,S
		BSR PUTCHAR
UPDATECURSOR	LDA CURX
		INCA
		CMPA DEVWID
		BHS OUTEOL
		STA CURX
CHAROUTEND	PULS D,X,Y,PC
OUTBS		LDB CURX
		TSTB
		BEQ CHAROUTEND
		DECB
		STB CURX
		LDA CURY
		LBSR GETMEMPOSXY
		LDA #$20
		BSR PUTCHAR
		PULS D,X,Y,PC
OUTEOL		CLR CURX
OUTLF		LDA CURY
		INCA
		CMPA #24
		BHS DOSCROLL
		STA CURY
		PULS D,X,Y,PC
DOSCROLL	LBSR SCROLLUP
		PULS D,X,Y,PC

* OUTPUT AN ASCIIZ STRING POINTED BY X
* (TRASHES: ACCA, X)

PRINTSTR	LDA ,X+
		TSTA
		BEQ RTS01	* SAVE 1 BYTE USING SOMEONE ELSE'S RTS
		BSR CHAROUT
		BRA PRINTSTR

* SET ZF IF IN 256x192 GRAPHICS SCREEN

TSTHIRES	PSHS A
		LDA PIA1+2
		ANDA #$F0
		CMPA #$F0
		PULS A,PC
		
* APPLY ASCII CHARACTER TO SCREEN MEMORY
* INPUT:   ACCA = ASCII CHARACTER
*          Y    = MEMORY LOCATION
*          ACCB = BIT DISPLACEMENT (0-7)
* OUTPUT:  NONE
* TRASHES: ACCD, X

OUTARANGE	CLRA
		BRA PROCEED
PUTCHAR		PSHS D
		SUBA #32
		CMPA #224
		BHS OUTARANGE
PROCEED		EXG A,B
		CLRA
		LSLB
		ROLA
		LSLB
		ROLA
		ANDB #$F8
		LDX FONTLOCATION
		LEAX D,X
		PULS D
		ANDA #1
		BNE RENDERCHARODD	* BLEED INTO RENDERCHAR

* APPLY A CHARACTER CELL TO A MEMORY LOCATION
* INPUT:   X    = CHARACTER CELL (HIGH NIBBLES)
*          Y    = MEMORY LOCATION
*          ACCB = BIT DISPLACEMENT (0-7)
* OUTPUT:  NONE
* TRASHES: ACCA, X

RENDERCHAR	LDA #8
		PSHS D,Y
LOOPCHAR	LDA ,X+
		LDB 1,S
		PSHS X
		ANDA #$F0
		BSR APPLYNIBBLE
		PULS X
		LEAY 32,Y	* BYTES PER SCANLINE
		DEC ,S
		BNE LOOPCHAR
		PULS D,Y,PC

* APPLY A CHARACTER CELL TO A MEMORY LOCATION
* INPUT:   X    = CHARACTER CELL (LOW NIBBLES)
*          Y    = MEMORY LOCATION
*          ACCB = BIT DISPLACEMENT (0-7)
* OUTPUT:  NONE
* TRASHES: ACCA, X

RENDERCHARODD	LDA #8
		PSHS D,Y
LOOPCHARODD	LDA ,X+
		LSLA
		LSLA
		LSLA
		LSLA
		LDB 1,S
		PSHS X
		BSR APPLYNIBBLE
		PULS X
		LEAY 32,Y	* BYTES PER SCANLINE
		DEC ,S
		BNE LOOPCHARODD
		PULS D,Y,PC

* SET PRINT PARAMETERS RAM HOOK
NEWPRINTPARMS	BSR TSTHIRES
		LBNE OLDRVEC2
		TST DEVNUM
		LBNE OLDRVEC2
		LEAS 2,S
GETPARMS	PSHS D
		CLR PRTDEV
		LDA CURX
		STA DEVPOS
		TST TEXTMODE
		BNE PARMS64
		LDA #51
		STA DEVWID
		LDD #$1020
		STD DEVCFW
		PULS D,PC
PARMS64		LDA #64
		STA DEVWID
		LDD #$1030
		STD DEVCFW
		PULS D,PC

* APPLY A NIBBLE TO A MEMORY LOCATION
* INPUT:   ACCA = NIBBLE (USES THE HIGH ONE)
*                 LOW 4 BITS MUST BE ALREADY ZEROED OUT
*          Y    = MEMORY LOCATION
*          ACCB = BIT DISPLACEMENT (0-7)
* OUTPUT:  NONE
* TRASHES: ACCD, X

APPLYNIBBLE	TST TEXTMODE
		BEQ APPLYNIBBLE51

		TST REVERSE
		BNE FLIPNIBBLE
APPLYNIBBLE64	TSTB
		BNE RIGHTNIBBLE64
		LDB ,Y
		ANDB #$0F
		PSHS B
		ORA ,S+
		STA ,Y
		RTS
RIGHTNIBBLE64	LSRA
		LSRA
		LSRA
		LSRA
		LDB ,Y
		ANDB #$F0
		PSHS B
		ORA ,S+
		STA ,Y
		RTS
FLIPNIBBLE	COMA
		ANDA #$F0
		BRA APPLYNIBBLE64

APPLYNIBBLE51	CMPB #3
		BHI NASTY
		TSTB
		BEQ SIMPLE

MEDIUM		PSHS B		* STACK HAS 1: DISP
		SHRABYB
		PSHS A		* STACK HAS 2: SHIFTED NIBBLE, DISP
		LDA #$F8
		LDB 1,S
		SHRABYB
		PULS B		* ACCB HAS SHIFTED NIBBLE, STACK HAS 1: DISP
		EXG A,B		* CORRECT REGS FOR APPLYBITS
		LEAS 1,S	* DISCARD STACK
APPLYBITS	TST REVERSE
		BEQ NOREVM	* APPLY COMPLEMENT IF IN REVERSE MODE
		COMA
NOREVM		PSHS B		* APPLY BITS OF ACCA TO MEMORY POINTED BY Y,
		ANDA ,S+	* WITH MASK IN ACCB
		COMB
		ANDB ,Y
		PSHS B
		ORA ,S+
		STA ,Y
		RTS

NASTY		PSHS D		* STACK HAS 2: NIBBLE,DISPL
		LDX #$F800
		SHRXBYB
		PSHS X		* STACK HAS 4: 16BMASK,NIBBLE,DISP
		LDX 2,S
		LDB 3,S
		SHRXBYB		* X HAS SHIFTED NIBBLE
		PULS D		* D HAS 16BMASK, STACK HAS 2: NIBBLE,DISP
		EXG D,X		* CORRECT REGS FOR APPLYBITSD
		LEAS 2,S	* DISCARD STACK
		TST REVERSE
		BEQ NOREVN	* APPLY COMPLEMENT IF IN REVERSE MODE
		COMA
		COMB
NOREVN		PSHS X		* APPLYBITSD: APPLY BITS OF ACCD TO
		ANDA ,S		* MEMORY POINTED BY Y, WITH MASK IN X
		ANDB 1,S
		PSHS D
		LDD 2,S
		COMA
		COMB
		ANDA ,Y
		ANDB 1,Y
		ORA ,S
		ORB 1,S
		STD ,Y
		PULS D,X,PC

SIMPLE		LDB #$F8
		BRA APPLYBITS

* SCROLL SCREEN UP ONE LINE
* (A 6309 WOULD MAKE THIS WAAAAY FASTER)
SCROLLUP	PSHS D,X,Y
		LDY BEGGRP
		LEAX $1800,Y
		PSHS X
		LEAX 256,Y
SCRLOOP		LDD ,X++	* MOVE 4 WORDS AT A TIME TO DO
		STD ,Y++	* LESS BRANCHES (~15% FASTER)
		LDD ,X++
		STD ,Y++
		LDD ,X++
		STD ,Y++
		LDD ,X++
		STD ,Y++
		CMPX ,S
		BLO SCRLOOP
		LDA REVERSE	* FILL LAST LINE WITH $FF IF
		TFR A,B		* REVERSE OR 0 IF NORMAL
		TFR Y,X		* USE THE BETTER INDEX REGISTER
CLRLASTLOOP	STD ,X++
		CMPX ,S
		BLO CLRLASTLOOP
		LEAS 2,S
		PULS D,X,Y,PC

* CONSOLE IN RAM HOOK
NEWCONIN	TST CURSORENABLE
		LBEQ OLDRVEC4
		TST DEVNUM
		LBNE OLDRVEC4
		LBSR TSTHIRES
		LBNE OLDRVEC4
		LEAS 2,S
		PSHS B,X,Y
		LDA CURSORENABLE
		CMPA #1
		BEQ FIXEDCURSOR
		LDX #$1
		LDB #$20
WAITFORKEY	JSR [POLCAT]
		BNE GOTACHAR
		LDA CURSORENABLE
		CMPA #1
		BEQ WAITFORKEY
		LEAX -1,X
		BNE WAITFORKEY
		LDX CURSORDELAY
		NEGB
		ADDB CURSORCHAR
		ADDB #$20		* MOVE TO ALTERNATING CHAR
		BSR PAINTCHAR
		BRA WAITFORKEY
GOTACHAR	CMPA #$0C		* CLEAR?
		BNE NOCLEARKEY
		TST CLEARKEYCLEARS	* ARE WE WITHIN A LINE INPUT?
		BEQ NOCLEARKEY
		BSR CLS
		CLR CLEARKEYCLEARS	* NEXT CLEAR WON'T CLEAR
		LDA #08			* CHAR = BS AND CHAR COUNT = -1
		LDB #1			* WILL FORCE A LINE INPUT RESTART
		STB ,S
NOCLEARKEY	PSHS A
		CMPB #$20
		BEQ NONEEDTOWIPE
		LDB #$20
		BSR PAINTCHAR		* PAINT SPACE
NONEEDTOWIPE	CLR CINBFL		* CLEAR CONSOLE IN BUFFER EMPTY FLAG
		PULS A,B,X,Y,PC

FIXEDCURSOR	LDB CURSORCHAR
		BSR PAINTCHAR
		BRA WAITFORKEY
		
* LINE INPUT RAM HOOK
NEWLINEINPUT	LBSR TSTHIRES
		BNE GOOLDRVEC12
		TST DEVNUM
		BNE GOOLDRVEC12
		PSHS A
		LDA #1
		STA CLEARKEYCLEARS
		PULS A
GOOLDRVEC12	LBRA OLDRVEC12

* PAINT CHARACTER IN ACCB AT CURSOR POSITION, DON'T ADVANCE
* TODO: GENERALIZE AND USE SAME ROUTINE CHAROUT USES
PAINTCHAR	PSHS B,X
		LDB CURX
		LDA CURY
		LBSR GETMEMPOSXY
		LDA ,S
		LBSR PUTCHAR
		PULS B,X,PC

GOOLDRVEC22	PULS X,CC
		LBRA OLDRVEC22
		
* CLS RAM HOOK
NEWCLS		PSHS X,CC		* CLS HOOK HAS TO PRESERVE FLAGS
		LDX 3,S			* GET RETURN ADDRESS FROM STACK
		CMPX CLSRETN		* CHECK TO SEE IF IT'S THE CLS ROUTINE
		BNE GOOLDRVEC22
		LBSR TSTHIRES		* ARE WE IN "OUR" VIDEO MODE?
		BNE GOOLDRVEC22
		PULS X,CC		* RECOVER FLAGS
		BEQ NOCLSARG		* ZF => NO ARGUMENTS
		JSR [GETBYTEARG]	* PARSE & IGNORE (IN THIS VERSION)
NOCLSARG	LEAS 2,S		* DISCARD RET ADDR
CLS		PSHS D,X,Y,U
		LDY BEGGRP
		LDA REVERSE		* FILL WITH EITHER FF OR 00
		TFR A,B
		TFR D,U
		LDX #$600
LOOPCLS		STD ,Y++
		STU ,Y++
		LEAX -1,X
		BNE LOOPCLS
		CLR CURX
		CLR CURY
		LDA 1,S
		CMPA #51
		BNE NOEE
		LDX #EEMSG
		LBSR PRINTSTR
NOEE		PULS D,X,Y,U,PC

* COCO 3 CLS PATCH CODE
NEWCLSCOCO3LI	ORCC #4			* SET ZF TO AVOID BASIC PARSING
NEWCLSCOCO3	PSHS CC
		TST HRWIDTH
		BNE GOALINK23
		LBSR TSTHIRES
		BNE GOOLDRVEC22
		PULS CC
		BEQ CLS
		JSR [GETBYTEARG]	* PARSE & IGNORE (IN THIS VERSION)
		BRA CLS
GOALINK23	JMP ALINK23
		
* THE "FONT", SUCH AS IT IS. DRAWN ON NOTEPAD FROM SWEET, SWEET
* MEMORIES OF SUPER COLOR WRITER. NO, REALLY. NOT KIDDING. HONEST.

		INCLUDE font51.asm
		
		END BEG