;	+------------------------+
;	|         SETUP          |
;	+------------------------+
;	|                        |
;	| Coded By H. Erlandsson |
;	+------------------------+
**************** EXT FILES ****************
**************** SYMBOLS ****************
Wid=320
Hgt=256
Bpls=4
Bwid=Wid/8
Bpl=Bwid*Hgt
Buff1=$7f800-Bpls*Bpl			;leave space for SSP
Buff2=Buff1-Bpls*Bpl
**************** MACROS ****************
WaitBlit:MACRO				;wait until blitter is finished
	btst #14,2(a6)
	bne.s *-6
	ENDM

WaitBlit2:MACRO				;wait until blitter is finished
	btst #14,(a6)			;A6=DFF002!
	bne.s *-4
	ENDM

WaitSync:MACRO				;wait until raster beam=\1
	btst #0,5(a6)
	bne.s *-6
	cmp.b \1,6(a6)
	bne.s *-14
	ENDM

WaitSync1:MACRO				;wait until raster beam=$100+\1
	btst #0,5(a6)
	beq.s *-6
	cmp.b \1,6(a6)
	bne.s *-14
	ENDM
**************** PROGRAM ****************
JUMPPTR B
ORG  $20000
LOAD $20000
B:
	MOVEM.L D1-A6,-(SP)
	LEA $DFF000,A6
	move.w $1c(a6),-(SP)
	move.w 2(a6),-(SP)
	move.l $78.w,-(SP)
	move.w #$7fff,$9c(a6)
	move.w #$7fff,$9a(a6)
	move.w #$7fff,$96(a6)

	WAITSYNC #0
	move.l #Cop0,$80(a6)
	move.w #0,$88(a6)

	move.l #Lvl6,$78.w		;int pointer
	lea $bfd400,a5			;reg. base
	lea LoHi(PC),a0
	move.b (a5),(a0)+		;save old timerA values
	move.b $100(a5),(a0)+

	move.b #$81,(a5)		;set new timerA value
	move.b #$37,$100(a5)		;to approx 1/50th of a second
	move.b #$81,$900(a5)		;bit#7=set/clr,#0=TimerA
	WAITSYNC #$80			;so that visible!
	move.b #$11,$a00(a5)		;Bit#0=TimerA,#4=strobe,#3=one-shot

	move.w #$e000,$9a(a6)		;enable lvl6!

	move.w #$87f0,$96(a6)
	bset #1,$bfe001			;filter off

INIT:	lea Buff1,a0
	move.l #Bpls*Bpl,d0
	bsr ClrMem			;Clear Screen(s)
;;
MLOOP:	WAITSYNC #0
	moveq #0,d0
	bsr ChkKey
	move.b Key(PC),d0
	beq.s .NoKey

	cmp.b #$66,d0			;P?
	bne.s .NoP
.Pause:	move.w #$0200,Ena0+2
	moveq #0,d0
	bsr ChkKey
	cmp.b #$66,Key			;P?
	bne.s .Pause
	move.w #$4200,Ena0+2
.NoP:	cmp.b #$3a,d0			;ESC?
	beq.s EXIT
.NoKey:	BRA MLOOP

EXIT:	bclr #1,$bfe001
	move.w #$7fff,$9c(a6)
	move.w #$7fff,$9a(a6)
	move.w #$7fff,$96(a6)
	move.l (SP)+,$78.w

	move.l 4.w,a0
	move.l (a0),a0
	move.l (a0),a0
	WAITSYNC #0
	move.l $26(a0),$80(a6)
	move.w #0,$88(a6)		;restore cop

	move.w (SP)+,d0
	bset #15,d0
	move.w d0,$96(a6)
	move.w (SP)+,d0
	bset #15,d0
	move.w d0,$9a(a6)
	MOVEM.L (SP)+,D1-A6
	MOVEQ #0,D0
	RTS
**************** PROGRAM ROUTINES ****************
;;
Lvl6:
	btst #0,$bfdd00			;is this MY TimerA int?
	beq.s .End			;if not, skip
	move.w #$fff,$dff180
	move.w #$000,$dff180
.End:	move.w #$2000,$dff09c
	RTE

Vbl:	MOVEM.L D0-A6,-(SP)
	addq.w #1,Frame
	MOVEM.L (SP)+,D0-A6
	move.w #$0020,$dff09c
	RTE
**************** SYSTEM ROUTINES ****************
ShadeRGB:	;shade from a0 to a1-->a2.d0=step0-16,d1=dstmod,d2=nrcols-1
	MOVEM.L D0-D1/A0,-(SP)
.loop:	move.w (a0)+,d3			;get src1-col->d2
	move.w (a1)+,d4			;get src2-col->d3
	move.w d3,d5			;R
	clr.b d5
	move.w d4,d7
	clr.b d7
	sub.w d5,d7
	muls d0,d7
	asr.w #4,d7
	add.w d5,d7
	move.w d3,d5			;G
	and.w #$f0,d5
	move.w d4,d6
	and.w #$f0,d6
	sub.w d5,d6
	muls d0,d6
	asr.w #4,d6
	add.w d5,d6
	and.w #$f0,d6
	move.b d6,d7
	and.w #$f,d3
	and.w #$f,d4
	sub.w d3,d4			;B
	muls d0,d4
	asr.w #4,d4
	add.w d3,d4
	or.w d4,d7
	move.w d7,(a2)+
	add.w d1,a2
	dbf d2,.loop
	MOVEM.L (SP)+,D0-D1/A0
	RTS

BlitFill:				;a0=ptr,d0=bltsize,d1=mod,d2=fillword
	WAITBLIT
	move.l a0,$54(a6)
	move.w d1,$66(a6)
	move.l #$01f00000,$40(a6)
	moveq #-1,d1
	move.l d1,$44(a6)
	move.w d2,$74(a6)
	move.w d0,$58(a6)
	RTS

BlitCopy:	;copies a0-->a1.d0=bltsize,d1=smod/dmod.addrs=incstart/decend
	move.l #$09f00000,d2
	cmp.l a0,a1
	ble.s .inc
	addq.b #2,d2
.inc:	WAITBLIT
	move.l a0,$50(a6)
	move.l a1,$54(a6)
	move.l d1,$64(a6)
	move.l d2,$40(a6)
	moveq #-1,d1
	move.l d1,$44(a6)
	move.w d0,$58(a6)
	RTS

DblBuf:				;double buffer the two screens.a0=copper ptrs+2
	move.l Scrn(PC),d0
	move.w #Bpls-1,d1
	subq.w #1,d1
.Loop:	swap d0
	move.w d0,(a0)
	swap d0
	move.w d0,4(a0)
	addq.w #8,a0
	add.l #Bpl,d0
	dbf d1,.Loop
	move.l #Buff1,d0
	btst #0,Frame+1
	beq.s .Buf1
	move.l #Buff2,d0
.Buf1:	move.l d0,Scrn
	RTS				;[Buff] is now the non-shown plf

ChkKey:				;read RAW key code-->d0.0=no key!Clr d0 if 1st!
	lea $bfec01,a0
	lea OldC01(PC),a1
	btst #3,$100(a0)
	beq.s .End			;key pressed down?
	move.b (a0),d0			;read key
	bset #6,$200(a0)
	bclr #6,$200(a0)		;ready to receive next!
	lsr.b #1,d0
	bcc.s .NoKey
	move.b d0,(a1)
	bra.s .End
.NoKey:	moveq #0,d0
.End:	move.b d0,Key
	RTS

ClrMem:					;Clr a0-mem,word aligned. d0.L=nrBYTES!
	add.l d0,a0
	moveq #0,d1
	move.b d0,d1
	and.b #31,d1
	beq.s .NoClrb
.loop1:	clr.b -(a0)
	subq.b #1,d1
	bne.s .loop1
.NoClrb:lea Black(PC),a2
	movem.l (a2)+,d1-d7/a1
	lsr.l #5,d0
	beq.s .NoMVM
	subq.w #1,d0
.loop2:	movem.l d1-d7/a1,-(a0)
	dbf d0,.loop2
.NoMVM:	RTS

**************** COPPER ****************
EVEN
Cop0:
dc.w $0100,$0200
dc.l -2
dc.w $180,$0
dc.w $08e,$2881
dc.w $090,$28c1
dc.w $092,$38
dc.w $094,$d0
dc.w $102,0
dc.w $104,0
dc.w $108,0
dc.w $10a,0

Spr0:
dc.w $120,0,$122,0,$124,0,$126,0,$128,0,$12a,0,$12c,0,$12e,0
dc.w $130,0,$132,0,$134,0,$136,0,$138,0,$13a,0,$13c,0,$13e,0

Pal0:
dc.w $180,$000,$182,$fff,$184,$000,$186,$000
dc.w $188,$000,$18a,$000,$18c,$000,$18e,$000
dc.w $190,$000,$192,$000,$194,$000,$196,$000
dc.w $198,$000,$19a,$000,$19c,$000,$19e,$000
dc.w $1a0,$000,$1a2,$000,$1a4,$000,$1a6,$000
dc.w $1a8,$000,$1aa,$000,$1ac,$000,$1ae,$000
dc.w $1b0,$000,$1b2,$000,$1b4,$000,$1b6,$000
dc.w $1b8,$000,$1ba,$000,$1bc,$000,$1be,$000

Bpl0:
dc.w $0e0,(Buff1+Bpl*0)/65536
dc.w $0e2,(Buff1+Bpl*0)&65535
dc.w $0e4,(Buff1+Bpl*1)/65536
dc.w $0e6,(Buff1+Bpl*1)&65535
dc.w $0e8,(Buff1+Bpl*2)/65536
dc.w $0ea,(Buff1+Bpl*2)&65535
dc.w $0ec,(Buff1+Bpl*3)/65536
dc.w $0ee,(Buff1+Bpl*3)&65535
dc.w $0f0,(Buff1+Bpl*4)/65536
dc.w $0f2,(Buff1+Bpl*4)&65535
Ena0:
dc.w $100,$4200

dc.l -2
**************** DC-DATA ****************
EVEN
;;
Black:	blk.w 32,0			;also used for ClrMem
**************** VARS ****************
EVEN
;;
Scrn:	dc.l Buff1			;Buffer NOT shown
Frame:	dc.w 1				;if odd then show Buff2 otherwise Buff1
Vars:	blk.l 8,0
SaveSP:	dc.l 0
LoHi:	dc.b 0,0
Key:	dc.b 0
OldC01:	dc.b 0
E:
*************** LOADED DATA **************
***************** WORKSPACE ***************