;	opt 	l-,c+,d-

	output	fireworks

_LVOAllocMem	EQU	-198 		* exec library
_LVOFreeMem	EQU	-210 
_LVOOpenLibrary	EQU	-552 
_LVOCloseLibrary	EQU	-414

_LVOLoadRGB4	EQU	-192 		* graphics library
_LVOMove		EQU	-240 
_LVODraw		EQU	-246 
_LVOSetAPen	EQU	-342 
_LVOWritePixel	EQU	-324

_LVOOutput	EQU	-60 
_LVOWrite		EQU	-48 		* DOS library
_LVODelay		EQU	-198 
_LVODateStamp	EQU	-192

_LVOCloseScreen	EQU	-66 		* intuition
_LVOOpenScreen	EQU	-198 

_LVOFindTask	EQU	-$126
_LVOGetMsg	EQU	-$174
_LVOReplyMsg	EQU	-$17a
_LVOForbid	EQU	-$84
_LVOWaitPort	EQU	-$180

_SysBase	EQU	4

pr_MsgPort	EQU	$5c
pr_CLI		EQU	$ac



CALLEXEC	MACRO
	move.l	(_SysBase).w,a6
	jsr	_LVO\1(a6)
	ENDM
CALLGRAF	MACRO
	move.l	_GfxBase,a6
	jsr	_LVO\1(a6)
	ENDM
CALLDOS	MACRO
	move.l	_DOSBase,a6
	jsr	_LVO\1(a6)
	ENDM
CALLINT	MACRO
	move.l	_IntuitionBase,a6
	jsr	_LVO\1(a6)
	ENDM


start
	sub.l	a1,a1		* a1=NULL hence current task
	CALLEXEC FindTask		* Where's our process struct?
	move.l	d0,a4		* in a4 so we can index off it

	tst.l	pr_CLI(a4)	* Have we come from the CLI??
	bne.s	setup

	lea	pr_MsgPort(a4),a0	* The Hit it! message
	move.l	a0,a3		* save the pointer
	CALLEXEC WaitPort
	move.l	a3,a0		* restore pointer
	CALLEXEC GetMsg		* get the message
	move.l	d0,wbmsg		* and save the pointer to it..


setup	moveq	#0,d0		
	lea	intname,a1	
	CALLEXEC OpenLibrary	* open intuition
	move.l	d0,_IntuitionBase
	beq	fin
	moveq	#0,d0
	lea	grafname,a1
	CALLEXEC OpenLibrary	* open graphics
	move.l	d0,_GfxBase
	beq	panic
	moveq	#0,d0
	lea	dosname,a1
	CALLEXEC OpenLibrary	* open DOS
	move.l	d0,_DOSBase
	beq	panic

	tst.l	pr_CLI(a4)	* If there's no CLI, then we
	beq.s	screen		* can't Write to it..

	CALLDOS	Output		
	move.l	d0,ohandle	* get output handle

screen	lea	NScr,a0
	CALLINT	OpenScreen	* make ourselves a screen
	move.l	d0,scr
	move.l	d0,d1
	beq	scrpanic
	add.l	#$54,d1		* sc_RastPort
	move.l	d1,rastp
	add.l	#$2c,d0		* sc_ViewPort
	move.l	d0,viewp	

	tst.l	pr_CLI(a4)	* test CLI again
	beq.s	cmap

	move.l	ohandle,d1	* Print the welcome massage
	move.l	#stmess,d2
	move.l	#stmesslen,d3
	CALLDOS	Write


cmap	move.l	viewp,a0		* setup our own personal pallete
	lea	colmap,a1
	move.w	#32,d0
	CALLGRAF LoadRGB4

variables
	move.l	#date,d1		* use date to setup random seed
	CALLDOS	DateStamp
	
	lea	date,a0
	move.w	10(a0),d2
	swap	d2
	move.w	6(a0),d2
	move.l	d2,rndseed

	clr.w	numactive		* initialise variables
	clr.w	wait
	clr.w	blocksfull

	move.w	#numlines,d0	* loop to clear firework blocks
	lea	data,a2
clearloop
	clr.l	(a2)+
	clr.l	(a2)+
	clr.l	(a2)+
	clr.l	(a2)+
	dbra	d0,clearloop

Outsideloop
	move.w	wait,d0		* check wait counter
	bne.s	nonewones		

	cmp.w	#minnum,numactive	* check number of fireworks 
	bgt.s	noneed
	
	bsr	makefirework
	move.w	#25,d0		* reset wait between creation
nonewones
	subq.w	#1,d0
	move.w	d0,wait		* decrement wait counter
noneed
	move.w	blocksfull,d0	* number of full blocks
	lsr.w	#4,d0
	cmp.w	#2,d0
	bge.s	dontwaitup	* determines value to use 
	
	moveq	#2,d6
	sub.w	d0,d6
	bsr	delay		* for dos delay
dontwaitup
	lea	data,a2		* loop through 
	move.w	#numlines,d4	* number of blocks
innerloop
	moveq	#0,d2		* clear d2
	move.b	colr(a2),d2	
	beq.s	next1		* if zero, empty block
	
	cmp.w	#groundval+20,Ypos(a2)
	ble.s	leaveit		* check against ground

	bsr	removeit		* if below ground remove
	bra.s	next1
leaveit
	rol.b	#3,d2		* move type into lower three bits
	and.b	#7,d2		*

	add.w	d2,d2
	add.w	d2,d2
	lea	firejumptab,a0
	move.l	(a0,d2.w),a3

	movem.l	d4/a2,-(sp)
	jsr	(a3)
	movem.l	(sp)+,a2/d4

	bsr	procpoint
next1
	lea	ppsize(a2),a2
	dbra	d4,innerloop
next2
	btst	#6,$bfe001
	beq.s	end
	bra	outsideloop

end	move.l	scr,a0
	CALLINT	CloseScreen
panic
	move.l	_GfxBase,d1
	beq.s	panic1
	move.l	d1,a1
	CALLEXEC CloseLibrary
panic1	move.l	_IntuitionBase,d1
	beq.s	panic2
	move.l	d1,a1
	CALLEXEC CloseLibrary
panic2	move.l	_DOSBase,d1
	beq.s	fin
	move.l	d1,a1
	CALLEXEC CloseLibrary

fin	tst.l	wbmsg			* If we came from workbench,
	beq.s	epilog

	CALLEXEC Forbid			* Then clean up.
	move.l	wbmsg(pc),a1
	CALLEXEC ReplyMsg		* dispose of the message

epilog	rts


scrpanic
	tst.l	pr_CLI(a4)
	beq.s	panic

	move.l	ohandle,d1
	move.l	#scrmess,d2
	move.l	#scrmesslen,d3
	CALLDOS Write
	bra.s	panic


***
*** Subroutines:
*** 
getblock
	lea	data,a2
	move.w	#numlines,d0
blockloop
	move.b	colr(a2),d1
	beq.s	gotblock
	lea	ppsize(a2),a2
	dbra	d0,blockloop
	moveq	#0,d0
	rts
gotblock	
	addq.w	#1,blocksfull
	moveq	#-1,d0
	rts

firejumptab
	dc.l	help		;0 firework zero, an error
	dc.l	rocket1		;1 single boom rocket
	dc.l	rocket2		;2 double boom rocket
	dc.l	romancandle	;3 three straight up red,green,blue
	dc.l	traficlight	;4 sparks in all colours
	dc.l	spark1		;5 spark, last generation
	dc.l	spark2		;6 spark, nearly last generation
	dc.l	help		;7 firework seven, an error

help
	rts
romancandle
	addq.b	#1,time(a2)
	move.l	a2,a3
	move.b	time(a2),d0
	cmp.b	#32,d0
	beq.s	done1

	move.w	#0,colour

	and.b	#%00000111,d0
	bne.s	notnowdear

	bsr	getblock
	beq.s	done1
	bsr	makerocket2
	move.w	#0,Xvel(a2)
	move.w	Xpos(a3),Xpos(a2)
	move.w	lXpos(a3),lXpos(a2)

	moveq	#0,d0
	move.b	time(a3),d0
	asl.w	#1,d0
	sub.w	#groundval-50,d0
	move.w	d0,Yvel(a2)	
	
	move.b	time(a3),d0
	and.b	#%00011000,d0
	and.b	#%11100000,colr(a2)
	or.b	d0,colr(a2)
	move.l	a3,a2
notnowdear
	rts
done1
	move.l	a3,a2
	bsr	removeit
	rts

traficlight
	rts

rocket1
	moveq	#0,d0
	move.b	Yacc(a2),d0
	beq.s	sparkloop1

	moveq	#0,d0
	move.b	colr(a2),d0
	and.w	#%00011111,d0
	move.w	d0,colour

	cmp.w	#24,Yvel(a2)
	bgt.s	bang1
	rts
bang1	
	move.b	#0,Yacc(a2)
	move.w	#0,Xvel(a2)
	move.w	#4,Yvel(a2)
	move.w	#31,d1
	bsr	rnd
	move.b	d0,time(a2)	
sparkloop1
	move.l	a2,a3
	bsr	getblock
	beq.s	noneleft
	bsr	makespark1

	bsr	getblock
	beq.s	noneleft
	bsr	makespark1

	subq.b	#3,time(a3)
	bmi.s	noneleft

	move.l	a3,a2
	move.w	#0,colour
	rts
noneleft
	move.l	a3,a2
	bsr	removeit
	move.w	#0,colour
	rts

rocket2
	move.w	Yvel(a2),d0
	bpl.s	stop2

	moveq	#0,d0
;	move.w	d0,Xvel(a2)
	move.b	colr(a2),d0
	and.w	#%00011111,d0
	move.w	d0,colour

	move.b	time(a2),d0
	beq.s	makeone
	rts
makeone
	move.l	a2,a3
	bsr	getblock
	beq.s	stop2
	bsr	makespark1
	move.w	Yvel(a3),d0
	sub.w	d0,Yvel(a2)
	move.w	Xvel(a3),d0
	sub.w	d0,Xvel(a2)
	or.b	#1,colr(a2)
	move.l	a3,a2
	rts
stop2
	bsr	removeit
	rts


spark1
	subq.b	#1,time(a2)
	bpl.s	nochange1

	move.b	#4,time(a2)

	move.b	colr(a2),d0
	addq.b	#1,d0
	and.b	#%00000111,d0
	beq.s	dieout1
	and.b	#%11111000,colr(a2)
	or.b	d0,colr(a2)
nochange1
	moveq	#0,d0
	move.b	colr(a2),d0
	and.b	#%00011111,d0
	move.w	d0,colour
	rts
dieout1
	bsr	removeit
	rts
spark2
	rts


makefirework
	bsr	getblock
	beq.s	dontmake

	move.w	#127,d1
	bsr	rnd
	lsr.w	#4,d0

	add.w	d0,d0
	add.w	d0,d0
	lea	makejumptab,a0
	move.l	(a0,d0.w),a0
	jmp	(a0)
dontmake
	rts

makejumptab
	dc.l	makerocket1	;1 single boom rocket
	dc.l	makerocket2	;2 double boom rocket
	dc.l	makeromancandle	;3 single boom rocket
	dc.l	makerocket2	;4 double boom rocket
	dc.l	makerocket1	;5 single boom rocket
	dc.l	makeromancandle	;6 double boom rocket
	dc.l	makerocket1	;7 single boom rocket
	dc.l	makerocket2	;8 double boom rocket

makeromancandle
	addq.w	#1,numactive
	move.b	#%01100000,colr(a2)
	move.w	#groundval,Ypos(a2)
	move.w	#groundval,lYpos(a2)
	move.w	#120,d1
	bsr	rnd
	add.w	#100,d0
	move.w	d0,Xpos(a2)
	move.w	d0,lXpos(a2)

	move.w	#0,Yvel(a2)
	move.w	#0,Xvel(a2)
	rts

maketraficlight
	rts

makespark1
	move.b	#%10100000,colr(a2)
	bra	makespark
makespark2
	move.b	#%11000000,colr(a2)
makespark
	move.b	(a3),d0
	and.b	#%00011000,d0
	or.b	d0,colr(a2)

	move.w	Xpos(a3),Xpos(a2)
	move.w	Xpos(a3),lXpos(a2)
	move.w	Ypos(a3),Ypos(a2)
	move.w	Ypos(a3),lYpos(a2)

	move.w	#80,d1
	bsr	rnd
	sub.w	#40,d0
;	add.w	Yvel(a3),d0
	move.w	d0,Yvel(a2)

	move.w	#79,d1
	bsr	rnd
	sub.w	#40,d0
	add.w	Xvel(a3),d0
	move.w	d0,Xvel(a2)

	move.w	#32,d1
	bsr	rnd
	and.w	#$FF,d0
	asr.b	#4,d0
	addq.b	#1,d0
	move.b	d0,Yacc(a2)

	move.b	#0,Xacc(a2)
	move.w	#7,d1
	bsr	rnd
	move.b	d0,time(a2)
	rts

makerocket1
	move.b	#%00100000,colr(a2)
	bra	makerocket

makerocket2
	move.b	#%01000000,colr(a2)

makerocket
	addq.w	#1,numactive
	move.w	#groundval,Ypos(a2)
	move.w	#groundval,lYpos(a2)


	move.w	#120,d1
	bsr	rnd
	add.w	#100,d0
	move.w	d0,Xpos(a2)
	move.w	d0,lXpos(a2)

	move.w	#groundval/2,d1
	bsr	rnd
	add.w	#groundval/4,d0
	neg.w	d0
	move.w	d0,Yvel(a2)

	move.w	#200,d1
	bsr	rnd
	sub.w	#100,d0
	asr.w	d0
	move.w	d0,Xvel(a2)

	move.b	#0,Xacc(a2)
	move.b	#6,Yacc(a2)


	move.w	#3,d1
	bsr	rnd
	and.w	#$ff,d0
	addq.b	#1,d0
	lsl.b	#3,d0
	or.b	d0,colr(a2)
	rts

removeit
	subq.w	#1,blocksfull
	move.b	colr(a2),d0
	and.b	#%11100000,d0

	cmp.b	#%10100000,d0
	beq.s	killit

	cmp.b	#%11000000,d0
	beq.s	killit

	subq.w	#1,numactive
killit
	move.l	rastp,a1		* undraw last line
	move.l	#0,d0
	CALLGRAF SetAPen

	move.w	lxpos(a2),d0		* move cursor to point b4 last 
	move.w	lypos(a2),d1
	move.w	xpos(a2),d2
	move.w	ypos(a2),d3
	
	clr.l	(a2)
	clr.l	4(a2)
	clr.l	8(a2)
	clr.l	12(a2)
	bra	drawc
	rts

	
** procpoint: draws and updates a point
** On entry: a2 point to the data block of the point

procpoint
	move.l	rastp,a1		* undraw last line
	move.l	#0,d0
	CALLGRAF SetAPen

	move.w	lxpos(a2),d0		* move cursor to point b4 last 
	move.w	lypos(a2),d1
	move.w	xpos(a2),d2
	move.w	ypos(a2),d3

	move.w	d2,lxpos(a2)		* update last x & y posns
	move.w	d3,lypos(a2)

	bsr	drawc
	move.l	rastp,a1		* draw new line
	move.w	colour,d0
	CALLGRAF	SetAPen
	
	moveq	#0,d0
	moveq	#0,d1
	move.b	xacc(a2),d0		* update vels from accelerations
	move.b	yacc(a2),d1
	add.w	xvel(a2),d0		* get velocoties
	add.w	yvel(a2),d1
	move.w	d0,xvel(a2)		* save velocoties
	move.w	d1,yvel(a2)
	asr.w	#4,d0
	asr.w	#4,d1
	add.w	d2,d0			* move point with new vels
	add.w	d3,d1
	move.w	d0,xpos(a2)		* save point
	move.w	d1,ypos(a2)
	exg.l	d0,d2			} here so both line & anti-line
	exg.l	d1,d3			} go in same direction

	bsr	drawc
	rts

rnd	moveq	#32,d0		* Returns rnd number in d0 between 0 and d1
rnd32lp	move.b	rndseed+2,d6	* Trashes d6,d7
	move.b	rndseed+4,d7	
	lsr.b	#3,d6
	eor.b	d6,d7
	roxr.b	#1,d7
	roxl.w	rndseed
	roxl.w	rndseed+2
	roxl.w	rndseed+4
	dbra	d0,rnd32lp
	move.l	rndseed,d0
	mulu	d1,d0
	lsr.l	#8,d0
	lsr.l	#8,d0
	rts


* Delays for d6 ticks (50ths)
*

delay	movem.l	d0/a6,-(a7)
	move.l	d6,d1
	ext.l	d1
	CALLDOS	Delay
	movem.l	(a7)+,d0/a6
	rts

* draws the line (d0,d1)-(d2,d3) if all the line is onscreen

drawcfail	rts

drawc	tst.w	d0			* test all for -ve
	bmi.s	drawcfail
	cmp.w	#16,d1
	blt.s	drawcfail
	tst.w	d2
	bmi.s	drawcfail
	cmp.w	#16,d3
	blt.s	drawcfail

	cmp.w	#xmax,d0		* test all for too much +ve
	bgt.s	drawcfail
	cmp.w	#xmax,d2
	bgt.s	drawcfail
	cmp.w	#ymax,d1
	bgt.s	drawcfail
	cmp.w	#ymax,d3
	bgt.s	drawcfail
	
	btst	#7,colr(a2)
	bne.s	dot

	move.l	rastp,a1		* move to 1st point
	CALLGRAF Move

	move.w	d2,d0			* draw to 2nd point
	move.w	d3,d1
	move.l	rastp,a1
	CALLGRAF Draw
	rts
dot
	move.l	rastp,a1		* move to 1st point
	CALLGRAF	WritePixel
	rts

******* Data ********

grafname	dc.b	"graphics.library",0
intname	dc.b	"intuition.library",0
dosname	dc.b	"dos.library",0

_GfxBase	DC.L	0
_IntuitionBase	DC.L	0
_DOSBase	dc.l	0

ohandle	ds.l	1

NScr	DC.W	0				LeftEdge
	DC.W	0				TopEdge
	DC.W	xmax				Width
	DC.W	ymax				Height
	DC.W	depth				Depth
	DC.B	0				DetailPen
	DC.B	1				BlockPen
	DC.W	$0				ViewModes
	DC.W	$000F				Type
	DC.L	textattr			Font
	DC.L	scname				DefaultTitle
	DC.L	0				Gadgets
	DC.L	0			 	CustomBitMap


textattr	DC.L	fname
	DC.W	8
	DC.B	0
	DC.B	0

fname	DC.B	"topaz.font"
	DC.W	0

scname	DC.B	"Fireworks - By Fuzzz & Euphoria"
	DC.W	0

colmap	DC.W	$0000	;0
	DC.W	$0FFF	;1
	DC.W	$0F0f	;2
	DC.W	$0f0f	;3
	dc.w	$0f0f	;4
	dc.w	$0f0f	;5
	dc.w	$0f0f	;6
	dc.w	$0f0f	;7

	dc.w	$0f00	;8
	dc.w	$0d00	;9
	dc.w	$0b00	;a
	dc.w	$0900	;b
	dc.w	$0800	;d
	dc.w	$0700	;c
	dc.w	$0600	;e
	dc.w	$0500	;f
	dc.w	$00f0	;10
	dc.w	$00d0	;11
	dc.w	$00b0	;12
	dc.w	$0090	;13
	dc.w	$0080	;14
	dc.w	$0070	;15
	dc.w	$0060	;16
	dc.w	$0050	;17
	dc.w	$008f	;18
	dc.w	$007e	;19
	dc.w	$006d	;1a
	dc.w	$005c	;1b
	dc.w	$004b	;1c
	dc.w	$003a	;1d
	dc.w	$0039	;1e
	dc.w	$0038	;1f

scr	DC.L	0				Screen Pointers
rastp	DC.L	0
viewp	DC.L	0
colour
	dc.w	0	
StoreXpos
	dc.w	0
numactive
	dc.w	0
blocksfull
	dc.w	0
StoreYpos
	dc.w	0
wait
	dc.w	0
date
	dc.l	0,0,0,0

rndseed	dc.l	$4523
	dc.w	$6

	rsset	0
colr	rs.b	1	;0   includes type as bits 5,6,7
time	rs.b	1	;1
xpos	rs.w	1	;2
ypos	rs.w	1	;4
lxpos	rs.w	1	;6
lypos	rs.w	1	;8
xvel	rs.w	1	;10 Pix*16
yvel	rs.w	1	;12 Pix*16
xacc	rs.b	1	;14 *16
yacc	rs.b	1	;15 *16
ppsize	rs.w	0	;16

pointdata
	dc.w	xmax/2
	dc.w	240
	dc.w	xmax/2
	dc.w	240
	dc.w	16
	dc.w	-150
	dc.w	0
	dc.w	5

wbmsg	dc.l	0		* Ptr to the Hit it! message from workbench


xmax	equ	320
ymax	equ	256
depth	equ	5

numlines	equ	79
minnum	equ	1
groundval	equ	220

data	ds.b	ppsize*(numlines+1)

scrmess	dc.b	"OpenScreen failed.",10
scrmesslen	equ	*-scrmess
stmess	dc.b	10,"The Electric Menagerie Corporation Presents!",10
	dc.b	"             ",$9b,"1;33m","Fireworks",10
	dc.b	$9b,"0;31m - By James Hakewill & Ian Crowther"
	dc.b	" (Fuzzz & Euphoria)",10,10
	dc.b	"Written with ArgAsm from Argonaut Software.",10,0
stmesslen	equ 	*-stmess