erkyrath.infocom-zcode-terps/c-128/xzip/machine.asm

	PAGE
	STTL "--- MACHINE-DEPENDENT I/O: CBM64 ---"

	; ----------------------------
	; FETCH ASCII KEYCODE INTO [A]
	; ----------------------------

	; EXIT: ASCII IN [A] & [IOCHAR]
GETKEY:
	JSR	STCUR	; start the cursor please
GK1:
	JSR	GETIN	; do we have a key?
	CMP	#0	; 1 is yes
	BNE	GK2

	JSR	TOGCUR	; toggle the cursor?
	JMP	GK1	; check again!
GK2:
	STA	IOCHAR	; save the char
	JSR	OFFCUR	; turn off cursor, if necessary

	; CONVERT & MASK KEYCODE IN [A]
	LDA	IOCHAR
	
	JSR	GOTKEY		; parse the ol key
	CMP	#0		; 0 RETURN MEANS BAD KEY
	BEQ	GK1		; no goodnik key, try again!

	RTS			; AND RETURN IT
;
; parse the key, returning it in (A), with 0 = bad key
;
GOTKEY:
	CMP	#'0'		; check for numbers
	BCC	GOTK1		; nope, let it go
	CMP	#'9'+1		; how about more than nine?
	BCS	GOTK1		; ayyup
;
; must be a number, see if it was the numeric keypad
;
	LDY	SFDX		; get keyboard coordinate
	CPY	#$41		; check against lowest keypad coord
	BCC	NCHK		; it was normal number
;
; pretend these ones are functions keys
;
	CLC			; get ready for translate
	ADC	#97		; keypads range from 145-154
NCHK:
	JMP	GOTDNE		; no need for further checking
GOTK1:
	CMP	#'A'		; CONVERT UNSHIFTED ALPHA
	BCC	GKA		; TO ASCII LOWER CASE
	CMP	#'Z'+1
	BCS	GKA
	ADC	#$20
	JMP	GOTDNE
GKA:
	CMP	#133		; LET FCN KEYS THRU, ALREADY CORRECT
	BCC	MASK
	CMP	#141
	BCC	GOTDNE
	CMP	#143
	BEQ	GOTDNE
;
; CHECK FOR "ARROWS", CONVERT FOR USE (EZIP)
; ALSO : CHANGE < > TO , .
;
MASK:	LDX	#ENDKEY		; GET LENGTH OF LIST
MASK0:	CMP	HAVE,X		; CHECK AGAINST LIST OF UNWANTED KEYS
	BEQ	MASK1		; FOUND IT
	DEX
	BPL	MASK0		; CHECK THEM ALL
	BMI	MASK3		; NOT FOUND, CONTINUE OTHER CHECKS
MASK1:	LDA	WANT,X		; GET KEY TO USE INSTEAD
	BNE	GOTDNE		; JMP
MASK3:
	AND	#%01111111	; SCREEN OUT SHIFTS
	CMP	#EOL		; EOL?
	BEQ	GOTDNE
	CMP	#BACKSP
	BEQ	GOTDNE
	CMP	#SPACE		; ANYTHING ELSE < "SPACE"
	BCC	BADKEY		; IS BAD

	LDX	#BLISTL		; IGNORE OBSTINATE NON ALLOWED KEYS
BADL:	CMP	BADLIST,X
	BEQ	BADKEY
	DEX
	BNE	BADL
GKCMP1:
	CMP	#'Z'+1		; PASS U-C ALPHA
	BCC	GOTDNE		; AND OTHER ASCII CHARS

BADKEY:	JSR	BOOP		; REJECT BAD KEYPRESS
	LDA	#0		; O MEANS BAD KEYPRESS
GOTDNE:
	STA	IOCHAR		; save char
	ADC	RNUM1		; FUTZ WITH RANDOM
	STA	RNUM1
	EOR	RNUM2
	STA	RNUM2
	LDA	IOCHAR		; go get it back

	RTS

	; ARROW AND FUNCTION KEYS FOR XZIP ARE:
	; FOUR ARROW KEYS (BOTH SETS MATCH) PLUS EXTRA UP ARROW KEY
	; FUNCTION KEYS ARE F1 - F8, F9 = ESC, F10 = TAB, F11 = HELP
	; F12 = LINE FEED
	; Also, numberic keypad 0-9 turns into 145-154
	;
HAVE:	DB	'<','>',$91,$11,$9D,$1D,$5E
	DB	$1B,$09,$0A
WANT:	DB	',','.',129,130,131,132,129
	DB	141,142,144
ENDKEY	EQU	$-WANT-1

BADLIST: DB	'%','&','=','@'
BLISTL	EQU	$-BADLIST-1

	; -------------------------
	; OUTPUT AN ASCII CHARACTER
	; -------------------------

LETTER:	CMP	#'a'		; LOWER-CASE?
	BCC	LET0		; NO, CONTINUE
	CMP	#'z'+1
	BCS	LETEX		; CTRL CHARS
	AND	#%01011111	; ELSE MASK FOR LOWER-CASE
	JMP	CHROUT

LET0:	CMP	#'A'		; UPPER-CASE?
	BCC	LETEX
	CMP	#'Z'+1
	BCS	LETEX
	ORA	#%00100000	; MAKE UPPER
LETEX:
	STA	IOCHAR	; just in case we need it
	JSR	CHROUT	; goodbye, cruel char
	RTS

FONTFLAG: DB	0		; 0 = font1/1 = not font 1, for current
				; output character

	; -----------------
	; PRINT CHAR IN [A]
	; -----------------

CHAR:	STA	IOCHAR		; SAVE HERE
	TXA
	PHA			; SAVE [X] AND [Y]
	TYA
	PHA

	LDA	IOCHAR		; RESTORE CHAR
	CMP	#$0E		; change to font 1?
	BNE	CH1		; nope

	LDX	#0		; set font1 flag showing font 1
	STX	FONTFLAG	; 0 = font 1
	BEQ	CH2
CH1:
	CMP	#$8E		; font 3/4 ?
	BNE	CH2		; nope
	
	LDX	#1
	STX	FONTFLAG	; 1 = not font 1
CH2:
	CMP	#$22
	BNE	NOQUOT

	JSR	LETTER		; QUOTE MARKS SCREW
	LDA	#0		; UP SYSTEM, SO
	STA	QUOTMOD		; TURN OFF QUOTE MODE FLAG
	BEQ	CHDUN

NOQUOT:	LDX	FONTFLAG	; IF FONT 3 OR 4 DO DIRECT CHROUT
	BNE	NOLETR		; LETTER CONVERTS CHARS

	JSR	LETTER		; OFF TO THE SCREEN!
CHDUN:
	LDA	IOCHAR	; go get char
	CMP	#EOL	; did we just send a <CR>?
	BNE	LETJ	; nope, continue
;
; move cursor back to left margin
;
	SEC
	JSR	PLOT	; first, get where cursor is
	LDY	ZBEGIN+ZLMRG+1 ; set left margin
	CLC		; and then send the
	JSR	PLOT	; cursor back there
	LDA	#0	; and then show no more chars in [LBUFF]
	STA	CHRCNT	; none more
	LDA	RVFLAG	; is rvideo on?
	BEQ	LETJ	; nope
	LDA	#$12	; turn it back on
	JSR	CHROUT	; okay
LETJ:
	PLA
	TAY			; RESTORE [X] AND [Y]
	PLA
	TAX
	RTS
NOLETR:
	JSR	CHROUT
	JMP	CHDUN


; -----------------------
; DIRECT PRINT LINE [X/A]
; -----------------------
; ENTRY: STRING ADDRESS IN [X/A] (LSB/MSB)
; STRING LENGTH IN [Y]

DLINE:	STX	STRING+LO	; DROP STRING ADDRESS
	STA	STRING+HI	; INTO DUMMY BYTES
	STY	MTEMP		; COUNTER

	LDA	TOP		; RETAIN STATUS LINE(S)
	STA	WTOP

	LDX	#0		; INIT CHAR-FETCH INDEX
DOUT:	DB	$BD		; 6502 "LDA nnnn,X" OPCODE
STRING:	DW	$0000		; DUMMY OPERAND BYTES
	JSR	CHAR
	INX
	DEC	MTEMP		; LOOP TILL
	BNE	DOUT		; OUT OF CHARS

	LDA	#0
	STA	WTOP

	RTS		


	; -----------------------
	; SEND [LBUFF] TO PRINTER
	; -----------------------

	; ENTRY: LENTH OF LINE IN [PRLEN]
	; NOW WITH IMPROVED ERROR PROTECTION! (BM 11/24/84)

PPRINT:	LDA	SCRIPT		; SCRIPTING INTERNALLY ENABLED?
	BEQ	PEX		; NO, SCRAM IMMEDIATELY

	LDA	ZBEGIN+ZSCRIP+1	; CHECK SCRIPT FLAG
	AND	#%00000001	; SCRIPTING ON?
	BEQ	PP3		; NO, CHECK FOR "UNSCRIPT"

	LDA	PSTAT		; CHECK PRINTER STATUS
	BMI	PEX		; CAN'T OPEN IF NEGATIVE
	BNE	PP1		; ALREADY OPEN, SCRIPT THE LINE

	; OPEN THE PRINTER FOR OUTPUT

PP0:	LDX	#1
	STX	PSTAT		; SET STATUS TO "PRINTER OPENED" (1)

	LDA	#4		; LOGICAL FILE #4
	TAX			; DEVICE #4
	LDY	#7		; ALLOW UPPER/LOWER CASE
	JSR	SETLFS		; SET UP LOGICAL FILE
	LDA	#0
	JSR	SETNAM		; NO FILENAME REQUIRED
	JSR	OPEN		; OPEN THE CHANNEL
	BCC	PP1		; OPEN OKAY IF CARRY CLEAR
PPERR:
	LDA	#$FF		; ELSE SET PRINTER STATUS
	STA	PSTAT		; TO "CAN'T OPEN"
	BNE	PP5		; AND SIMULATE AN "UNSCRIPT"
PP1:
	LDX	#4		; SET PRINTER CHANNEL
	JSR	CHKOUT		; TO "OUTPUT"
	BCS	PPERR		; ERROR IF CARRY SET

	LDY	#0		; INIT INDEX
PP2:	LDA	LBUFF,Y
	CMP	#$0D
	BEQ	PP6
	AND	#%01111111
	CMP	#$20
	BCC	PP4		; NO CONTROLS
PP6:	JSR	LETTER
	BCS	PPERR		; ERROR IF CARRY SET
PP4:	INY
	DEC	PRLEN
	BNE	PP2
	BEQ	PEX		; RESET & RETURN

	; CHECK FOR "UNSCRIPT"

PP3:	LDA	PSTAT		; CHECK PRINTER STATUS
	BEQ	PEX		; EXIT IF PRINTER WAS OFF
	BMI	PEX		; OR UNOPENABLE

PCLOSE:	LDA	#0		; RESET PRINTER STATUS FLAG
	STA	PSTAT		; TO "CLOSED"

	; ENTRY FOR PRINTER ERROR

PP5:	LDA	#4
	JSR	CLOSE		; CLOSE THE PRINTER CHANNEL
PEX:	JMP 	CLRCHN

PSTAT:	DB	0		; HERE SO RESTART WON'T ALTER


	; ------------
	; SPLIT SCREEN
	; ------------

	; SPLIT SCREEN AT LINE [ARG1]
	; DISABLE SPLIT IF [ARG1] = 0
	; IGNORE IF SPLIT ALREADY ENABLED OR [ARG1] >= 23

	; ON C-128, I AM USING KERNAL RTNS TO ACCESS SCREEN MEMORY
	; AS SCREEN MEMORY IS IN ITS OWN WORLD. IN ORDER NOT TO
	; SCROLL THE TOP WINDOW WHEN SCREEN IS SPLIT, THE C-128
	; TOP OF SCREEN INDICATOR MUST BE USED, BUT: NO ACCESS IS
	; ALLOWED ABOVE THAT INDICATOR. THAT INDICATOR (WTOP) WILL
	; THEREFORE BE SET ONLY WHEN SCROLLING MIGHT OCCUR, LEAVING
	; [WTOP] SET TO #0 OTHERWISE. THE SPLIT LINE IS KEPT TRACK
	; OF IN [TOP].

ZSPLIT:	LDA	TOP		; HOLD A SEC
	STA	I
	LDA	ARG1+LO		; GET # OF LINES FOR SCREEN
	BEQ	NORL		; IF 0 THEN RESTORE SCREEN
	CMP	#24		; IS SPLIT REALLY = WHOLE SCREEN
	BCS	ZSPOUT		; YES, IGNORE

	CMP	TOP		; IF SCREEN 1 SHRINKING
	BCS	ZSLVIT		; SET LINCNT - (TOP - [A])
	PHA			; HOLD IT
	SEC
	SBC	TOP
	ADC	LINCNT
	STA	LINCNT
	PLA

ZSLVIT:	STA	TOP		; SET THE TOP OF THE SECOND SCREEN
	STA	SPSTAT		; NON ZERO = SCREEN IS SPLIT
	CMP	LINCNT		; IS SCROLLING SCREEN NOW MORE THAN LINCNT?
	BCC	ZSPL3		; NO
	STA	LINCNT		; YES, RESET LINCNT
ZSPL3:	LDA	#0		; ALIGN TOP CURSOR FOR NEW SPLIT
	STA	OLD1Y
	STA	OLD1X

	SEC
	JSR	PLOT		; FIND WHERE WE ARE NOW
	CPX	I
	BCC	ZSPL5		; TOP SCREEN, GO TO 0,0
	CPX	TOP		; STAYING W/IN BOTTOM SCREEN
	BCS	ZSPOUT		; YUP

	LDX	TOP		; WERE IN TOP, NOW IN BOTTOM SCREEN
	LDY	ZBEGIN+ZLMRG+1	; SO GO TO TOP LEFT OF IT
	CLC
	JMP	PLOT

ZSPL5:	LDX	#0
	LDY	#0
	CLC
	JMP	PLOT

NORL:	;RESTORE SCREEN	TO FULL SCREEN MODE

	LDA	#0		; PUT CURSOR AT TOP OF SCREEN
	STA	WTOP		; RESTORE FULL SCREEN ALIGNMENT
	STA	TOP		; JIC
	STA	LINCNT
	STA	SPSTAT		; FLAG NOT SPLIT
ZSPOUT:	RTS


; ------
; SCREEN
; ------
; GO TO TOP WINDOW (TOP OF SCREEN) IF [ARG1] = 1
; GO TO BOTTOM OF SCREEN IF [ARG1] = 0
; IGNORE IF SPLIT NOT ENABLED OR [ARG1] <> 0 OR 1
; FLAG SPLITF WILL BE SET FOR OUTPUT TO DETERMINE
; IF AND WHICH WINDOW TO DISPLAY TO
; (0=BOTTOM 1=TOP)

ZSCRN:
	LDA	SPSTAT		; CHECK IF SCREEN IS SPLIT
	BEQ	ZSPOUT		; NO, SO JUST LEAVE
	JSR	CLRBUF		; EMPTY OUTPUT BUFFER BEFORE MOVING
	SEC			; GET CURSOR LOC
	JSR	PLOT
	TXA
	LDX	SPLITF		; SAVE CURSOR OF SCREEN NOW IN
SCRSAV:	STA	OLD0X,X
	TYA
	STA	OLD0Y,X

	LDA	ARG1+LO		; CHECK WHICH WINDOW
	BNE	SCRN1		; TOP SCREEN

SCRN0:	LDA	#$FF		; SCROLLING SCREEN SO
	STA	SCRIPT		; ALLOW SCRIPTING
	LDA	OLDWD		; RESET MARGINS
	STA	XSIZE
	LDA	#0
	STA	SPLITF		; SET FLAG TO BOTTOM SCREEN (0)
	JMP	SCRNP		; JMP TO <CR> RTN

SCRN1:	CMP	#01
	BNE	ZSPOUT		; INVALID SCREEN ID
	STA	SPLITF		; SET FLAG TO UNSCROLLING SCREEN (1)
	LDA	XSIZE		; SAVE MARGINS
	STA	OLDWD

	LDA	#0
	STA	SCRIPT		; SET SCRIPTNG OFF, NOT ALLOWED THIS SCREEN
	LDA	#79
	STA	XSIZE		; SET FOR TOP SCREEN USING WHOLE WIDTH
SCRNP:
	LDX	SPLITF		; WHICH SCREEN
	LDA	FONT,X		; get screens font
	CMP	#1		; to font 1?
	BNE	SCF1		; nope
	LDX	FONTFLAG	; 1 means we weren't in font 1 before
	BEQ	SCF2		; here we don't need to change it
	BNE	SCF3		; so we need to change it
SCF1:
	LDX	FONTFLAG	; 0 means we are already in font 1
	BNE	SCF2		; so don't change a thing
SCF3:
	JSR	CHFONT		; and change to it
SCF2:	
	LDX	SPLITF		; WHICH SCREEN
	LDA	OLD0Y,X		; SET CURSOR TO WHERE IT WAS IN THAT WINDOW
	TAY
	LDA	OLD0X,X
	TAX
	CLC
	JMP	PLOT		; SET CURSOR (+ LEAVE)


	; ------
	; MARGIN
	; ------

ZMARG:	JSR	CLRBUF		; CLEAR LBUFF BEFORE RESETTING LINE MARGINS
	LDA	ARG2+LO		; SET RIGHT MARGIN
	STA	ZBEGIN+ZRMRG+1
	LDA	ARG1+LO
	STA	ZBEGIN+ZLMRG+1
	LDA	#79		; FULL WIDTH
	SEC
	SBC	ARG2+LO		; SUBTRACT BOTH MARGINS
	SBC	ARG1+LO		; TO GET NEW WIDTH
	STA	XSIZE
	STA	OLDWD		; JIC

	SEC
	JSR	PLOT
	LDY	ARG1+LO		; SET CURSOR AT NEW LEFT MARGIN
	CLC
	JMP	PLOT


	; -----
	; SOUND
	; -----
	; ARG1 = BOOP (2) BEEP (1) ALL OTHERS INVALID
	; (EZIP)

ZSOUND:	LDX	ARG1+LO	; GET SOUND WANTED
	DEX		
	BNE	ZSO1
	JMP	BEEP	
ZSO1:	DEX		
	BNE	ZSOEX	; INVALID
	JMP	BOOP	; DOWN IN COMMON MEMORY

ZSOEX:	RTS		


	; -----
	; COLOR
	; -----
	; ARG1 IS FOREGROUND, ARG2 BACKGROUND
	; TRANSLATES GAME COLOR CODE TO MACHINE CODE
	; ONLY AVAILABLE IF USER ASKED FOR COLOR
	; (MONOCHROME MONITOR POSSIBLE)

ZCOLOR:	; SET BACKGROUND COLOR IN REGISTER 26 BITS 3-0 OF 80 COL CHIP
	LDA	ZBEGIN+ZMODE
	AND	#$01
	BEQ	ZCNO		; WE'RE NOT ON

	JSR	CLRBUF		; MAKE SURE ANYTHING WAITING IS DISPLAYED

	LDX	ARG2+LO		; GO SET BACKGROUND COLOR
	BEQ	ZFORE		; BACK SET TO NO CHANGE, CHECK FORE
	LDA	BAKCOL,X
	JSR	COLOR		; RTN IN SHARED MEMORY
ZFORE:	LDX	ARG1+LO		; AND FOREGROUND COLOR
	BEQ	ZCNO		; NO CHANGE
	LDA	FORCOL,X
	JSR	ADDBUF		; add unprinting char to buffer
ZCNO:	RTS

FORCOL:	DB	00,$9F,$90,$1C,$1E,$9E,$1F,$81,$97,$05
BAKCOL:	DB	0,0,0,8,4,$0D,2,$0A,6,$0F


ZDISPL:
ZDCLR:	RTS
ZPICNF:	JMP	PREDF		; SET AS BAD


;********SET A FLAG SO RESTARTS DON'T DO THIS
;********
	; ALLOWS FOR 2 FONTS, 3 & 4, THAT ARE LOCATED AT TRACK 32, SECTOR 0
	; AND TRACK 33, SECTOR 0 AND HAVE A MAX LENGTH OF 4 SECTORS (1K)
	; AFTER READING IN THE 4 SECTORS A CHECK IS MADE TO SEE IF THERE 
	; IS A FONT FILE THERE, IF NOT A FLAG IS SET SO THAT THE FONT OPCODE
	; RETURNS A FAIL IF THE GAME TRIES TO USE THAT FONT
	; A CHECK IS ALSO MADE TO MAKE SURE THAT CHARACTERS WITH A VALUE LESS
	; THAN 32 ARE NOT USED AND THAT ALL CHARS ARE 8*8 IN SIZE. (GOFF 
	; LESS THAN 32, OR GSIZE IS NOT 8*8)  THE ZIP
	; WILL HALT WITH ERROR CODE 17 IF EITHER OF THESE OCCUR. OTHERWISE
	; THE CHAR DEFINITIONS ARE LOADED INTO THE 80 COL CHIP CHARACTER
	; DEFINITION RAM. THE SETUP THERE IS 8 BYTES OF CHAR DEFINITION
	; FOLLOWED BY 8 BYTES OF NULLS. ALSO CHARS ARE LOADED IN AS SUCH:
	; 	CHAR	ASCII VALUE	ADDRESS IN CHAR DEF RAM
	;     @ - <-	 $40 - $5F	     $3000 - $31FF
	;  SPACE - ?	 $20 - $3F	     $3200 - $33FF
	;     A - Z	 $61 - $7A	     $3410 - $35xx
	; THIS IS FOR UPPER/LOWER CHARS, INVERSE STARTS AT $3800
	; AND UPPER/GRAPHICS DEFS ARE AT $2000, THIS SECTION AT $2000 IS
	; WHAT IS BEING USED FOR THE 2 ALTERNATE CHAR SETS.
	; @ = 3C 66 6E 6E 60 62 3C 00 00 00 00 00 00 00 00 00 
	
LDFNTS:
	LDA	RESFLG		; is this a restart?
	BEQ	LDFj		; nope, so check it out

	JMP	DONE		; okay, so done it
LDFj:
	LDA	#FONT3T		; FONT 1 TRACK
	STA	TRACK
	LDA	#FONT3S		; AND ITS FIRST SECTOR
	STA	SECTOR

	LDA	#$20
	STA	STRT
	LDA	#$24
	STA	STRT96
	JSR	MOVFNT
	BCC	FONT4
	LDA	#1		; SET SO WON'T USE FONT 3
	STA	F3FLG

	; FALL THRU TO DO FONT4 ALSO

FONT4:	LDA	#FONT4T		; FONT 1 TRACK
	STA	TRACK
	LDA	#FONT4S		; AND ITS FIRST SECTOR
	STA	SECTOR
	LDA	#$28
	STA	STRT
	LDA	#$2C
	STA	STRT96
	JSR	MOVFNT
	BCC	F4EX
	LDA	#1		; SET SO WON'T USE FONT 3
	STA	F4FLG		; FLAG STARTS = 0

F4EX:	LDX	#>ZBEGIN	; RESET POINTERS TO LOAD
	INX			; IN REST OF GAME NOW
	STX	DBUFF+HI	; STARTING WITH 2ND PAGE
	LDX	#00		; (1ST ALREADY IN)
	STX	DBLOCK+HI
	INX
	STX	DBLOCK+LO
	LDA	#MAIN
	STA	DSKBNK		; JIC
	RTS


	; READ FONT FILE IN AT ZBEGIN + 1
	; AND MOVE ITS CONTENTS INTO 80 COL CHAR DEFINITION RAM

MOVFNT:	LDX	#>ZBEGIN	; READ FONT FILE IN AT PAGE AFTER ZBEGIN
	INX			; AS 1ST PAGE OF GAME ALREADY IN
	STX	DBUFF+HI
	STX	I+HI		; SET FOR COPY
	LDX	#0		; PAGE ALIGNED!
	STX	I+LO
	LDA	#MAIN
	STA	DSKBNK
	LDA	#4		; 4 PAGES LONG
	STA	L
F1LP:	JSR	GETRES
	BCC	F1OK
	JMP	DSKERR		; BAD READ
F1OK:	DEC	L
	BNE	F1LP

	LDY	#5
ISFILE:	LDA	(I),Y		; CHECK IF THERE IS A FONT FILE
	BNE	CHKFLE		; IF <> 0, then must be something there
	DEY
	BPL	ISFILE
	SEC			; NO FONT FILE PRESENT
	RTS			; SET SO THAT DON'T TRY TO USE THAT FONT

CHKFLE:	LDY	#GOFF
	LDA	(I),Y		; CHECK HIGH BYTE SB. 0
	BNE	BADGR
	INY
	LDA	(I),Y
	CMP	#32
	BCC	BADGR
	STA	GCHAR		; SET STARTING CHAR
	LDY	#GSIZE
	LDA	(I),Y
	CMP	#8
	BNE	BADGR		; CHAR SIZE MUST BE 8*8
	INY
	LDA	(I),Y		; OR I DON'T KNOW THE ALIGNMENT TO USE
	CMP	#8
	BEQ	GOODGR

	; *** ERROR #17: ALTERNATE CHAR SET FILE NOT USABLE ***

BADGR:	LDA	#17
	JMP	ZERROR


	; OK, THIS ALTERNATE CHARACTER SET CAN BE USED ON THE C128
	; SO LOAD IT INTO THE 80-COL CHIP CHAR DEFINITION RAM

GOODGR:	LDY	#GCOUNT		; CHAR MAX IS 96, SKIP ANY MORE THAN THIS
	LDA	(I),Y
	BNE	SETMAX
	INY
	LDA	(I),Y
	CMP	#97
	BCC	GOK
SETMAX:	LDA	#96
GOK:	CLC
	ADC	GCHAR
	STA	GEND		; SET JUST BEYOND LAST CHAR TO DO

	LDA	#CSTART		; SET I TO WHERE CHAR DEFS START
	STA	I+LO		; (JUST SET CAUSE PAGE STARTED AT 0)

	LDA	GCHAR
	LDX	#0
	STX	J+HI
	LDY	#4
GLP:	ASL	A		; MULTIPLY START CHAR BY 16 TO GET OFFSET
	ROL	J+HI		; INTO 80-COL CHAR RAM
	DEY
	BNE	GLP
	STA	J+LO
	LDA	STRT		; ADD IN START OF CHAR RAM
	CLC
	ADC	J+HI
	STA	J+HI

	LDA	GCHAR		; IF STARTING IN 64 - 95 RANGE
	CMP	#$40		; MUST BRING IT DOWN TO WHERE
	BCC	BIGLP		; IT BELONGS AT $2000
	CMP	#$60		; (MULTIPLIES IN AT $2300 RANGE)
	BCS	BIGLP
	LDA	J+HI
	SEC
	SBC	#3
	STA	J+HI

BIGLP:	LDA	#8
	STA	K
SMLOOP:	LDY	#0		;GET ADDR & VALUE
	LDA	(I),Y
	LDX	J+HI
	LDY	J+LO
	JSR	WRTCHR		; AND WRITE IT OUT

	INC	J+LO
	BNE	INCI
	INC	J+HI
INCI:	INC	I+LO
	BNE	CHKCNT
	INC	I+HI
CHKCNT:	DEC	K
	BNE	SMLOOP
	LDA	#8		; SKIP 8 NULL BYTES OF CHAR DEFINITION
	CLC			; IN 80 COL CHAR DEF RAM
	ADC	J+LO
	STA	J+LO
	BCC	NXTCHR		; ON TO NEXT CHAR
	INC	J+HI

NXTCHR:	INC	GCHAR		; NEXT CHAR TO DO
	LDA	GCHAR
	CMP	GEND		; DONE THEM ALL?
	BCS	DONE		; NOPE

	CMP	#$40		; 64 AND 96 ARE BORDER CHARACTERS
	BNE	CHK60
	LDA	STRT		; 64 - 95 LOAD IN AT $2000
	STA	J+HI
	LDA	#0
	STA	J+LO
	BEQ	BIGLP		; JMP
CHK60:	CMP	#$60		; 96 - 127 LOAD IN AT $2400
	BNE	BIGLP
	LDA	STRT96
	STA	J+HI
	LDA	#0
	STA	J+LO
	BEQ	BIGLP		; JMP

DONE:	CLC			; TELL CALLING RTN THE FONT IS LOADED
	RTS

	END