#dontinclude
	opt	forwardrefmax
#include	coco\main_lib.txt
#include	coco\disk_lib.txt
#include	coco\pmode4_lib.txt
#include	coco\sidchip.txt
#include	coco\joystick_lib.txt

#memstart	28672	;$7000


	org	$4000	;mem start?
start
	disk_buffer()
	std	disk256
	disk_granuals()
	std	diskgran
	cg6_display(#0)
	disk_loadm(#0,#filename1,#0,disk256,diskgran)


doloop
	bra	doloop







; end of program
cocoromend
filename1
	fcn	'IMAGES  BIN'

def	disk256	string	256
def	diskgran	string	70


	end	start

; ideas

- active display 6144 bytes
- working display 1 6144 bytes
- working display 2 6144 bytes

def	rdytmr	byte
def	dcdrv	byte
def	drgram	byte
def	dctrk	byte
def	dcsta	byte
def	dcopc	byte
def	zero	word

dskreg	equ	$ff40

;diskcon rip

dskcon
	pshs	u,y,x,b,a	;save registers
	lda	#$05	;get retry count and
	pshs	a	;save it on the stack
ld672	clr	rdytmr	;reset drive not ready timer
	ldb	dcdrv	;get drive number
	ldx	#ld7aa	;point x to drive enable masks
	lda	drgram	;get dskreg image
	anda	#$a8	;keep motor status, double density. halt enable
	ora	b,x	;'or' in drive select data
	ora	#$20	;'or' in double density
	ldb	dctrk	;get track number
	cmpb	#22	;precompensation starts at track 22
	blo	ld68b	;branch if less than 22
	ora	#$10	;turn on write precompensation if >= 22
ld68b	tfr	a,b	;save partial image in accb
	ora	#$08	;'or' in motor on control bit
	sta	drgram	;save image in ram
	sta	dskreg	;program the 1793 control register
	bitb	#$08	; = were motors already on?
	bne	ld69f	; = don't wait for it to come up to speed if already on
	jsr	la7d1	; wait a while
	jsr	la7d1	;* wait some more for motor to come up to speed
ld69f	bsr	ld6de	;wait until not busy or time out
	bne	ld6ad	;branch if timed out (door open. no disk, no power. etc.)
	clr	dcsta	;clear status register
	ldx	#ld7a2	;point to command jump vectors
	ldb	dcopc	;get command
	aslb	; 2 bytes per command jump address


	jsr	[b,x]	;go do it
ld6ad	puls	a	; get retry count
	ldb	dcsta	; get status
	beq	ld6be	;branch if no errors
	deca	;decrement retries counter
	beq	ld6be	; branch if no retries left
	pshs	a	; save retry count on stack
	bsr	ld6c5	;restore head to track 0
	bne	ld6ad	; branch if seek error
	bra	ld672	; go try command again if no error
ld6be	lda	#120	; 120*1/60 = 2 seconds (1/60 second for each irq interrupt)
	sta	rdytmr	;wait 2 seconds before turning off motor
	puls	a,b,x,y,u,pc	; restore registers - exit dskcon

; restore head to track 0
ld6d0	ldx	#dr0trk	; point to track table
	ldb	dcdrv	;get drive number
	clr	b,x	; zero track number
	lda	#$03	; restore head to track 0, unload the head
	sta	fdcreg	;  at start, 30 ms stepping rate
	exg	a,a	; =
	exg	a,a	; = wait for 1793 to respond to command
	bsr	ld6de	; wait till drive not busy
	bsr	ld6fd	; wait some more
	anda	#$10	; 1793 status : keep only seek error
	sta	dcsta	; save in dskcon status
ld6d0	rts

; dskreg masks for disk drive select
ld7aa	fcb	1	; drive sel 0
	fdb	2	;drive sel 1
	fdb	4	;drive sel 2
	fcb	$40	; drive sel 3



; dskcon operation code jump vectors
ld7a2	fdb	ld6c5	; restore head to track zero
	fdb	ld6dd	; no op - return
	fdb	ld705	; read sector
	fdb	ld708	; write sector


la7d1
	timer?
	LDX	ZERO	; GET READY TO WAIT A WHILE

;* delay while decrementing x to zero
la7d3	leax	-1,x	; decrement x
	bne	la7d3	; branch if not zero
	rts



ld6de	ldx	zero	; get zero to x register - long wait
ld6e0	leax	-1,x	; decrement long wait counter
	beq	ld6ec	; lf not ready by now, force interrupt
	lda	fdcreg	; get 1793 status and test
	bita	#$01	; busy status bit
	bne	ld6e0	;branch if busy
	rts

ld6ec	lda	#$d0	;* force interrupt command - terminate any command
	sta	fdcreg	; * in process. do not generate a 1793 interrupt request
	exg	a,a	; * wait before reading 1793
	exg	a,a	; *
	lda	fdcreg	;reset intrq (fdc interrupt request)
	lda	#$80	; return drive not ready status if the drive did not become unbusy
	sta	dcsta	; save dskcon status byte
	rts


;* restore head to track 0
ld6c5	ldx	#dr0trk	; point to track table
	ldb	dcdrv	; get drive number
	clr	b,x	; zero track number
	lda	#$03	; * restore head to track 0, unload the head
	sta	fdcreg	; * at start, 30 ms stepping rate
	exg	a,a	; =
	exg	a,a	; = wait for 1793 to respond to command
	bsr	ld6de	; wait till drive not busy
	bsr	ld6fd	; wait some more
	anda	#$10	; 1793 status : keep only seek error
	sta	dcsta	; save in dskcon status
ld6dd	rts


; medium delay
ld6fd	ldx	#8750	; delay for a while
ld700	leax	-1,x	; * decrement delay counter and
	bne	ld700	; * branch if not done
	rts

; read one sector
	ld705	lda	#$80	; $80 is read flag (1793 read sector)
ld707	cmpx	#$86a0	; skip two bytes
; write one sector
ld708	lda	#$a0	; $a0 is write flag (1793 write sector)
	pshs	a	;save read/write flag on stack
	ldx	#dr0trk	; point x to track number table in ram
	ldb	dcdrv	; get drive number
	abx	;point x to correct drive's track byte
	ldb	,x	; get track number of current head position
	stb	fdcreg+1	; send to 1793 track register
	cmpb	dctrk	; compare to desired track
	beq	ld739	; branch if on correct track
	lda	dctrk	;get track desired
	sta	fdcreg+3	; send to 1793 data register
	sta	,x	; save in ram track image
	lda	#$17	; * seek command for 1793: do not load the
	sta	fdcreg	; * head at start, verify destination track,
	exg	a,a	; * 30 ms stepping rate - wait for
	exg	a,a	; * valid status from 1793
	bsr	ld6de	; wait till not busy
	bne	ld737	; return if timed out
	bsr	ld6fd	; wait some more
	anda	#$18	; keep only seek error or crc error in id field
	beq	ld739	; branch if no errors - head on correct track
	sta	dcsta	; save in dskcon status
ld737	puls	a,pc
;* head positioned on correct track
ld739	lda	dsec	; get sector number desired
	sta	fdcreg+2	; send to 1793 sector register
	ldx	#ld798	; * point x to routine to be vectored
	stx	dnmisv	; * to by nmi upon completion of disk i/o and save vector
	ldx	dcbpt	; point x to i/o buffer
	lda	fdcreg	; reset intrq (fdc interrupt request)
	lda	drgram	; get dskreg image
	ora	#$80	; set flag to enable 1793 to halt 6809
	puls	b	; get read/write command from stack
	ldy	zero	; zero out y - timeout initial value
	ldu	#fdcreg	;p u points to 1793 interface registers
	com	nmiflg	; nmi flag = $ff: enable nmi vector
	orcc	#$50	; disable firq,irq
	stb	fdcreg	; * send read/write command to 1793: single record, compare
	exg	a,a	; * for side 0, no 15 ms delay, disable side select
	exg	a,a	; * compare, write data address mark (fb) - wait for status
	cmpb	#$80	; was this a read?
	beq	ld782	; if so, go look for data
;* wait for the 1793 to acknowledge ready to write data
	ldb	#$02	; drq mask bit

ld768	bitb	,u	; is 1793 ready for a byte? (drq set in status byte)
	bne	ld778	; branch if so
	leay	-1,y	; decrement wait timer
	bne	ld768	; keep waiting for the 1793 drq
ld770	clr	nmiflg	; reset nmi flag
	andcc	#$af	; enable firq,irq
	jmp	ld6ec	; force interrupt, set drive not ready error

; write a sector
ld778	ldb	,x+	; get a byte from ram
	stb	fdcreg+3	; send it to 1793 data register
	sta	dskreg	; reprogram fdc control register
	bra	ld778	; send more data
; wait for the 17933 to acknowledge ready to read data
ld782	ldb	#$02	; drq mask bit
ld784	bitb	,u	; does the 1793 have a byte? (drq set in status byte)
	bne	ld78e	; yes, go read a sector
	leay	-1,y	; decrement wait timer
	bne	ld784	; keep waiting for 1793 drq
	bra	ld770	; generate drive not ready error

; read a sector
ld78e	ldb	fdcreg+3	; get data byte from 1793 data register
	stb	,x+	; put it in ram
	sta	dskreg	; reprogram fdc control register
	bra	ld78e	; keep getting data
; branch here on completion of sector read/write
ld798	andcc	#$af	; enable irq, firo
	lda	fdcreg	; * get status & keep write protect, record type/write
	anda	#$7c	; * fault, record not found, crc error or lost data
	sta	dcsta	; save in dskcon status
	rts


