BLANKS ON
	STRING ASIS
	
	IMPORT test_func
	
shoeClearInterrupt 	EQU	4*0  ; Write 1 to clear the via2 interrupt
shoeSetMode			EQU	4*1  ; write depth in bits
shoeGrayPage		EQU	4*2  ; Gray out the screen buffer

shoeSetClutIndex	EQU 4*3  ; Set the index of the clut entry I'm about to modify
shoeSetClutRed		EQU 4*4  ; Set the red uint16_t for this clut entry
shoeSetClutGreen	EQU 4*5  ; green
shoeSetClutBlue		EQU 4*6  ; blue

shoeEnableInts		EQU 4*7  ; Enable/disable interrupts
shoeDebug			EQU 4*8  ; Print out the long value written to this "register"
	
shoeGrayCLUT		EQU 4*9  ; Gray out the CLUT
shoeUseLuminance	EQU 4*10 ; "designing cards" calls this SetGray, but that's confusing

DriverStart

	DC.W $4C00 ; "ctl, status, needsLock" (what?)
	DC.W 0, 0, 0 ; "not an ornament" (??)
	
	DC.W VideoOpen-DriverStart
	DC.W 0 ; What does "prime" do?
	DC.W VideoCtl-DriverStart
	DC.W VideoStatus-DriverStart
	DC.W VideoClose-DriverStart
	
	STRING	Pascal
	
	; This needs to match the name in shoebill_video_rom.a
	
	DC.B	'.Display_Video_Apple_Shoebill'
	STRING 	ASIS
	ALIGN	2
	DC.W	$0	; Version number (overrides INIT if very high)
	
VideoOpen
	move.l a0, a2 ; param block pointer
	move.l a1, a3 ; DCE pointer
	
	; Allocate a slot queue element
	moveq.l #sqHDSize, d0
	_NewPtr ,SYS,CLEAR
	bne Reset
	
	; Install the interrupt handler
	lea InterruptHandler, a4
	move.w #SIQType, SQType(a0)
	move.l a4, SQAddr(a0)
	move.l dctlDevBase(a3), SQParm(a0)
	moveq.l #0, d0
	move.b dctlSlot(a3), d0
	_SIntInstall
	bne Reset
	
	; Return success
	moveq.l #0, d0
	rts

VideoCtl
	movem.l a0-a6/d1-d7, -(sp)
	moveq.l #0, d1
	move.w csCode(a0), d1
	
	move.l dCtlDevBase(a1), a2
	add.l #$00F00000, a2
	
	move.l csParam(a0), a3
	; a0 -> "IO parameter block"
	; a1 -> DCE pointer
	; a2 -> register base address
	; a3 -> parameters
	; d1 -> ctl code
	
VideoCtl_reset
	cmp.w #0, d1
	bne VideoCtl_killio
	
	move.l OneBitMode, shoeSetMode(a2) ; set to B&W
	move.l #1, shoeGrayPage(a2) ; gray out the screen
	
	move.l #noErr, d0 ; success
	bra VideoCtl_rtn
	
VideoCtl_killio
	cmp.w #1, d1
	bne VideoCtl_setvidmode
	
	moveq.l #noErr, d0 ; no async IO on shoebill, so succeed
	bra VideoCtl_rtn
	
VideoCtl_setvidmode
	cmp.w #2, d1
	bne VideoCtl_setentries
	
	; Gray out the CLUT
	move.b #1, shoeGrayCLUT(a2)
	
	; (it's okay to write bytes/words to these long register addresses)
	move.w csMode(a3), shoeSetMode(a2) 
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn
	
VideoCtl_setentries
	cmp.w #3, d1
	bne VideoCtl_setgamma
	
	move.l (a3), a4 ; csTable
	moveq.l #0, d2
	move.w 4(a3), d2 ; csStart
	moveq.l #0, d3
	move.w 6(a3), d3 ; csCount
	
	cmp.w #$ffff, d2
	bne cont
	reset
cont:

	
	move.l d2, d4
	lsl.l #3, d4 ; multiply csStart by 8, sizeof(ColorSpec)==8
	add.l d4, a4 ; add (csStart*8) to csTable
	
	addq.l #1, d3 ; csCount is 0-based (why??) Make it 1-based
	moveq.l #0, d4
setentries_loop:
	
	move.l d2, shoeSetClutIndex(a2) ; communicate the clut entry index
	move.w 2(a4), shoeSetClutRed(a2) ; communicate the red component
	move.w 4(a4), shoeSetClutGreen(a2)
	move.w 6(a4), shoeSetClutBlue(a2)
	
	addq.l #1, d2 ; increment csStart
	addq.l #8, a4 ; increment csTable pointer 
	addq.l #1, d4 ; increment loop counter
	cmp d4, d3
	bne setentries_loop
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn
	
VideoCtl_setgamma
	cmp.w #4, d1
	bne VideoCtl_graypage
	
	; Debug-print setgamma
	move.l #$b0040000, d4
	move.l d4, shoeDebug(a2)
	
	; Not implemented
	moveq.l #controlErr, d0
	bra VideoCtl_rtn
	
VideoCtl_graypage
	cmp.w #5, d1
	bne VideoCtl_setgray
	
	; Debug-print graypage
	move.l #$b0050000, d4
	move.l d4, shoeDebug(a2)
	
	move.l #0, shoeGrayPage(a2)
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn
	
VideoCtl_setgray ; 
	cmp.w #6, d1
	bne VideoCtl_setinterrupt
	
	; Debug-print setgray
	move.l #$b0060000, d4
	move.l d4, shoeDebug(a2)
	
	move.b csMode(a3), shoeUseLuminance(a2)
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn
	
VideoCtl_setinterrupt
	cmp.w #7, d1
	bne VideoCtl_directsetentries
	
	; Debug-print csMode(a3)
	move.l #$b0070000, d4
	move.b csMode(a3), d4
	move.l d4, shoeDebug(a2)
	
	move.b csMode(a3), d1
	move.b d1, shoeEnableInts(a2)
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn

VideoCtl_directsetentries
	cmp.w #8, d1
	bne VideoCtl_setdefault
	
	; Not implemented
	moveq.l #controlErr, d0
	bra VideoCtl_rtn
	
VideoCtl_setdefault ; setDefaultMode
	cmp.w #9, d1
	bne VideoCtl_bogus
	
	; Debug-print csMode(a3)
	move.l #$b0090000, d4
	move.b csMode(a3), d4
	move.l d4, shoeDebug(a2)
	
	suba #spBlockSize, sp ; allocate a slot parameter block
	move.l sp, a0
	move.b dCtlSlot(a1), spSlot(a0) 
	clr.b spExtDev(a0)
	
	suba #sizesPRAMRec, sp
	move.l sp,spResult(a0)
	_sReadPRAMRec ; read this slot's pram data
	
	; copy the new default mode to VendorUse2 (byte idx 3)
	move.b csMode(a3), 3(sp)
	move.l sp, spsPointer(a0)
	_SPutPRAMRec ; write the new pram data
	
	adda #SizesPRAMRec+spBlockSize, SP
	
	moveq.l #noErr, d0
	bra VideoCtl_rtn
	
VideoCtl_bogus
	move.l #controlErr, d0;
	; fall through
	
VideoCtl_rtn
	movem.l (sp)+, a0-a6/d1-d7
	
	rts

	
; ---- Video status ----


VideoStatus
	movem.l a0-a6/d1-d7, -(sp)
	move.l dCtlDevBase(a1), a2
	add.l #$00F00000, a2
	
	move.l #$e0000000, shoeDebug(a2)
	
	move.l #statusErr, d0
	bra VideoStatus_rtn
	
VideoStatus_bogus
	move.l #statusErr, d0
	
VideoStatus_rtn
	movem.l (sp)+, a0-a6/d1-d7
	rts
	
	
; ---- Video close ----
	
	
VideoClose
	movem.l a0-a6/d1-d7, -(sp)
	move.l dCtlDevBase(a1), a2
	add.l #$00F00000, a2
	
	; Nothing much to do except disable interrupts
	; I don't think VideoClose is ever even called
	move.l #0, shoeEnableInts(a2)
	move.l #$a0000000, shoeDebug(a2)
	
	movem.l (sp)+, a0-a6/d1-d7
	moveq.l #0, d0
	rts
	
	
; --- Interrupt handler ---
	
InterruptHandler
	; Compute the slot number given the base address in a1
	move.l a1, d0
	rol.l #8, d0
	and.l #$0f, d0
	
	; Tell Shoebill to clear the interrupt flag
	move.l a1, a0
	add.l #$00F00000, a0 ; the "clear interrupt" register
	move.l #1, (a0)
	
	; Call JVBLTask (with d0 = slot number)
	move.l JVBLTask, a0
	jsr (a0)
	
	; Return success
	moveq.l #1, d0
	rts
	

Reset

	reset