section Code,Code_c


; Right Mouse Button To Fade In / Out

	include	df0:aga-sourcecode/HardwareEquates

start	bsr	make.copper.lists


	move.l	4.w,a6
	jsr	-132(a6)		turn off multitasking


	lea	$dff000,a6
	move.w	intenar(a6),ints	save system interrupt status
	move.w	#$3fef,intena(a6)
	move.w	#$c010,intena(a6)	enable copper interrupt


vpwait	move.l	vposr(a6),d0		get vertical beam position
	and.l	#$1ff00,d0
	lsr.l	#8,d0
	cmp.w	#312,d0			wait for bottom line
	bne.s	vpwait			before disabling sprite DMA


	move.w	#$03ff,dmacon(a6)	DMA off


	move.l	$14.w,olddbz		division-by-zero exception handler
	move.l	#rteins,$14.w		set to rte instruction


*
* SET SCREEN SIZE ETC
*
	move.w	#$0210,bplcon0(a6)	initialise screen
	move.w	#$2c81,diwstrt(a6)
	move.w	#$2cc1,diwstop(a6)
	move.w	#$38,ddfstrt(a6)
	move.w	#$d8,ddfstop(a6)
	move.w	#$24,bplcon2(a6)
	move.w	#40*7-8,bpl1mod(a6)
	move.w	#40*7-8,bpl2mod(a6)

*
* SET THE NEW COPPER LOCATION
*
	move.l	4.w,a6
	lea	grafname(pc),a1
	moveq	#0,d0
	jsr	-552(a6)		openlibrary
	tst.l	d0
	beq	end
	move.l	d0,gfxbase
	move.l	d0,a6
	jsr	-456(a6)		ownblitter

	move.l	gfxbase(pc),a1
	move.l	38(a1),oldcopper

	lea	$dff000,a6

	bsr	Set.Colours

	move.l	copper1(pc),cop1lch(a6)
	move.w	d0,copjmp1(a6)
	move.w	#$83c0,dmacon(a6)	DMA on (bitplane, copper, blitter)



*
* INITIALISE LEVEL 3 INTERRUPT
*

	move.l	$6c.w,old
	move.l	#level3,$6c.w


*****************************************
*		MAIN LOOP		*
*****************************************


loop
	clr.w	nextframe
wait	tst.w	nextframe
	beq.s	wait

	tst.b	Fade.Direction
	beq.s	No.do.Fade

	bsr	Fade
	bsr	Set.Colours
	bra.s	Check.Quit

No.do.Fade

	btst	#2,potgor(a6)
	bne.s	Check.Quit

	move.b	Fade.Direction.Copy(pc),d0
	not.b	d0
	move.b	d0,Fade.Direction
	move.b	d0,Fade.Direction.Copy

Check.Quit
	btst	#6,$bfe001
	bne.s	loop



*
* EXIT ROUTINE
*


wait.2	btst	#6,dmaconr(a6)		wait for blitter to finish
	bne.s	wait.2

	move.l	old(pc),$6c.w

	move.l	oldcopper(pc),cop1lch(a6)

	move.w	#$8030,dmacon(a6)	DMA on (sprite, disk)
	move.w	ints(pc),d0
	ori.w	#$c000,d0		set SET and INTEN bits
	move.w	d0,intena(a6)		restore system interrupt status

	move.l	olddbz(pc),$14.w   	restore d-b-z exception handler

	move.l	gfxbase(pc),a6
	jsr	-462(a6)		disownblitter
	move.l	gfxbase(pc),a1
	move.l	4.w,a6
	jsr	-414(a6)		closelibrary

end	move.l	4.w,a6
	jsr	-138(a6)		turn on multitasking

	moveq	#0,d0
	rts



*********************
* LEVEL 3 INTERRUPT *
*********************


level3
	move.w	#$10,intreq(a6)
	move.w	#1,nextframe
rteins	rte


*****************************************************


Fade
	lea	ColourTable(pc),a1
	lea	ColTab1a(pc),a3
	lea	ColTab1b(pc),a4

	tst.b	Fade.Direction
	bpl.s	Fade.Up
	bmi.s	Fade.Down
	beq.s	Fade.Stop

Fade.Up
	addq.w	#4,Fade.Value

	cmp.w	#257,Fade.Value
	blt.s	Fade.Now

	move.w	#256,Fade.Value
	bra.s	Fade.Stop

Fade.Down
	subq.w	#4,Fade.Value
	bge.s	Fade.Now

Fade.Stop
	sf	Fade.Direction
	st	Fade.Finished
	rts

Fade.Now
	move.w	Fade.Value,d0
	move.w	#256-1,d1

Fade.Loop
	moveq	#0,d2
	moveq	#0,d3
	moveq	#0,d4
	move.b	(a1)+,d2
	move.b	(a1)+,d3
	move.b	(a1)+,d4

	mulu	d0,d2
	mulu	d0,d3
	mulu	d0,d4

	lsr.w	#8,d2
	lsr.w	#8,d3
	lsr.w	#8,d4
****
	move.w	d2,d5			Get red value for both words

	and.w	#$f0,d2
	and.w	#$0f,d5

	lsl.w	#4,d2
	lsl.w	#8,d5

	move.w	d2,TempCoarseColour
	move.w	d5,TempFineColour
****
	move.w	d3,d5			get green value for both words

	and.w	#$f0,d3
	and.w	#$0f,d5

	lsl.w	#4,d5

	or.w	d3,TempCoarseColour
	or.w	d5,TempFineColour
****
	move.w	d4,d5			get blue value for both words

	and.w	#$f0,d4
	and.w	#$0f,d5

	lsr.w	#4,d4

	or.w	d4,TempCoarseColour
	or.w	d5,TempFineColour

	move.w	TempCoarseColour,(a3)+
	move.w	TempFineColour,(a4)+

	dbra	d1,Fade.Loop

	rts


Fade.Direction		dc.b	1
Fade.Direction.Copy	dc.b	1
Fade.Finished		dc.b	0
	even
Fade.Value		dc.w	0
TempCoarseColour	dc.w	0
TempFineColour		dc.w	0


*****************************************************


Set.Colours
	lea	ColTab1a(pc),a0
	lea	ColTab1b(pc),a1
	move.w	#$0c40,d1
	moveq	#8-1,d7

NextBank.C40
	move.w	d1,$106(a6)
	lea	$dff180,a2
	moveq	#16-1,d2

Next.Colour.C40
	move.l	(a0)+,(a2)+
	dbra	d2,Next.Colour.C40

	add.w	#$2000,d1
	dbra	d7,NextBank.C40

	move.w	#$0e40,d1
	moveq	#8-1,d7

NextBank.E40
	move.w	d1,$106(a6)
	lea	$dff180,a2
	moveq	#16-1,d2

Next.Colour.E40
	move.l	(a1)+,(a2)+
	dbra	d2,Next.Colour.E40

	add.w	#$2000,d1
	dbra	d7,NextBank.E40

	rts

*****************************************************
*
*

make.copper.lists
	move.l	#Graphic,d0
	add.l	#(256*2)*2,d0		256 colours most/least significant
	move.l	#Bit.Screen,a0

init.copper
	moveq	#8-1,d1
next.plane
	move.w	d0,6(a0)		save low word
	swap	d0
	move.w	d0,2(a0)		save high word
	swap	d0
	add.l	#40,d0			next bitplane
	addq.w	#8,a0			update pointer to copper list
	dbra	d1,next.plane

	rts



;""""""""""""""""""""""""""""""""""""""""
;	" THE COPPER LIST "
;	"                 "
;	"""""""""""""""""""

copper.list.1
	dc.w	$180,0
	dc.w	$1fc,3

Bit.Screen
	dc.w	bpl1pth			8 bitplane display
	dc.w	0,bpl1ptl
	dc.w	0,bpl2pth
	dc.w	0,bpl2ptl
	dc.w	0,bpl3pth
	dc.w	0,bpl3ptl
	dc.w	0,bpl4pth
	dc.w	0,bpl4ptl
	dc.w	0,bpl5pth
	dc.w	0,bpl5ptl
	dc.w	0,bpl6pth
	dc.w	0,bpl6ptl
	dc.w	0,bpl7pth
	dc.w	0,bpl7ptl
	dc.w	0,bpl8pth
	dc.w	0,bpl8ptl
	dc.w	0


	dc.w	$ff01,$fffe

	dc.w	intreq,$8010

	dc.w	$ffff,$fffe		END



*************
* VARIABLES *
*************

copper1		dc.l	copper.list.1

olddbz		dc.l	0
oldcopper	dc.l	0
gfxbase		dc.l	0
ints		dc.w	0
old		dc.l	0
nextframe	dc.w	0
Delay		dc.w	50*5

grafname	dc.b	'graphics.library',0
		even

ColTab1a	ds.w	256*2
ColTab1b	ds.w	256*2

ColourTable	incbin	binary/tut.colours

	section	data,data_c

Graphic	incbin	binary/tut