OPT C-			;Turn off case sensitivity
	
	Section MISSION,CODE_C	;Make amiga_dos load the whole prg to chipram

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

Cmove	MACRO
	dc.w \2,\1
	ENDM
		
Cwait	MACRO
	dc.w \2<<8!\1!1,$fffe
	ENDM

Blitwait MACRO
bw_\@	btst #14,dmaconr(a5)
	bne.s bw_\@
	ENDM
	
CatchVB MACRO
vb1_\@:
	btst #0,vposr+1(a5)
	beq.s vb1_\@
vb2_\@:
	btst #0,vposr+1(a5)
	bne.s vb2_\@
	ENDM
	
*******************************************************************
	
start:	
	move.l	#$dff000,a5		;address of custom regs.
	catchvb
	blitwait
	jsr	takesys			;kill the operating system
	move.w	#$8240,dmacon(a5)
	move.l	#0,0			;for people with an A590
			
*******************************************************************
	
makescreens:	
	move.l	#piccy+(0*planesize),d0		;address of picture
	move.w	d0,plane1l			;store in copper list
	swap	d0
	move.w	d0,plane1h
	move.l	#piccy+(1*planesize),d0		;second plane
	move.w	d0,plane2l
	swap	d0
	move.w	d0,plane2h
	move.l	#piccy+(2*planesize),d0		;third plane
	move.w	d0,plane3l
	swap	d0
	move.w	d0,plane3h	
	move.l	#piccy+(3*planesize),d0		;fourth plane
	move.w	d0,plane4l
	swap	d0
	move.w	d0,plane4h
	
*******************************************************************

set_dma:
	catchvb
	blitwait
	move.w	#$02e0,dmacon(a5)
	move.w	#$87e0,dmacon(a5)	;turn on blitter-nasty,
					;master DMA, bitplane DMA,
					;copper, blitter + sprite DMA

*******************************************************************
	
title:
	catchvb				;wait for vertical blank
	blitwait			;wait for blitter to be free
	move.w	#$01a0,dmacon(a5)
	move.l	#main_copper,cop1lc(a5)	;point copper list to our
	move.w	#$ff,copjmp1(a5)	;custom copper list
	move.w	#$81a0,dmacon(a5)
	move.w	#$4010,intena(a5)	;disable ints.	
	move.l	#main_int,$6c		;point to add. of our routine
	move	#$c010,intena(a5)	;re-enable interrupts
	
	move.w	#2,curspeed
	move.w	#2,palspeed
	
	move.w	#18,d7
fade_cols:
	move.w	#2,int_occur		
cols_wait:
	cmpi.w	#0,int_occur		;wait until two frames have gone
	bne	cols_wait
	lea	colours,a0		;set up fade routine
	lea	ac_pal,a1		;by pointing to our palette
	lea	normal_colours,a2
	lea	palette,a3
	move.w	#15,d6
set_palette:
	move.w	(a0),(a1)+		;copy present colours to fade 
	move.w	(a2)+,(a3)+		;routine
	add.w	#4,a0
	dbra	d6,set_palette
	
	move.w	#15,d0			
	bsr	palchange		;call fade routine
	
	lea	ac_pal,a0
	lea	colours,a1
	move.w	#15,d6
copy_colours:
	move.w	(a0)+,(a1)		;now copy colours back to
	add.w	#4,a1			;our copperlist
	dbra	d6,copy_colours
	dbra	d7,fade_cols

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

main:
	btst	#7,ciaapra		;is the joystick fire pressed?
	beq	fade_off		;yes, so exit
	btst	#10,$dff016		;what about the right mouse?
	beq	fade_off		;if that is pressed, exit
	btst	#6,ciaapra		;what about left mouse then?
	bne	main			;nope, fingers are free!

fade_off:
	move.w	#2,curspeed		;set up fade routine again
	move.w	#2,palspeed
	
	move.w	#15,d7
fade_cols2:
	move.w	#2,int_occur
cols_wait2:
	cmpi.w	#0,int_occur
	bne	cols_wait2
	lea	colours,a0
	lea	ac_pal,a1
	lea	black_colours,a2
	lea	palette,a3
	move.w	#15,d6
set_palette2:
	move.w	(a0),(a1)+		;copy present colours
	move.w	(a2)+,(a3)+
	add.w	#4,a0
	dbra	d6,set_palette2
	
	move.w	#15,d0
	bsr	palchange		;call fade off routine
		
	lea	ac_pal,a0
	lea	colours,a1
	move.w	#15,d6
copy_colours2:
	move.w	(a0)+,(a1)		;copy colours into clist
	add.w	#4,a1
	dbra	d6,copy_colours2
	dbra	d7,fade_cols2
	
*******************************************************************
 
zzap:	
	catchvb
	blitwait	
	jsr	freesys			;re-enable the op. system

ende:
	clr.l	d0			;and return to DOS!
	rts
		
*******************************************************************

* This routine uses two tables - 
*   "Palette"  -- Holds the user's palette to change TO
*   "Ac_Pal"   -- The actual palette at the moment. (Internal)

* The user can change the speed by writing a WORD value to
* PalSpeed. The value designates 50ths of a second between each change.

Palchange:
	movem.l	d0-d7/a0-a6,-(SP)	; Preserve registers
	move.w	#0,done_pal
	sub.w	#1,CurSpeed
	beq	PalOK

	bra	Pal006
PalOK:
	move.w	#1,done_pal
	move.w	PalSpeed,CurSpeed
	lea	Palette(pc),a0	; User's Palette
	lea	Ac_Pal(pc),a1	; Actual (current) palette

Pal001:
* D1 holds red pigment, d2 holds green, d3 holds blue
	move.w	(a0)+,d1	; Load user's color
	move.w	d1,d2
	move.w	d1,d3
	and.w	#$f00,d1
	and.w	#$0f0,d2
	and.w	#$00f,d3
	
* Now for the Actual Palette.
	move.w	(a1),d4	; Don't incr., we re-write d4 later
	move.w	d4,d5
	move.w	d4,d6
	and.w	#$f00,d4
	and.w	#$0f0,d5
	and.w	#$00f,d6
	
* OK let's convert that color!
	cmp.w	d1,d4
	blt.s	.Rless	; if D4 is less than D1
	bgt.s	.Rmore
	bra.s	.Rfin
	
.Rless:
	add.w	#$100,d4
	bra.s	.Rfin
.Rmore:
	sub.w	#$100,d4
.Rfin:
	cmp.w	d2,d5
	blt.s	.Gless	; if D5 is less than D2
	bgt.s	.Gmore
	bra.s	.Gfin
	
.Gless:
	add.w	#$010,d5
	bra.s	.Gfin
.Gmore:
	sub.w	#$010,d5
.Gfin:
	cmp.w	d3,d6
	blt.s	.Bless	; if D6 is less than D3
	bgt.s	.Bmore
	bra.s	.Bfin
	
.Bless:
	add.w	#$001,d6
	bra.s	.Bfin
.Bmore:
	sub.w	#$001,d6
.Bfin:	
* Now to convert Actual Palette base colors back again,
	or.w	d5,d4
	or.w	d6,d4	; D4 holds new color
	move.w	d4,(a1)+
	
	dbf	d0,Pal001
	
* Note, ChangePal.ASM Doesn't do anything with Ac_Pal, It's
* up to you to do what you want to do with it to allow
*greater flexibility.

Pal006:
	movem.l	(SP)+,d0-d7/a0-a6	; restore registers
	RTS
	
	
Palette	ds.w	32
Ac_Pal	ds.w	32

PalSpeed:	dc.w	2	; Default speed : every OTHER frame
CurSpeed:	dc.w	2	; (This to be the best speed)
	
done_pal:	dc.w	0

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

main_int:
	movem.l	d0-d7/a0-a6,-(sp)
	lea	$dff000,a5
	and	#$10,intreqr(a5)	;is this a copper int.?
	beq	main_out		;no, so exit
	move.w	#$10,intreq(a5)		;clear interrupt flag

	cmpi.w	#0,int_occur
	beq	main_out
	sub.w	#1,int_occur
main_out:
	movem.l	(sp)+,d0-d7/a0-a6

	rte

int_occur:	dc.w	0

*******************************************************************
* 	      The next bit is our custom COPPERLIST               *
*******************************************************************

main_copper:
	dc.w	bplcon1,0		;standard screen
	dc.w	bpl1mod,0,bpl2mod,0	;no modulos
	dc.w	bplcon0,$4200		;4 bitplanes
	dc.w	bplcon2,$0		;normal priority
		
	dc.w	diwstrt,$2c81
	dc.w	diwstop,$2cc1
	dc.w	ddfstrt,$0038
	dc.w	ddfstop,$00d0
	dc.w	spr0pth			;these are the sprite
sp0h	dc.w	0			;pointers. We have set
	dc.w	spr0ptl			;them to point to 0
sp0l:	dc.w	0			;as we are not using them
	dc.w	spr1pth
sp1h:	dc.w	0
	dc.w	spr1ptl
sp1l:	dc.w	0
	dc.w	spr2pth
sp2h:	dc.w	0
	dc.w	spr2ptl
sp2l:	dc.w	0
	dc.w	spr3pth
sp3h:	dc.w	0
	dc.w	spr3ptl
sp3l:	dc.w	0
	dc.w	spr4pth
sp4h:	dc.w	0
	dc.w	spr4ptl
sp4l:	dc.w	0
	dc.w	spr5pth
sp5h:	dc.w	0
	dc.w	spr5ptl
sp5l:	dc.w	0
	dc.w	spr6pth
sp6h:	dc.w	0
	dc.w	spr6ptl
sp6l:	dc.w	0
	dc.w	spr7pth
sp7h:	dc.w	0
	dc.w	spr7ptl
sp7l:	dc.w	0

	dc.w	bpl1pth			;these are the bitplane
plane1h	dc.w	0			;pointers
	dc.w	bpl1ptl
plane1l	dc.w	0
	dc.w	bpl2pth
plane2h	dc.w	0
	dc.w	bpl2ptl
plane2l	dc.w	0
	dc.w	bpl3pth
plane3h	dc.w	0
	dc.w	bpl3ptl
plane3l	dc.w	0	
	dc.w	bpl4pth
plane4h	dc.w	0
	dc.w	bpl4ptl
plane4l	dc.w	0	


;there now follows the screen colours, in the following order:-
;1 WORD colour offset, then 1 WORD containing the colour data

	dc.w col0
colours:
	dc.w $0000,col1,$0000,col2,$0000,col3,$0000
	dc.w col4,$0000,col5,$0000,col6,$0000,col7,$0000
	dc.w col8,$0000,col9,$0000,col10,$0000,col11,$0000
	dc.w col12,$0000,col13,$0000,col14,$0000,col15,$0000

	dc.w	$ff0f,$fffe,$ffdd,$fffe ;use copper in PAL area
	
	cwait	0,51
	dc.w	intreq,$8010
	cwait	255,254

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

normal_colours:
	dc.w $0000,$0c73,$0976,$0a87,$0654,$0330,$0430,$0430
	dc.w $0530,$0740,$0840,$0950,$0a51,$0a62,$0643,$0444
black_colours:
	dc.w 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

*****************************************************************************
* TAKESYS and FREESYS were written by P.R.BRAIN (GARION) to safely
* take down and restore the operating system. Thanks to Paul for
* allowing us to use them.
*****************************************************************************
* TAKESYS will disable the OS interrupts and replace with custom drivers
* Also saves out the DMA control status...
* Returns with all Dma and all interrupts OFF
*****************************************************************************

Newvects dc.l lev1,lev2,lev3,lev4,lev5,lev6,lev7
Oldvects ds.l 7
OldTAh	 dc.b 0
OldTAl	 dc.b 0
Oldcra	 dc.b 0
	even
Oldintreq dc.w 0
Oldintena dc.w 0
Olddmacon dc.w 0
	
gfxname	dc.b	"graphics.library",0
syscop1 dc.l  0
syscop2 dc.l  0

takesys:
	move.l 4.w,a6
	jsr forbid(a6)
	lea custom,a5
	blitwait
	
	lea gfxname,a1
	moveq #0,d0
	jsr openlib(a6)	
	move.l d0,a1
	move.l oslist(a1),syscop1	;store OS copper addrs
	move.l oslist2(a1),syscop2
	jsr closelib(a6)

	lea $64.w,a0
	lea Oldvects,a1
	moveq #7-1,d0
vsavelp move.l (a0)+,(a1)+
	dbf d0,vsavelp			;Store OS vectors.
	
	move dmaconr(a5),Olddmacon	;store DMA
	move.w intreqr(a5),oldintreq
	move.w intenar(a5),oldintena	;store ints
	move.w #$7fff,intena(a5)
	move.w #$7fff,intreq(a5)	;disable all ints	
	catchVB
	move.w #$7fff,dmacon(a5)	;&dma
	
	lea newvects,a0
	lea $64.w,a1
	moveq #7-1,d0
vloadlp	move.l (a0)+,(a1)+
	dbf d0,vloadlp			;load new handler vectors

;Now setup the ciaa for keyboard...

	move.b ciaa+cra,Oldcra
	move.b #%00010000,ciaa+cra	;SP input, STOP & Forceload timerA
	move.b ciaa+Talo,oldtal
	move.b ciaa+Tahi,oldtah
		
;Configure CIA-A for kboard...

	move.b #0,ciaa+cra		;SP input...
	move.b #%01111111,ciaa+icr	;clear all cia ints
	move.b #%10001000,ciaa+icr	;SP int on
	move.b ciaa+icr,d0		;clear IRs

	move.w	#$c008,intena(a5)		
	rts

*****************************************************************************
* FREESYS will put the OS back together again... (Better had!)
*****************************************************************************

freesys:
	lea custom,a5
	move #$7fff,intena(a5)
	move #$7fff,intreq(a5)		;disable all ints
	move #$7fff,dmacon(a5)		;& Dma

	move.b #0,ciaa+cra		;reset ciaa...
	move.b #%01111111,ciaa+icr
	move.b #%10011011,ciaa+icr
					
	move.b oldtal,ciaa+talo
	move.b oldtah,ciaa+tahi
	move.b oldcra,ciaa+cra

	lea oldvects,a0
	lea $64.w,a1
	moveq #7-1,d0
vloslp	move.l (a0)+,(a1)+
	dbf d0,vloslp			;reset OS vectors

	catchvb
	move.l syscop1,cop1lc(a5)
	move.l syscop2,cop2lc(a5)
	move #0,copjmp1(a5)
	move #0,copjmp2(a5)		;reset the copper

	move oldintena,d0
	or #$c000,d0
	move d0,intena(a5)		;restore OS ints
	move oldintreq,d0
	or #$8000,d0
	move d0,intreq(a5)
	
	catchVB
	move olddmacon,d0
	or #$8200,d0
	move d0,dmacon(a5)		;restore OS Dma

	move.l 4.w,a6
	jsr permit(a6)
	rts

*****************************************************************************
* Unused Interrupt Drivers
*****************************************************************************

LEV1:
LEV2:
LEV3:
LEV4:
LEV5:
LEV6:
LEV7:
	rte

*******************************************************************
		
;Offsets for OS routines....

Openlib	equ -30-522
Closelib equ -414		;...Equates for OS calls...

Forbid  equ -30-102
Permit  equ -30-108

ciaapra = $bfe001

OsList		EQU	38
OsList2		EQU 	50

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

;Equates for hardware registers
 
custom	EQU   $dff000

dmaconr	EQU   $002
vposr	EQU   $004
vhposr	EQU   $006
intenar	EQU   $01C
intreqr	EQU   $01E

vposw	EQU   $02A
vhposw	EQU   $02C

cop1lc	EQU   $080
cop2lc	EQU   $084
copjmp1	EQU   $088
copjmp2	EQU   $08A
diwstrt	EQU   $08E
diwstop	EQU   $090
ddfstrt	EQU   $092
ddfstop	EQU   $094
dmacon	EQU   $096
intena	EQU   $09A
intreq	EQU   $09C

aud0vol	EQU   $0A8
aud1vol EQU   $0B8
aud2vol	EQU   $0C8
aud3vol	EQU   $0D8

bpl1pth	EQU   $0E0
bpl1ptl	EQU   $0E2
bpl2pth	EQU   $0E4
bpl2ptl	EQU   $0E6
bpl3pth	EQU   $0E8
bpl3ptl	EQU   $0EA
bpl4pth	EQU   $0EC
bpl4ptl	EQU   $0EE
bpl5pth	EQU   $0F0
bpl5ptl	EQU   $0F2
bpl6pth	EQU   $0F4
bpl6ptl	EQU   $0F6

bplcon0	EQU   $100
bplcon1	EQU   $102
bplcon2	EQU   $104
bpl1mod	EQU   $108
bpl2mod	EQU   $10A

spr0pth	EQU   $120
spr0ptl EQU   $122
spr1pth EQU   $124
spr1ptl EQU   $126
spr2pth	EQU   $128
spr2ptl EQU   $12A
spr3pth EQU   $12C
spr3ptl EQU   $12E
spr4pth	EQU   $130
spr4ptl EQU   $132
spr5pth EQU   $134
spr5ptl EQU   $136
spr6pth	EQU   $138
spr6ptl EQU   $13A
spr7pth EQU   $13C
spr7ptl EQU   $13E

col0	EQU   $180
col1 	EQU   $182
col2	EQU   $184
col3    EQU   $186
col4	EQU   $188
col5	equ   $18a
col6	equ   $18c
col7	equ   $18e
col8	EQU   $190
col9	equ   $192
col10	equ   $194
col11	equ   $196
col12	equ   $198
col13	equ   $19a
col14	equ   $19c
col15	equ   $19e
col16   equ   $1A0	
col17	equ   $1a2
col18   equ   $1a4
col19   equ   $1a6
col20   equ   $1a8
col21   equ   $1aa
col22   equ   $1ac
col23   equ   $1ae
col24   equ   $1b0
col25   equ   $1b2
col26   equ   $1b4
col27   equ   $1b6
col28   equ   $1b8
col29   equ   $1ba
col30   equ   $1bc
col31   equ   $1be

ciaa 	equ 	$bfe001
ciab	equ	$bfd000

pra	EQU	$0000
prb	EQU	$0100
ddra	EQU	$0200
ddrb	EQU	$0300
talo	EQU	$0400
tahi	EQU	$0500
tblo	EQU	$0600
tbhi	EQU	$0700
todlow	EQU	$0800
todmid	EQU	$0900
todhi	EQU	$0A00
sp	EQU	$0C00
icr	EQU	$0D00
cra	EQU	$0E00
crb	EQU	$0F00

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

planesize	equ	40*256

timer:	dc.l	0
	
*******************************************************************

piccy:
		;incbin	"dh0:mm/piccy"

		;to include a picture here, just replace the
		;above INCBIN with one of your own, specifying the
		;correct pathname for the picture. The picture 
		;must be in RAW format, not IFF.
		
*******************************************************************

	end