************************************************
* Mandelbrot Explorer for Color Computer 3 
* Chris Lomont 2006 www.lomont.org
*
************************************************

* push S order: PC,U,Y,X,DP,B,A,CC low byte first, S pre-decremented 

************************************************
* Splash screen 32x16
************************************************
splash	equ	0
	if splash
	org	1024
	fcc	"*         *          *          "	
	fcc	"12345678901234567890123456789012"
	fcc	"                                "	
	fcc	"           MANDELBROT           "	
	fcc	"        CHRIS LOMONT 2006       "	
	fcc	"                                "	
	fcc	"                                "	
	fcc	"                                "	
	fcc	"                                "	
	fcc	"                                "	
	fcc	"                                "	
	fcc	"12345678901234567890123456789012"
	
	org	356	disk basic autostart - replace jump vectors
	lbra	start
	lbra	start
	lbra	start
	endif

	org	$E00		3584 decimal
start	

	clr	$FFD9		high speed poke (todo - undo at end?)

	lbsr	TestFPCode

*	jsr	SetPMODE4
	lbsr	DisableInterrupts	these puke once we replace top of ram
	lbsr	SetGr320	320x200x16 mode
	
	ldx	vidstart	clear screen
	ldy	#32000		this is 320*200/2 bytes, i.e. screensize
	lda	#$11		somple color
	lbsr	memset		

	* test upper corder, and orientation
	lda	#3		pixel color,x,y
	ldx	#0
	ldy	#0
	lbsr	SetPixel
	leax	1,x
	leay	1,y
	lbsr	SetPixel

	* test lower corner	
	lda	#6
	ldx	#319
	ldy	#199
	lbsr	SetPixel

	lda	#3
	ldx	#5
	ldy	#5
	ldb	#170
!	lbsr	SetPixel
	leax	1,x
	leay	1,y
	inca
	decb	
	bne	<	


	* compute mandelbrot color for every pixel
	ldx	#0
	ldy	#0


mndloop	lbsr	ComputeMandelbrotPoint	
*	cmpd	#0
*	beq	drawpix
*	lda	#15
	tfr	b,a		color from low pixel
drawpix	lbsr	SetPixel
	

!	leax	1,x		next pixel
	cmpx	#320
	blt	mndloop
	ldx	#0
	leay	1,y
	cmpy	#200
	blt	mndloop

	ldx	#$A000		infinite loop, making colors move
	ldy	#0
!	sty	,x		
	leay	1,y
	bra	<
			
* todo - enable cleanup rountines
	rts			return?!	


TestFPCode
	* test the FP code

	ldx	#AFPOne
	ldy	#AFPTemp1
	lbsr	FPCopy		1 in temp1
	ldx	#AFPTemp1
	lbsr	FPNeg		-1 in temp1
	ldy	#AFPTwo
	ldu	#AFPTemp2
	lbsr	FPMul		-2 in temp2
	ldy	#AFPTemp2
	ldu	#AFPTemp3
	lbsr	FPMul		2 in temp3
*	bra	TestFPCode
	
		
	lbsr	FPMul		0.5 in temp1
	
	
	
	ldx	#AFPOne
	ldy	#AFPHalf	
	ldu	#AFPTemp1
	lbsr	FPMul		0.5 in temp1
	
	ldx	#AFPTemp1
	ldy	#AFPTemp2	
	lbsr	FPCopy		0.5 in temp2
	
	ldx	#AFPTemp1
	lbsr	FPNeg		-0.5 in temp1

	ldx	#AFPTemp1
	ldy	#AFPTemp2	
	ldu	#AFPTemp3
	lbsr	FPMul		-0.25 in temp3

	ldx	#AFPTemp3
	ldy	#AFPTemp2	
	ldu	#AFPTemp1
	lbsr	FPAdd		0.25 in temp1


	ldx	#AFPTemp1
	ldy	#AFPTemp1	
	ldu	#AFPTemp1
	lbsr	FPAdd		0.5 in temp1

	ldx	#AFPTwo	
	ldy	#AFPTemp3
	ldu	#AFPTemp2
	lbsr	FPMul		-0.5 in temp2
	
	ldx	#AFPTemp1	
	ldy	#AFPTemp2
	ldu	#AFPTemp3
	lbsr	FPAdd		0

	rts


AFPOne		fcb	1,0,0,0
AFPHalf		fcb	0,128,0,0
AFPTwo		fcb	2,0,0,0
AFPTemp1	fcb	0,0,0,0
AFPTemp2	fcb	0,0,0,0
AFPTemp3	fcb	0,0,0,0

************************************************
* memset - fill memory
* REGX = start address
* REGY = length
* REGA = filler byte
* modifies REGX, REGY
************************************************
memset
!	sta	,x+	
	leay	-1,y
	bne	<
	rts


************************************************
* Variables for current graphics state
************************************************
vidstart	rmd	1	video start page for drawing	


************************************************
* DrawBox - draw a box on the screen
* REGA 	color 0-15
* REGX	x coord 0-319
* REGY	y coord 0-199
* REGB	height
* REGU	width
* registers changed: none
************************************************
DrawBox
	pshs	x,y,u,a,b	* stack: 
	
	
@top	lbsr	SetPixel
	leax	1,x
	leau	-1,u
	bne	@top
	
	
	puls	x,y,u,a,b
	rts


************************************************
* Set a pixel in 320x200x16 color mode
* REGA 	color 0-15
* REGX	x coord 0-319
* REGY	y coord 0-199
*
* Registers changed: none
************************************************
SetPixel
	*clamp pixels for safety? todo: or add outer clamping rountine
	cmpx	#320
	bge	pixexit		out of bounds
	cmpy	#200
	bge	pixexit		out of bounds
	pshs	x,y,d	save these

	tfr	y,d	want 160*y todo - faster with shift and add tricks?
	lda	#160
	mul	
	
	addd	vidstart
	
	pshs	d	save this
	
	tfr	x,d
	
	lsra		divide by two to get byte offset
	rorb
	
	addd	,s	add back rest	
	
	tfr	d,y	final byte pointer in y
	
	puls	d	restore stack	
	
	lda	,s 	get pixel value
	anda	#$0F	clamp
	ldb	3,s	get x low nibble
	andb	#1
	beq	even
		
	ldb	#$F0	mask
	bra	write
	
even	ldb	#$0F	mask
	lsla		shift to high nibble
	lsla
	lsla
	lsla

write	andb	,y	mask out
	stb	,y
	ora	,y	write pixel
	sta	,y
	puls	x,y,d	restore from stack
pixexit	rts
	
************************************************
* Disable/Enable interrupts 
************************************************
DisableInterrupts
	orcc	#$50		disable interrupts
	rts
	
EnableInterrupts	
	andcc	#$AF		enable interrupts
	rts	
	
************************************************
* Set graphics memory - sets 32K in 0x8000-0xFFFF 
* from MMU pages 0x60000 on up 
* interrupts should be disabled to use this
* 
************************************************
SetGraphicsMem
	* set graphics screen to $2000-$3FFF
	ldd	#$8000
	std	vidstart
	
	lda	#48		first block of graphics at $60000
	ldx	#$FFA4		mapped to $8000-$9FFF, then more
	ldb	#4		
!	sta	,x+
	inca	
	decb
	bne	<		
	
	*write here
*	ldx	#$2000
*	clrb
*!	stb	,x+
*	incb		
*	bne	<
	
	
*	lda	#$39		restore normal memory
*	sta	$FFA1		mapped to $2000
	rts	
	

************************************************
* Set a graphics  mode 320x200x16 color mode
* from GIME docs: HR2 HR1 HR0 CR1 CR0
*                  1   1   1   1   0    320 pixels, 16 colors
* TODO REGX contains 16 bit address for video start, aligned on 8 byte boundary
************************************************
SetGr320 
	lda 	#%01001100 	Coco3, MMU on, DRAM constant, standard SCS 16K internal 16K external ROM
	sta 	$FF90
	lda	#%10000000	
	sta	$FF98 		graphics mode, 60 hz, normal burst
	lda	#%00111110 	width 320, height 200
	sta	$FF99 	
	clr	$FF9C		low 4 bits are vertical scroll
	
	ldd	#$C000		first block of graphics screen at $60000 / 8
	std	$FF9D		vidstart offset
	clr	$FF9F		clear horiz scroll
	
	jsr	SetGraphicsMem	set the memory pages

	ldx	#$FFB0		set some palette entries
	ldy	#palette
	ldb	15
!	lda	,y+
	sta	,x+
	decb	
	bne	<
			
	rts


palette	
	fcb	%00000000,%00000111,%00111000,%00111111
	fcb	%00000100,%00100000,%00100100
	fcb	%00000010,%00010000,%00010010
	fcb	%00000001,%00001000,%00001001
	fcb	%00110110,%00101101,%00011011

************************************************
* Set a palette entry (RGB Monitor mode - todo - map to TV mode also)
* REGA is color bits (0,0,RH,GH,BH,RL,GL,BL)
* REGB is color index to set 0-15
* 
* 
************************************************
SetPaletteEntry
	andb	#15	
	ldx	#$FFB0
	abx
	sta	,x	
	rts

************************************************
* Set a graphics mode
************************************************
SetPMODE4
	clr 	$ffc0
	clr 	$ffc3
	clr 	$ffc5 	gives RG6 (PMODE4)
	lda 	$ff
	sta 	$ff22
	rts

************************************************
* Set text mode
************************************************
TextMode
	clr 	$ffc0
	clr 	$ffc2
	clr 	$ffc4 	gives text mode
	lda 	#8
	sta 	$ff22
	rts

************************************************
* Mandelbrot point computation
* REGX x coord 0-319
* REGY y coord 0-199
* returns REGD is number of color value 0 on up
* Registers changed: REGD
************************************************
MandelX		fcb	0,0,0,0		current iterate
MandelY		fcb	0,0,0,0
MandelX2	fcb	0,0,0,0		square of iterate
MandelY2	fcb	0,0,0,0
MandelX0	fcb	0,0,0,0		point to add each pass			
MandelY0	fcb	0,0,0,0
MandelTemp	fcb	0,0,0,0		temp space
MandelIt	fcb	0,0		iteration count
MandelItMx	fcb	4,0		max iter iteration count 1024

* some constants for computations
MandelXS	fcb	2,104,83,118	(3/319)*256 in FP
MandelYS	fcb	2,146,167,60	(2/199)*256 in FP
FPNegFour	fcb	$FC,0,0,0	-4 in FP
FPNegTwo	fcb	$FE,0,0,0	-2 in FP
FPNegOne	fcb	$FF,0,0,0	-1 in FP
FPTwo		fcb	$2,0,0,0	 2 in FP

* mandelbrot drawn over [-2,1]x[-1,1]	
ComputeMandelbrotPoint
	pshs	u,y,x
	
*  x = x0 = x co-ordinate of pixel
*  y = y0 = y co-ordinate of pixel
	ldx	#MandelX	zero out these
	lbsr	FPClear
	ldx	#MandelY
	lbsr	FPClear
	
	ldx	,s		get original x

	ldu	#MandelX	save coords/256
	stx	,u
	ldu	#MandelY
	sty	,u
	
	ldx	#MandelX
	ldy	#MandelXS	xscale [0-319]->[0,3]
	ldu	#MandelX0
	lbsr	FPMul
	tfr	u,x
	ldy	#FPNegTwo
	ldu	#MandelX
	lbsr	FPAdd		x now in [-2,1]
	ldx	#MandelX
	ldy	#MandelX0
	lbsr	FPCopy		x and x0 now initialized
	
	ldy	#MandelY
	ldx	#MandelYS	yscale [0-199]->[0,2]
	ldu	#MandelY0
	lbsr	FPMul
	tfr	u,x
	ldy	#FPNegOne
	ldu	#MandelY
	lbsr	FPAdd		y now in [-1,1]
	ldx	#MandelY
	ldy	#MandelY0
	lbsr	FPCopy		y and y0 now initialized	
	
*  x2 = x*x
*  y2 = y*y
	ldx	#MandelX	initialize the squares - todo - compact with below
	tfr	x,y
	ldu	#MandelX2
	lbsr	FPMul
		
	ldx	#MandelY
	tfr	x,y
	ldu	#MandelY2
	lbsr	FPMul

*  iteration = 0
*  maxiteration = 1000

	ldx	#MandelIt
	ldd	#0
	std	,x
	ldx	#MandelItMx
	ldd	#50		todo- bigger?
	std	,x 
 
*  while ( x2 + y2 < (2*2)  AND  iteration < maxiteration ) {
mloop	ldx	#MandelX2
	ldy	#MandelY2
	ldu	#MandelTemp
	lbsr	FPAdd
	tfr	u,x
	ldy	#FPNegFour	todo - can check this with highest FP byte
	lbsr	FPAdd
	lda	,u		get highest bit, see if positive
	bita	#$80
	beq	mdone		jump out
	ldy	#MandelItMx
	ldd	MandelIt
	cmpd	,y
	bge	mdone		if too many iterations, bail out

*    iteration = iteration + 1
	addd	#1
	*incd	todo - 6309	
	std	MandelIt
		 
*    y = 2*x*y + y0
	ldx	#MandelX
	ldy	#MandelY
	ldu	#MandelTemp
	lbsr	FPMul
	tfr	u,x
	ldy	#FPTwo
	ldu	#MandelY
	lbsr	FPMul		todo- make a mul by two routine - faster
	tfr	u,x
	ldy	#MandelY0
	lbsr	FPAdd

*    x = x2 - y2 + x0
	ldx	#MandelY2
	lbsr	FPNeg
	ldy	#MandelX2
	ldu	#MandelX
	lbsr	FPAdd
	tfr	u,x
	ldy	#MandelX0
	lbsr	FPAdd	

*    x2 = x*x     
*    y2 = y*y

	ldx	#MandelX
	tfr	x,y
	ldu	#MandelX2
	lbsr	FPMul
		
	ldx	#MandelY
	tfr	x,y
	ldu	#MandelY2
	lbsr	FPMul


   	lbra	mloop
 
 
*  if ( iteration == maxiteration )
*    colour = black
*  else
*    colour = iteration
mdone	ldd	MandelIt
	cmpd	MandelItMx
	bne	colorok
	ldd	#0
colorok	puls	x,y,u
	rts

************************************************
* Fixed point rountines - 
* values stored as 2's complement, 8.24 mode, 4 bytes
************************************************

************************************************
* FPAdd - Fixed point Add 
* REGX - point to operand1
* REGY - point to operand2
* REGU - point to answer
* all registers are allowed to point to same spots
* Registers changed: none
************************************************
FPAdd
	pshs	a	
	lda	3,x		Least sig byte
	adda	3,y
	sta	3,u
	lda	2,x
	adca	2,y
	sta	2,u
	lda	1,x
	adca	1,y
	sta	1,u
	lda	,x		most sig byte
	adca	,y
	sta	,u
	puls	a
	rts
	
************************************************
* FPClear - zero out fp value 
* REGX - point to operand
* Registers changed: none
************************************************
FPClear
	clr	,x+
	clr	,x+
	clr	,x+
	clr	,x+
	leax	-4,x
	rts

************************************************
* FPCopy - copy one value to another 
* REGX - point to source
* REGY - point to dest
* Registers changed: none
************************************************
FPCopy
	pshs	a
	lda	,x+
	sta	,y+
	lda	,x+
	sta	,y+
	lda	,x+
	sta	,y+
	lda	,x
	sta	,y
	leax	-3,x
	leay	-3,y
	puls	a
	rts


************************************************
* FPNeg - Fixed point negate 
* REGX - point to operand
* Registers changed: none
************************************************
FPNeg
	pshs	y,u
	com	3,x		2's complement, complement and add one
	com	2,x
	com	1,x
	com	,x
	ldy	#FPEps
	tfr	x,u		dest same
	bsr	FPAdd	
	puls	y,u
	rts
FPEps	fcb	0,0,0,1		8.24 fixed point smallest positive value

************************************************
* FPMulu - Fixed point multiply of positive numbers 
* REGX - point to operand1
* REGY - point to operand2
* REGU - point to answer
* all registers are allowed to point to same spots
* Registers changed: none
************************************************
FPMulu
	pshs	u,y,x,b,a	order PC,U,Y,X,DP,B,A,CC low byte first, S pre-decremented
	ldu	#FPTempU	temp storage
	ldd	#0		todo - clrd is a 6309 only opcode - how to make ccasm warn me?
	std	,u++		zero temp storage
	std	,u++		
	std	,u++
	std	,u
	ldd	#$0303			
	pshs	d		x pos byte, y pos byte counter, each goes 3 down to 0

loop	ldb	,s		x counter
	lda	1,s		y counter
	ldx	4,s		x base
	ldy	6,s		y base
	ldu	#FPTempU
	abx			x byte to mult
	leay	a,y		y byte to mult
	adda	,s		total offset space
	leau	a,u		where to write answer
		
	lda	,x		multiply the bytes		
	ldb	,y
	mul	
	addd	,u		store in location
	std	,u
carry	lda	,-u		prepare to add with carry to prev byte	
	cmpu	#FPTempU	add carries to top of temp
	blt	next		no more byters left
	adca	#0
	sta	,u
	bcs	carry		more carry to do

next	dec	1,s		decrement two counters, fall through when done		
	bge	loop
	ldb	#3	
	stb	1,s
	dec	,s
	bge	loop
	
	puls	d		clean stack
	
	ldx	#FPTempU+1	answer is shifted off one
	ldu	6,s		original u value for answer
	
	ldd	,x++		copy 4 bytes
	std	,u++
	ldd	,x++		
	std	,u++
	
	puls	u,y,x,b,a
	rts
FPTempU	fcb	1,2,3,4,5,6,7,8	eight bytes temp space
************************************************
* FPMul - Fixed point multiply 
* REGX - point to operand1
* REGY - point to operand2
* REGU - point to answer
* Registers changed: none
************************************************
FPMul
	pshs	y,x,b,a
	lda	,x		get signs
	ldb	,y		get signs

* if x < 0 or x==y or x==u then copy x to new location	
	bita	#$80		check sign on x
	bne	movex
	cmpx	4,s		see if x and y point to same space
	beq	movex
	cmpx	6,s		see if x and u point to same space
	bne	xdone
	
movex	ldy	#FPTemp1	move x to another spot
	lbsr	FPCopy		get copy
	ldx	#FPTemp1	point here
	bita	#$80
	beq	xdone
	lbsr	FPNeg		negate this copy

xdone	ldy	4,s		get y
	bitb	#$80		check sign on y
	bne	movey
	cmpy	2,s		see if x and y point to same space
	beq	movey
	cmpy	6,s		see if x and u point to same space
	bne	ydone
	
movey	pshs	x		save this for copy
	tfr	y,x		source
	ldy	#FPTemp2	dest
	lbsr	FPCopy		copy
	puls	x		restore
	bitb	#$80		check sign on y
	beq	ydone		jump if nonnegative
	exg	x,y		save regs
	lbsr	FPNeg		negate y value
	exg	x,y		restore regs
	
ydone	lbsr	FPMulu		both positive now, so mult them

	pshs	b
	eora	,s		compute final sign
	puls	b
	bita	#$80
	beq	anspos
	
	tfr	u,x
	lbsr	FPNeg		negate answer
		
anspos	puls	y,x,b,a
	rts
FPTemp1 fcb	1,2,3,4,5,6,7,8	eight bytes temp space
FPTemp2 fcb	1,2,3,4,5,6,7,8	eight bytes temp space
	

	end	start

* end - Mandelbrot.asm