********************************************************************
* CCIO - OS-9 Level One V2 CoCo I/O driver
*
* $Id$
*
* Edt/Rev  YYYY/MM/DD  Modified by
* Comment
* ------------------------------------------------------------------
*  12      ????/??/??  ???
* From Tandy OS-9 Level One VR 02.00.00.
*
*  12r1    2003/09/11  Rodney V. Hamilton
* Modified key table to include $7F, $1D, $1E and $1F codes.

         nam   CCIO
         ttl   OS-9 Level One V2 CoCo I/O driver

         ifp1
         use   defsfile
	 use   scfdefs
	 use   cciodefs
         endc

tylg     set   Drivr+Objct
atrv     set   ReEnt+rev
rev      set   $01
edition  set   12

         mod   eom,name,tylg,atrv,start,size

size     equ   V.Last

         fcb   UPDAT.+EXEC.

name     fcs   /CCIO/
         fcb   edition

start    lbra  Init
         lbra  Read
         lbra  Write
         lbra  GetStat
         lbra  SetStat
         lbra  Term

* Init
*
* Entry:
*    Y  = address of device descriptor
*    U  = address of device memory area
*
* Exit:
*    CC = carry set on error
*    B  = error code
*
Init     stu   >D.KbdSta	store devmem ptr
         clra			clear A
         leax  <V.SCF,u		point to memory after V.SCF
         ldb   #$5D		get counter
L002E    sta   ,x+		clear mem
         decb			decrement counter
         bne   L002E		continue if more
         coma			A = $FF
         comb			B = $FF
         stb   <V.Caps,u
         std   <V.LKeyCd,u
         std   <V.2Key2,u
         lda   #60
         sta   <V.ClkCnt,u
         leax  >AltIRQ,pcr	get IRQ routine ptr
         stx   >D.AltIRQ	store in AltIRQ
         leax  >SetDsply,pcr	get display vector
         stx   <V.DspVct,u	store in vector address
         leax  >XY2Addr,pcr	get address of XY2Addr
         stx   <V.CnvVct,u
         ldd   <IT.PAR,y	get parity and baud
         lbra  L05CE		process them

* Term
*
* Entry:
*    U  = address of device memory area
*
* Exit:
*    CC = carry set on error
*    B  = error code
*
Term     pshs  cc
         orcc  #IRQMask		mask interrupts
         ldx   >D.Clock		get clock vector
         stx   >D.AltIRQ	and put back in AltIRQ
         puls  pc,cc

* Read
*
* Entry:
*    Y  = address of path descriptor
*    U  = address of device memory area
*
* Exit:
*    A  = character read
*    CC = carry set on error
*    B  = error code
*
Read     leax  <V.InBuf,u	point X to input buffer
         ldb   <V.IBufT,u	get tail pointer
         orcc  #IRQMask		mask IRQ
         cmpb  <V.IBufH,u	same as head pointer
         beq   Put2Bed		if so, buffer is empty, branch to sleep
         abx			X now points to curr char
         lda   ,x		get char
         bsr   L009D		check for tail wrap
         stb   <V.IBufT,u	store updated tail
         andcc #^(IRQMask+Carry)	unmask IRQ
         rts

Put2Bed  lda   V.BUSY,u		get calling process ID
         sta   V.WAKE,u		store in V.WAKE
         andcc #^IRQMask	clear interrupts
         ldx   #$0000
         os9   F$Sleep		sleep forever
         clr   V.WAKE,u		clear wake
         ldx   <D.Proc		get pointer to current proc desc
         ldb   <P$Signal,x	get signal recvd
         beq   Read		branch if no signal
         cmpb  #S$Window	window signal?
         bcc   Read		branch if so
         coma
         rts
* Check if we need to wrap around tail pointer to zero
L009D    incb			increment pointer
         cmpb  #$7F		at end?
         bls   L00A3		branch if not
         clrb			else clear pointer (wrap to head)
L00A3    rts

*
* IRQ routine for keyboard
*
AltIRQ   ldu   >D.KbdSta	get keyboard static
         ldb   <V.CFlg1,u	graphics screen currently being displayed?
         beq   L00B7		branch if not
         ldb   <V.Alpha,u	alpha mode?
         beq   L00B7		branch if so
         lda   <V.PIA1,u
         lbsr  SetDsply		set up display
L00B7    ldx   #PIA0Base	point to PIA base
         clra
         clrb
         std   <V.KySns,u	clear keysense byte
         bsr   L00E8		get bits
         bne   L00CC
         clr   $02,x		clear PIA0Base+2
         lda   ,x		get byte from PIA
         coma			complement
         anda  #$7F		strip off hi bit
         bne   L00F1		branch if any bit set
L00CC    clra
         clrb
         std   <V.KTblLC,u	clear
         coma			A = $FF
         tst   <V.Spcl,u	special key?
         bne   l@		branch if so
         sta   <V.LKeyCd,u
l@       stb   <V.Spcl,u	clear for next time
         comb  
         sta   <V.2Key1,u
         std   <V.2Key2,u
L00E4    jmp   [>D.Clock]	jump into clock module

L00E8    comb
         stb   $02,x		strobe one column
         ldb   ,x		read PIA #0 row states
         comb			invert bits so 1=key pressed
         andb  #$03		mask out all but lower 2 bits
         rts

L00F1    bsr   L015C
         bmi   L00CC
         clrb
         bsr   L00E8
         bne   L00CC
         cmpa  <V.6F,u
         bne   L010E
         ldb   <V.ClkCnt,u
         beq   L010A
         decb
L0105    stb   <V.ClkCnt,u
         bra   L00E4
L010A    ldb   #$05
         bra   L011A
L010E    sta   <V.6F,u
         ldb   #$05
         tst   <V.KySame,u
         bne   L0105
         ldb   #60
L011A    stb   <V.ClkCnt,u
         ldb   <V.IBufH,u	get head pointer in B
         leax  <V.InBuf,u	point X to input buffer
         abx			X now holds address of head
         lbsr  L009D		check for tail wrap
         cmpb  <V.IBufT,u	B at tail?
         beq   L012F		branch if so
         stb   <V.IBufH,u
L012F    sta   ,x		store our char at ,X
         beq   WakeIt		if nul, do wake-up
         cmpa  V.PCHR,u		pause character?
         bne   L013F		branch if not
         ldx   V.DEV2,u		else get dev2 statics
         beq   WakeIt		branch if none
         sta   V.PAUS,x		else set pause request
         bra   WakeIt
L013F    ldb   #S$Intrpt	get interrupt signal
         cmpa  V.INTR,u		our char same as intr?
         beq   L014B		branch if same
         ldb   #S$Abort		get abort signal
         cmpa  V.QUIT,u		our char same as QUIT?
         bne   WakeIt		branch if not
L014B    lda   V.LPRC,u		get ID of last process to get this device
         bra   L0153		go for it
WakeIt   ldb   #S$Wake		get wake signal
         lda   V.WAKE,u		get process to wake
L0153    beq   L0158		branch if none
         os9   F$Send		else send wakeup signal
L0158    clr   V.WAKE,u		clear process to wake flag
         bra   L00E4		and move along

L015C    clra
         clrb
         std   <V.ShftDn,u	SHIFT/CTRL flag; 0=NO $FF=YES
         std   <V.KeyFlg,u
* %00000111-Column # (Output, 0-7)
* %00111000-Row # (Input, 0-6)
         coma
         comb
         std   <V.Key1,u	key 1&2 flags $FF=none
         sta   <V.Key3,u	key 3     "
         deca			lda #%11111110
         sta   $02,x		write column strobe
L016F    lda   ,x		read row from PIA0Base
         coma			invert so 1=key pressed
         anda  #$7F		keep only keys, bit 0=off 1=on
         beq   L0183		no keys pressed, try next column
         ldb   #$FF		preset counter to -1
L0178    incb
         lsra			bit test regA
         bcc   L017F		no key, brach
         lbsr  L0221		convert column/row to matrix value and store
L017F    cmpb  #$06		max counter
         bcs   L0178		loop if more bits to test
L0183    inc   <V.KeyFlg,u	counter; used here for column
         orcc  #Carry		bit marker; disable strobe
         rol   $02,x		shift to next column
         bcs   L016F		not finished with columns so loop
         lbsr  L0289		simultaneous check; recover key matrix value
         bmi   L020A		invalid so go
         cmpa  <V.LKeyCd,u	last keyboard code
         bne   L0199
         inc   <V.KySame,u	same key flag ?counter?
L0199    sta   <V.LKeyCd,u	setup for last key pressed
         beq   L01B9		if @ key, use lookup table
         suba  #$1A		the key value (matrix) of Z
         bhi   L01B9		not a letter, so go
         adda  #$1A		restore regA
         ldb   <V.CtrlDn,u	CTRL flag
         bne   L01E9		CTRL is down so go
         adda  #$40		convert to ASCII value; all caps
         ldb   <V.ShftDn,u	shift key flag
         eorb  <V.Caps,u	get current device static memory pointer
         andb  #$01		tet caps flag
         bne   L01E9		not shifted so go
         adda  #$20		convert to ASCII lowercase
         bra   L01E9
* Not a letter key, use the special keycode lookup table
* Entry: A = table idnex (matrix scancode-26)
L01B9    ldb   #$03		three entries per key (normal, SHIFT, CTRL)
         mul			convert index to table offset
         lda   <V.ShftDn,u	shift key flag
         beq   L01C4		not shifted so go
         incb			else adjust offset for SHIFTed entry
         bra   L01CB		and do it
L01C4    lda   <V.CtrlDn,u	CTRL flag?
         beq   L01CB		adjust offset for CTRL key
         addb  #$02
L01CB    lda   <V.KySnsF,u	key sense flag?
         beq   L01D4		not set, so go
         cmpb  #$11		spacebar?
         ble   L0208		must be an arrow so go
L01D4    cmpb  #$4C		ALT key? (SHOULD BE $4C???)
         blt   L01DD		not ALT, CTRL, F1, F2 or SHIFT so go
         inc   <V.AltDwn,u	flag special keys (ALT, CTRL)
         subb  #$06		adjust offset to skip them
L01DD    pshs  x		save X
         leax  >KeyTbl,pcr	point to keyboard table
         lda   b,x
         puls  x
         bmi   L01FD		if A = $81 - $84, special key
* several entries to this routine from any key press; A is already ASCII
L01E9    ldb   <V.AltDwn,u	was ALT flagged?
         beq   L01FA		no, so go
         cmpa  #$3F		?
         bls   L01F8		# or code
         cmpa  #$5B		[
         bcc   L01F8		capital letter so go
         ora   #$20		convert to lower case
L01F8    ora   #$80		set for ALT characters
L01FA    andcc #^Negative	not negative
         rts
* Flag that special key was hit
L01FD    inc   <V.Spcl,u
         ldb   <V.KySame,u
         bne   L0208
         com   <V.Caps,u
L0208    orcc  #Negative	set negative
L020A    rts

* Calculate arrow keys for key sense byte
L020B    pshs  b,a		convert column into power of 2
         clrb
         orcc  #Carry
         inca
L0211    rolb
         deca
         bne   L0211
         bra   L0219
L0217    pshs  b,a
L0219    orb   <V.KySns,u	previous value of column
         stb   <V.KySns,u
         puls  pc,b,a
* Check special keys (SHIFT, CTRL, ALT)
L0221    pshs  b,a
         cmpb  #$03		is it row 3?
         bne   L0230
         lda   <V.KeyFlg,u	get column #
         cmpa  #$03		is it column 3?; ie up arrow
         blt   L0230		if lt it must be a letter
         bsr   L020B		its a non letter so bsr
L0230    lslb			B*8 8 keys per row
         lslb
         lslb
         addb  <V.KeyFlg,u	add in the column #
         beq   L025D
         cmpb  #$33		ALT
         bne   L0243
         inc   <V.AltDwn,u	ALT down flag
         ldb   #$04
         bra   L0219
L0243    cmpb  #$31		CLEAR?
         beq   L024B
         cmpb  #$34		CTRL?
         bne   L0252
L024B    inc   <V.CtrlDn,u	CTRL down flag
         ldb   #$02
         bra   L0219
L0252    cmpb  #$37		SHIFT key
         bne   L0262
         com   <V.ShftDn,u	SHIFT down flag
         ldb   #$01
         bra   L0219
L025D    ldb   #$04
         bsr   L0217
         clrb
* Check how many key (1-3) are currently being pressed
L0262    pshs  x
         leax  <V.Key1,u	1st key table
         bsr   L026D
         puls  x
         puls  pc,b,a
L026D    pshs  a
         lda   ,x
         bpl   L0279
         stb   ,x
         ldb   #$01
         puls  pc,a
L0279    lda   $01,x
         bpl   L0283
         stb   $01,x
         ldb   #$02
         puls  pc,a
L0283    stb   $02,x
         ldb   #$03
         puls  pc,a
* simultaneous key test
L0289    pshs  y,x,b
         bsr   L02EE
         ldb   <V.KTblLC,u	key table entry #
         beq   L02C5
         leax  <V.2Key1,u	point to 2nd key table
         pshs  b
L0297    leay  <V.Key1,u	1st key table
         ldb   #$03
         lda   ,x		get key #1
         bmi   L02B6		go if invalid? (no key)
L02A0    cmpa  ,y		is it a match?
         bne   L02AA		go if not a matched key
         clr   ,y
         com   ,y		set value to $FF
         bra   L02B6
L02AA    leay  $01,y
         decb
         bne   L02A0
         lda   #$FF
         sta   ,x
         dec   <V.KTblLC,u	key table entry #
L02B6    leax  $01,x
         dec   ,s		column counter
         bne   L0297
         leas  $01,s
         ldb   <V.KTblLC,u	key table entry (can test for 3 simul keys)
         beq   L02C5
         bsr   L0309
L02C5    leax  <V.Key1,u	1st key table
         lda   #$03
L02CA    ldb   ,x+
         bpl   L02DE
         deca
         bne   L02CA
         ldb   <V.KTblLC,u	key table entry (can test for 3 simul keys)
         beq   L02EA
         decb
         leax  <V.2Key1,u	2nd key table
         lda   b,x
         bra   L02E8
L02DE    tfr   b,a
         leax  <V.2Key1,u	2nd key table
         bsr   L026D
         stb   <V.KTblLC,u
L02E8    puls  pc,y,x,b
L02EA    orcc  #Negative	flag negative
         puls  pc,y,x,b

L02EE    ldd   <V.ShftDn,u
         bne   L0301
         lda   #$03
         leax  <V.Key1,u
L02F8    ldb   ,x
         beq   L0302
         leax  $01,x
         deca
         bne   L02F8
L0301    rts
L0302    comb
         stb   ,x
         inc   <V.AltDwn,u
         rts

* Sort 3 byte packet @ G.2Key1 according to sign of each byte
* so that positive #'s are at beginning & negative #'s at end
L0309    leax  <V.2Key1,u	2nd key table
         bsr   L0314		sort bytes 1 & 2
         leax  $01,x
         bsr   L0314		sort bytes 2 & 3
         leax  -$01,x		sort 1 & 2 again (fall thru for third pass)
L0314    lda   ,x		get current byte
         bpl   L0320		positive - no swap
         ldb   $01,x		get next byte
         bmi   L0320		negative - no swap
         sta   $01,x		swap the bytes
         stb   ,x
L0320    rts

* Key Table
* 1st column = key (no modifier)
* 2nd column = SHIFT+key
* 3rd column = CTRL+key 
KeyTbl   fcb   $00,$40,$60	ALT @ `
         fcb   $0c,$1c,$13	UP
         fcb   $0a,$1a,$12	DOWN
         fcb   $08,$18,$10	LEFT
         fcb   $09,$19,$11	RIGHT
         fcb   $20,$20,$20	SPACEBAR
         fcb   $30,$30,$81	0 0 capslock
         fcb   $31,$21,$7c	1 ! |
         fcb   $32,$22,$00	2 " null
         fcb   $33,$23,$7e	3 # ~
         fcb   $34,$24,$1d	4 $ RS  (was null)
         fcb   $35,$25,$1e	5 % GS  (was null)
         fcb   $36,$26,$1f	6 & US  (was null)
         fcb   $37,$27,$5e	7 ' ^
         fcb   $38,$28,$5b	8 ( [
         fcb   $39,$29,$5d	9 ) ]
         fcb   $3a,$2a,$00	: * null
         fcb   $3b,$2b,$7f	; + del (was null)
         fcb   $2c,$3c,$7b	, < {
         fcb   $2d,$3d,$5f	- = _
         fcb   $2e,$3e,$7d	. > }
         fcb   $2f,$3f,$5c	/ ? \
         fcb   $0d,$0d,$0d	ENTER key
         fcb   $00,$00,$00	CLEAR key
         fcb   $05,$03,$1b	BREAK key
         fcb   $31,$33,$35	F1 key
         fcb   $32,$34,$36	F2 key

* Write
*
* Entry:
*    A  = character to write
*    Y  = address of path descriptor
*    U  = address of device memory area
*
* Exit:
*    CC = carry set on error
*    B  = error code
*
Write    ldb   <V.NGChr,u	are we in the process of getting parameters?
         bne   PrmHandl		yes, go process
         sta   <V.WrChr,u	save character to write
         cmpa  #C$SPAC		space or higher?
         bcc   GoCo		yes, normal write
         cmpa  #$1E		escape sequence $1E or $1F?
         bcc   Escape		yes, go process
         cmpa  #$0F		GFX codes?
         lbcc  GfxDispatch	branch if so
         cmpa  #C$BELL		bell?
         lbeq  Ding		if so, ring bell
* Here we call the CO-module to write the character
GoCo     lda   <V.CurCo,u	get CO32/CO80 flag
CoWrite  ldb   #$03		we want to write
CallCO   leax  <V.GRFOE,u	get base pointer to CO-entries
         ldx   a,x		get pointer to CO32/CO80
         beq   NoIOMod		branch if no module
         lda   <V.WrChr,u	get character to write
L039D    jmp   b,x		call i/o subroutine
NoIOMod  comb  
         ldb   #E$MNF
         rts 

* Parameter handler
PrmHandl cmpb  #$02		two parameters left?
         beq   L03B0		branch if so
         sta   <V.NChr2,u	else store in V.NChr2
         clr   <V.NGChr,u	clear parameter counter
         jmp   [<V.RTAdd,u]	jump to return address
L03B0    sta   <V.NChar,u	store in V.NChar
         dec   <V.NGChr,u	decrement parameter counter
         clrb
         rts

Escape   beq   L03C5		if $1E, we conveniently ignore it
         leax  <COEscape,pcr	else it's $1F... set up to get next char
L03BD    ldb   #$01
L03BF    stx   <V.RTAdd,u
         stb   <V.NGChr,u
L03C5    clrb
         rts

COEscape ldb   #$03		write offset into CO-module
         lbra  JmpCO

* Show VDG or Graphics screen
* Entry: B = 0 for VDG, 1 for Graphics
SetDsply pshs  x,a
         stb   <V.Alpha,u	save passed flag in B
         lda   >PIA1Base+2
         anda  #$07		mask out all but lower 3 bits
         ora   ,s+		OR in passed A
         tstb			display graphics?
         bne   L03DE		branch if so
         ora   <V.CFlag,u
L03DE    sta   >PIA1Base+2
         sta   <V.PIA1,u
         tstb			display graphics?
         bne   DoGfx		branch if so
* Set up VDG screen for text
DoVDG
         stb   >$FFC0
         stb   >$FFC2
         stb   >$FFC4
         lda   <V.ScrnA,u	get pointer to alpha screen
         bra   L0401

* Set up VDG screen for graphics
DoGfx    stb   >$FFC0
         stb   >$FFC3
         stb   >$FFC5
         lda   <V.SBAdd,u	get pointer to graphics screen

L0401    ldb   #$07
         ldx   #$FFC6
         lsra
L0407    lsra
         bcs   L0410
         sta   ,x+
         leax  $01,x
         bra   L0414
L0410    leax  $01,x
         sta   ,x+
L0414    decb
         bne   L0407
         clrb
         puls  pc,x

GRFO     fcs   /GRFO/
CO32     fcs   /CO32/
CO80     fcs   /CO80/

* GetStat
*
* Entry:
*    A  = function code
*    Y  = address of path descriptor
*    U  = address of device memory area
*
* Exit:
*    CC = carry set on error
*    B  = error code
*
GetStat  sta   <V.WrChr,u	save off stat code
         cmpa  #SS.Ready	ready call?
         bne   L0439		branch if not
         lda   <V.IBufT,u	get buff tail ptr
         suba  <V.IBufH,u	num of chars ready in A
         lbeq  NotReady		branch if empty
SSEOF    clrb	
         rts
L0439    cmpa  #SS.EOF		EOF?
         beq   SSEOF		branch if so
         ldx   PD.RGS,y		get caller's regs
         cmpa  #SS.Joy		joystick?
         beq   SSJOY		branch if so
         cmpa  #SS.ScSiz	screen size?
         beq   SSSCSIZ		branch if so
         cmpa  #SS.KySns	keyboard sense?
         beq   SSKYSNS		branch if so
         cmpa  #SS.DStat	display status?
         lbeq  SSDSTAT		branch if so
         ldb   #$06		getstat entry into CO-module
         lbra  JmpCO

* Return key sense information
SSKYSNS  ldb   <V.KySns,u	get key sense info
         stb   R$A,x		put in caller's A
         clrb
         rts

* Return screen size
SSSCSIZ  clra			clear upper 8 bits of D
         ldb   <V.Col,u	get column count
         std   R$X,x		save in X
         ldb   <V.Row,u	get row count
         std   R$Y,x		save in Y
         clrb			no error
         rts

* Get joytsick values
SSJOY    pshs  y,cc
         orcc  #IRQMask		mask interrupts
         lda   #$FF
         sta   >PIA0Base+2
         ldb   >PIA0Base
         ldy   R$X,x		get joystick number to poll
         bne   L0481
         andb  #$01
         bne   L0485
         bra   L0486
L0481    andb  #$02
         beq   L0486
L0485    clra
L0486    sta   R$A,x
         lda   >PIA0Base+3
         ora   #$08
         ldy   R$X,x
         bne   L0494
         anda  #$F7
L0494    sta   >PIA0Base+3
         lda   >PIA0Base+1
         anda  #$F7
         bsr   L04B3
         std   R$X,x
         lda   >PIA0Base+1
         ora   #$08
         bsr   L04B3
         pshs  b,a
         ldd   #63
         subd  ,s++
         std   R$Y,x
         clrb
         puls  pc,y,cc

L04B3    sta   >PIA0Base+1
         lda   #$7F
         ldb   #$40
         bra   L04C7
L04BC    lsrb
         cmpb  #$01
         bhi   L04C7
         lsra
         lsra
         tfr   a,b
         clra
         rts
L04C7    pshs  b
         sta   >PIA1Base
         tst   >PIA0Base
         bpl   L04D5
         adda  ,s+
         bra   L04BC
L04D5    suba  ,s+
         bra   L04BC

* Return display status
* Entry: A = path
* Exit: A = color code of pixel at cursor address
*       X = address of graphics display memory
*       Y = graphics cursor address; X = MSB, Y = LSB
SSDSTAT  lbsr  GfxActv		gfx screen allocated?
         bcs   L050E		branch if not
         ldd   <V.GCrsX,u	else get X/Y gfx cursor position
         bsr   XY2Addr		
         tfr   a,b
         andb  ,x
L04E7    bita  #$01
         bne   L04F6
         lsra			divide D by 2
         lsrb
         tst   <V.Mode,u	which mode?
         bmi   L04E7		branch if 256x192
         lsra			else divide D by 2 again
         lsrb
         bra   L04E7
L04F6    pshs  b
         ldb   <V.PMask,u	get pixel color mask in B
         andb  #$FC
         orb   ,s+
         ldx   PD.RGS,y		get caller's regs
         stb   R$A,x		place pixel color in A
         ldd   <V.GCrsX,u
         std   R$Y,x		cursor X/Y pos in Y,
         ldd   <V.SBAdd,u
         std   R$X,x		and screen addr in X
         clrb
L050E    rts

* Entry: A = X coor, B = Y coor
XY2Addr  pshs  y,b,a		save off regs
         ldb   <V.Mode,u	get video mode
         bpl   L0517		branch if 128x192 (divide A by 4)
         lsra			else divide by 8
L0517    lsra
         lsra
         pshs  a		save on stack
         ldb   #191		get max Y
         subb  $02,s		sutract from Y on stack
         lda   #32		byte sper line
         mul
         addb  ,s+		add offset on stack
         adca  #$00
         ldy   <V.SBAdd,u	get base address
         leay  d,y		move D bytes into address
         lda   ,s		pick up original X coor
         sty   ,s		put offset addr on stack
         anda  <V.PixBt,u
         ldx   <V.MTabl,u
         lda   a,x
         puls  pc,y,x		X = offset address, Y = base

* SetStat
*
* Entry:
*    A  = function code
*    Y  = address of path descriptor
*    U  = address of device memory area
*
* Exit:
*    CC = carry set on error
*    B  = error code
*
SetStat  sta   <V.WrChr,u	save function code
         ldx   PD.RGS,y		get caller's regs
         cmpa  #SS.ComSt
         lbeq  SSCOMST
         cmpa  #SS.AAGBf
         beq   SSAAGBF
         cmpa  #SS.SLGBf
         beq   SSSLGBF
         cmpa  #SS.KySns
         bne   CoGetStt
         ldd   R$X,x		get caller's key sense set data
         beq   L0558		branch if zero
         ldb   #$FF		else set all bits
L0558    stb   <V.KySnsF,u	store value in KySnsFlag
L055B    clrb
L055C    rts

CoGetStt ldb   #$09		CO-module setstat
JmpCO    pshs  b
         lda   <V.CurCo,u	get CO-module in use
         lbsr  CallCO
         puls  a
         bcc   L055B
         tst   <V.GRFOE,u	GRFO linked?
         beq   L055C
         tfr   a,b
         clra			GRFO address offset in statics
         lbra  CallCO		call it

* Reserve an additional graphics buffer (up to 2)
SSAAGBF  ldb   <V.Rdy,u	was initial buffer allocated with $0F?
         lbeq  NotReady		branch if not
         pshs  b		save buffer number
         leay  <V.AGBuf,u	point to additional graphics buffers
         ldd   ,y		first entry empty?
         beq   L058E		branch if so
         leay  $02,y		else move to next entry
         inc   ,s		increment B on stack
         ldd   ,y		second entry empty?
         bne   L059E		if not, no room for more... error out
L058E    lbsr  GetMem		allocate graphics buffer memory
         bcs   L05A1		branch if error
         std   ,y		save new buffer pointer at ,Y
         std   R$X,x		and in caller's X
         puls  b		get buffer number off stack
         clra			clear hi byte of D
         std   R$Y,x		and put in caller's Y (buffer number)
         clrb			call is ok
         rts			and return
L059E    ldb   #E$BMode
         coma
L05A1    puls  pc,a

* Select a graphics buffer
SSSLGBF  ldb   <V.Rdy,u	was initial buffer allocated with $0F?
         lbeq  NotReady		branch if not
         ldd   R$Y,x		else get buffer number from caller
         cmpd  #$0002		compare against high
         bhi   BadMode		branch if error
         leay  <V.GBuff,u	point to base graphics buffer address
         lslb			multiply by 2
         ldd   b,y		get pointer
         beq   BadMode		branch if error
         std   <V.SBAdd,u	else save in current
         ldd   R$X,x		get select flag
         beq   L05C3		if zero, do nothing
         ldb   #$01		else set display flag
L05C3    stb   <V.CFlg1,u	save display flag
         clrb
         rts
BadMode  comb
         ldb   #E$BMode
         rts

SSCOMST  ldd   R$Y,x		Get caller's Y
L05CE    bita  #$02		CO80?
         bne   GoCO80		branch if so
         ldb   #$10		assume true lower case TRUE
         bita  #$01		true lowercase bit set?
         bne   GoCO32		branch if so
         clrb			true lower case FALSE
GoCO32   stb   <V.CFlag,u	save flag for later
         lda   #$02		CO32 is loaded bit
         ldx   #$2010		32x16
         pshs  u,y,x,a
         leax  >CO32,pcr
         bra   L05F4
GoCO80   lda   #$04		'CO80 is loaded' bit
         ldx   #$5018		80x24
         pshs  u,y,x,a
         leax  >CO80,pcr
L05F4    bsr   L0601		load CO-module if not already loaded
         puls  u,y,x,a
         bcs   L0600
         stx   <V.Col,u	save screen size
         sta   <V.CurCo,u	current module in use? ($02=CO32, $04=C080)
L0600    rts
L0601    bita  <V.COLoad,u	module loaded?
         beq   L0608		branch if not
L0606    clrb			else clear carry
         rts			and return
L0608    pshs  y,x,a
         lbsr  LinkSub
         bcc   L061F		branch if link was successful
         ldx   $01,s		get pointer to name on stack
         pshs  u
         os9   F$Load		try to load subroutine I/O module
         puls  u
         bcc   L061F
         puls  y,x,a
         lbra  NoIOMod
L061F    leax  <V.GRFOE,u	get base pointer to CO-entries
         lda   ,s		get A off stack
         sty   a,x		save off CO32/CO80 entry point
         puls  y,x,a
         ldb   #$00		CO-module init offset
         lbra  CallCO		call it

* Link to subroutine
LinkSub  pshs  u
         lda   #Systm+Objct
         os9   F$Link
         puls  pc,u

* 128x192 4 color pixel table
Mode1Clr fdb   $0055,$aaff

GfxDispatch
         cmpa  #$15		GRFO-handled code?
         bcc   GoGrfo		branch if so
         cmpa  #$0F		display graphics code?
         beq   Do0F		branch if so
         suba  #$10
         bsr   GfxActv		check if first gfx screen was alloc'ed
         bcs   L0663		if not, return with error
         leax  <gfxtbl,pcr	else point to jump table
         lsla			multiply by two
         ldd   a,x		get address of routine
         jmp   d,x		jump to it

* Jump table for graphics codes $10-$14
gfxtbl   fdb   Do10-gfxtbl	$10 - Preset Screen
         fdb   Do11-gfxtbl	$11 - Set Color
         fdb   Do12-gfxtbl	$12 - End Graphics
         fdb   Do13-gfxtbl	$13 - Erase Graphics
         fdb   Do14-gfxtbl	$14 - Home Graphics Cursor

GfxActv  ldb   <V.Rdy,u	gfx screen allocated?
         bne   L0606		branch if so
NotReady comb
         ldb   #E$NotRdy
L0663    rts

GoGrfo   bsr   GfxActv
         bcs   L0663
         ldx   <V.GRFOE,u	get GRFO entry point
         bne   L0681		branch if not zero
         pshs  y,a		else preserve regs
         bne   L067F
         leax  >GRFO,pcr	get pointer to name string
         bsr   LinkSub		link to GRFO
         bcc   L067B		branch if ok
         puls  pc,y,a		else exit with error
L067B    sty   <V.GRFOE,u	save module entry pointer
L067F    puls  y,a		restore regs
L0681    clra			A = GRFO address offset in statics
         lbra  CoWrite

* Allocate GFX mem -- we must allocate on a 512 byte page boundary
GetMem   pshs  u		save static pointer
         ldd   #6144+256	allocate graphics memory + 1 page
         os9   F$SRqMem		do it
         bcc   L0691		branch if ok
         puls  pc,u		else return with error
L0691    tfr   u,d		move mem ptr to D
         puls  u		restore statics
         tfr   a,b		move high 8 bits to lower
         bita  #$01		odd page?
         beq   L069F		branch if not
         adda  #$01
         bra   L06A1
L069F    addb  #$18
L06A1    pshs  u,a
         tfr   b,a
         clrb
         tfr   d,u
         ldd   #256
         os9   F$SRtMem		return page
         puls  u,a
         bcs   L06B3		branch if error
         clrb
L06B3    rts

* $0F - display graphics
Do0F     leax  <DispGfx,pcr
         ldb   #$02
         lbra  L03BF

DispGfx  ldb   <V.Rdy,u		already allocated initial buffer?
         bne   L06D1		branch if so
         bsr   GetMem		else get graphics memory
         bcs   L06EF		branch if error
         std   <V.SBAdd,u	save memory
         std   <V.GBuff,u	and GBuff
         inc   <V.Rdy,u		ok, we're ready
         lbsr  EraseGfx		clear gfx mem
L06D1    lda   <V.NChr2,u	get character after next
         sta   <V.PMask,u	save color set (0-3)
         anda  #$03		mask out all but lower 2 bits
         leax  >Mode1Clr,pcr	point to mask byte table
         lda   a,x		get byte
         sta   <V.Msk1,u	save mask byte here
         sta   <V.Msk2,u	and here
         lda   <V.NChar,u	get next char, mode byte (0-1)
         cmpa  #$01		compare against max
         bls   L06F0		branch if valid
         comb
         ldb   #E$BMode		else invalid mode specified, send error
L06EF    rts

L06F0    tsta			test user supplied mode byte
         beq   L0710		branch if 256x192
         ldd   #$C003
         std   <V.MCol,u
         lda   #$01
         sta   <V.Mode,u	128x192 mode
         lda   #$E0
         ldb   <V.NChr2,u
         andb  #$08
         beq   L0709
         lda   #$F0
L0709    ldb   #$03
         leax  <L0742,pcr
         bra   L072D
L0710    ldd   #$8001
         std   <V.MCol,u
         lda   #$FF
         tst   <V.Msk1,u
         beq   L0723
         sta   <V.Msk1,u
         sta   <V.Msk2,u
L0723    sta   <V.Mode,u	256x192 mode
         lda   #$F0
         ldb   #$07
         leax  <L0746,pcr
L072D    stb   <V.PixBt,u
         stx   <V.MTabl,u
         ldb   <V.NChr2,u
         andb  #$04
         lslb  
         pshs  b
         ora   ,s+
         ldb   #$01
* Indicate screen is current
         lbra  SetDsply

L0742    fcb   $c0,$30,$0c,$03
L0746    fcb   $80,$40,$20,$10,$08,$04,$02,$01

* $11 - set color
Do11     leax  <SetColor,pcr	set up return address
         lbra  L03BD

SetColor clr   <V.NChar,u	get next char
         lda   <V.Mode,u	which mode?
         bmi   L075F		branch if 256x192
         inc   <V.NChar,u
L075F    lbra  L06D1

* $12 - end graphics
Do12     leax  <V.GBuff,u	point to first buffer
         ldy   #$0000		Y = 0
         ldb   #$03		free 3 gfx screens max
         pshs  u,b
L076D    ldd   #6144		size of graphics screen
         ldu   ,x++		get address of graphics screen
         beq   L077A		branch if zero
         sty   -$02,x		else clear entry
         os9   F$SRtMem		and return memory
L077A    dec   ,s		decrement counter
         bgt   L076D		keep going if not end
         ldu   ,x		flood fill buffer?
         beq   L0788		branch if not allocated
         ldd   #512		else get size
         os9   F$SRtMem		and free memory
L0788    puls  u,b		restore regs
         clra
         sta   <V.Rdy,u	gfx mem no longer alloced
         lbra  SetDsply

Do10     leax  <Preset,pcr	set up return address
         lbra  L03BD

* NOTE! Shouldn't this be lda <V.NChar,u ??
Preset   lda   <V.NChr2,u	get next char
         tst   <V.Mode,u	which mode?
         bpl   L07A7		branch if 128x192 4 color
         ldb   #$FF		assume we will clear with $FF
         anda  #$01		mask out all but 1 bit (2 colors)
         beq   EraseGfx		erase graphic screen with color $00
         bra   L07B2		else erase screen with color $FF
L07A7    anda  #$03		mask out all but 2 bits (4 colors)
         leax  >Mode1Clr,pcr	point to color table
         ldb   a,x		get appropriate byte
         bra   L07B2		and start the clearing

* Erase graphics screen
Do13
EraseGfx clrb			value to clear screen with
L07B2    ldx   <V.SBAdd,u
         leax  >6144+1,x	point to end of gfx mem + 1
L07B9    stb   ,-x		clear
         cmpx  <V.SBAdd,u	X = to start?
         bhi   L07B9		if not, continue
* Home Graphics cursor
Do14     clra
         clrb
         std   <V.GCrsX,u
         rts

*
* Ding - tickle CoCo's PIA to emit a sound
*
Ding     pshs  b,a
         lda   >PIA0Base+1
         ldb   >PIA0Base+3
         pshs  b,a
         anda  #$F7
         andb  #$F7
         sta   >PIA0Base+1
         stb   >PIA0Base+3
         lda   >PIA1Base+3
         pshs  a
         ora   #$08
         sta   >PIA1Base+3
         ldb   #$0A
L07E6    lda   #$FE
         bsr   DingDuration
         lda   #$02
         bsr   DingDuration
         decb
         bne   L07E6
         puls  a
         sta   >PIA1Base+3
         puls  b,a
         sta   >PIA0Base+1
         stb   >PIA0Base+3
         puls  pc,b,a

DingDuration
         sta   >PIA1Base
         lda   #128
L0805    inca
         bne   L0805
         rts

         emod
eom      equ   *
         end
