jmp run

; Titel 	: Copperlist with several dynamic BPLPTL changes
; Author        : J. Van Houtven
; Address	: Fruithoflaan 105 bus 42,
;		  B-2600 Berchem, Belgium.
; Creation Date : August 1988

; *** PROGRAM CONSTANTS

PlaneHeight=	256	; PAL LORES Height
PlaneWidth=	320	; LORES Width
PlaneDepth=	5

; *** SYSTEM CONSTANTS

EXECBASE=	$04
CUSTOM=		$dff000

; *** REGISTER ADDRESSES

CIAAPRA=	$bfe001

; *** REGISTER OFFSETS TO BASE CHIP ADDRESS $DFF000

DMACONR=	$0002
POTGOR=		$0016
DIWSTRT=	$008e
DIWSTOP=	$0090
DDFSTRT=	$0092
DDFSTOP=	$0094
DMACON=		$0096
INTENA=		$009a
BPL1PTH=	$00e0
BPLCON0=	$0100
BPLCON1=	$0102
BPLCON2=	$0104
BPL1MOD=	$0108
BPL2MOD=	$010a
SPR0PTH=	$0120
COLOR00=	$0180

; *** EXEC.LIBRARY FUNCTION OFFSETS

Forbid=		-132
Permit=		-138

AllocMem=	-198
FreeMem=	-210

CloseLibrary=	-414
OpenLibrary=	-552


; *** BEGIN OF PROGRAM *************************************

run:

movem.l	a0-a6/d0-d7,-(sp)

move.l	EXECBASE,a6

lea	GfxName,a1
move.l	#0,d0
jsr	OpenLibrary(a6)
move.l	d0,GfxBase
beq	ErrorExit

clr.l	d5	; Loop Counter
lea	BPLAddrsTable,a4
PlaneAddrsLoop:
add.l	#1,d5
add.l	#4,a4
move.l	#[[PlaneWidth*PlaneHeight]/8],d0 ; needed memory for BPLs in bytes
move.l	#$10002,d1		; CHIP|CLEAR
jsr	AllocMem(a6)
move.l	d0,(a4)
beq	ErrorExit
cmp.l	#PlaneDepth,d5
bne	PlaneAddrsLoop

move.l	#CopperListEnd-CopperListBegin,d0
add.l	#[[256*8]+4],d0	; for Dynamic Copperlist
move.l	d0,TotalCopMem
move.l	#$10002,d1
jsr	AllocMem(a6)
move.l	d0,COPAddr
beq	ErrorExit

; Fill in the BitPlaneAddrs in the CopperList and in Planes table

lea	CopperBPLAddrs,a0	; BPL1PTH
lea	Here,a5	; BPL1PTH
lea	Here2,a4	; BPL1PTH
add.l	#2,a0
add.l	#2,a5
add.l	#2,a4
lea	Plane1,a1 		; Plane in BitMap struct
lea	BPLAddrsTable,a2
clr.l	d1			; LoopCounter
CopBPLAddrsLoop:
add.l	#1,d1
add.l	#4,a2
move.l	(a2),d0
move.l	d0,(a1)
move.w	d0,4(a0)		; fill in BPLxPTL 
move.w	d0,4(a5)		; fill in BPLxPTL 
move.w	d0,4(a4)		; fill in BPLxPTL 
swap	d0
move.w	d0,(a0)			; fill in BPLxPTH
move.w	d0,(a5)			; fill in BPLxPTH
move.w	d0,(a4)			; fill in BPLxPTH
add.l	#8,a0			; update pointer to next BPLxPTH
add.l	#8,a5			; update pointer to next BPLxPTH
add.l	#8,a4			; update pointer to next BPLxPTH
add.l	#4,a1			; update pointer to next Planex
cmp.l	#PlaneDepth,d1
bne	CopBPLAddrsLoop



; Copy the CopperList to allocated ChipMem (COPAddr)

move.l	EXECBASE,a6

lea	CopperListBegin,a0	; Copy source addrs
move.l	COPAddr,a1		; Copy destination addrs

CopCopyLoop:

move.l	(a0),(a1)+
cmp.l	#$fffffffe,(a0)+
bne	CopCopyLoop

move.l	a1,DynCopStartAddr	; The address in a1 points
				; to the reserved memory
				; in the CopperList



; *** Fill BitPlanes
 
lea	BPLAddrsTable+4,a4
move.l	#PlaneDepth-1,d7	; NrOfPlanes Counter
move.l	#$aaaaaaaa,d0
PlaneNrLoop:
move.l	(a4)+,a5		; copy BPLAddress

move.l	#[PlaneHeight/[[15+1]*2]]-1,d5	; RepeatNrOfLinesLoop Counter
RepeatLinesLoop:
move.l	#15,d4			; NrOfLines Counter
move.l	d0,d1
NrOfLinesLoop:
move.l	#[[PlaneWidth/32]-1],d6	; NrOfLongsPerLine Counter
FillLineLoop:
move.l	d1,(a5)+
dbf	d6,FillLineLoop
rol.l	#1,d1
dbf	d4,NrOfLinesLoop

move.l	#15,d4			; NrOfLines Counter
move.l	d0,d1
NrOfLinesLoop2:
move.l	#[[PlaneWidth/32]-1],d6	; NrOfLongsPerLine Counter
FillLineLoop2:
move.l	d1,(a5)+
dbf	d6,FillLineLoop2
ror.l	#1,d1
dbf	d4,NrOfLinesLoop2

dbf	d5,RepeatLinesLoop

add.l	#$030a030a,d0

dbf	d7,PlaneNrLoop

move.l	#31,d7
move.w	#$fff,d0
lea	CUSTOM,a0
add.l	#COLOR00,a0
ColorsLoop:
move.w	d0,(a0)+
sub.w	#111,d0
dbf	d7,ColorsLoop


move.l	EXECBASE,a6
jsr	Forbid(a6)	; Emulate Atari ST (8{}) ...

lea	CUSTOM,a5
move.l	#00000000,SPR0PTH(a5)
move.w	DMACONR(a5),-(sp)
move.w	#$07ff,DMACON(a5)	
move.l	GfxBase,a4
move.l	$32(a4),OldCOPAddr
move.l	COPAddr,$32(a4)
move.w	#$83c0,DMACON(a5)

move.w	#$4000,INTENA(a5)
move.l	$6c,OldIrq+2
move.l	#NewIrq,$6c
move.w	#$c000,INTENA(a5)

LMB_RMBTestLoop:
btst	#10,POTGOR(a5)
bne	ContTestLoop
bchg	#0,StopAction
;bset	#10,POTGOR(a5)

move.l	#2,d6
TimeLoop1:
move.l	#$ffffffff,d7
TimeLoop2:
dbf	d7,TimeLoop2
dbf	d6,TimeLoop1

;bset	#10,POTGOR(a5)

ContTestLoop:
btst	#6,CIAAPRA	; LOW ACTIVE
bne	LMB_RMBTestLoop

lea	CUSTOM,a5

move.w	#$4000,INTENA(a5)
move.l	OldIrq+2,$6c
move.w	#$c000,INTENA(a5)

move.w	#$07ff,DMACON(a5)
move.l	GfxBase,a4
move.l	OldCOPAddr,$32(a4)
move.w	(sp)+,d0
bset	#15,d0
move.w	d0,DMACON(a5)


move.l	EXECBASE,a6
jsr	Permit(a6)	; I wanna multitask the whole night long ...

; *** DebuggingRoutine *************************************
;move.l	#$fffffffe,d0
;DebugLoop:
;move.w	d0,$dff180
;dbf	d0,DebugLoop
; *** End of DebuggingRoutine ******************************

NormalExit:
jsr	CleanUp

movem.l	(sp)+,a0-a6/d0-d7
rts

; *** END OF PROGRAM ***************************************

; *** New VBlank Routine

NewIrq:
movem.l	d0-d7/a0-a6,-(sp)

cmp.b	#1,StopAction
beq	Exit

move.l	COPAddr,a5

btst	#0,IncDecFlag	; 0=Increment	Flag begin = 0
bne	Decrement
Increment:
add.b	#$01,126(a5)
add.b	#$01,76(a5)
cmp.b	#$ff,76(a5)
bne	Exit
bchg	#0,IncDecFlag
jmp	Exit

Decrement:
sub.b	#$01,126(a5)
sub.b	#$01,76(a5)
cmp.b	#$29,76(a5)
bne	Exit
bchg	#0,IncDecFlag
jmp	Exit

Exit:

movem.l	(sp)+,a0-a6/d0-d7
OldIrq:
jmp	$00000000	; Normal VBlank
even

; ***

; *** SUBROUTINES

; ***

ErrorExit:
move.l	#$fffffffe,d0
ErrorExitLoop:
move.w	d0,CUSTOM+COLOR00
dbf	d0,ErrorExitLoop
bsr	CleanUp
bra	NormalExit

; ***

CleanUp:

move.l	EXECBASE,a6
move.l	GfxBase,a1
cmp.l	#0,a1
beq	NoGfxLibrary
jsr	CloseLibrary(a6)
NoGfxLibrary:

move.l	EXECBASE,a6
move.l	COPAddr,a1
cmp.l	#0,a1
beq	NoCOPAddr
move.l	TotalCopMem,d0
jsr	FreeMem(a6)
NoCOPAddr:
move.l	EXECBASE,a6

clr.l	d5	; Loop Counter
lea	BPLAddrsTable,a4
FreePLaneAddrsLoop:
add.l	#1,d5
add.l	#4,a4
move.l	(a4),a1
cmp.l	#0,a1
beq	ContFPALoop
move.l	#[[PlaneWidth*PlaneHeight]/8],d0 ; needed BPL memory in bytes
jsr	FreeMem(a6)
ContFPALoop:
cmp.l	#PlaneDepth,d5
bne	FreePlaneAddrsLoop

NoBPLAddr:
rts

; *** VARIABLES

; *** COPPERLIST *******************************************
; *
; *

even
CopperListBegin:

dc.w	DIWSTRT,$3081	; PAL LORES SCREEN 
dc.w	DIWSTOP,$30C1	; CENTERING
dc.w	DDFSTRT,$0038
dc.w	DDFSTOP,$00D0
dc.w	BPLCON0,$5200	; 5 BitPlanes & Color On
dc.w	BPLCON1,$0
dc.w	BPLCON2,$0
dc.w	BPL1MOD,$0
dc.w	BPL2MOD,$0

CopperBPLAddrs:			; Filled in by program
dc.w	BPL1PTH+00,$0000	; BPL1PTH
dc.w	BPL1PTH+02,$0000	; 
dc.w	BPL1PTH+04,$0000	; BPL2PTH
dc.w	BPL1PTH+06,$0000	; 
dc.w	BPL1PTH+08,$0000	; BPL3PTH
dc.w	BPL1PTH+10,$0000	;
dc.w	BPL1PTH+12,$0000	; BPL4PTH
dc.w	BPL1PTH+14,$0000	;
dc.w	BPL1PTH+16,$0000	; BPL5PTH
dc.w	BPL1PTH+18,$0000	;

dc.w	$2911,$fffe

Here:
dc.w	BPL1PTH+00,$0000	; BPL1PTH
dc.w	BPL1PTH+02,$0000	; 
dc.w	BPL1PTH+04,$0000	; BPL2PTH
dc.w	BPL1PTH+06,$0000	; 
dc.w	BPL1PTH+08,$0000	; BPL3PTH
dc.w	BPL1PTH+10,$0000	;
dc.w	BPL1PTH+12,$0000	; BPL4PTH
dc.w	BPL1PTH+14,$0000	;
dc.w	BPL1PTH+16,$0000	; BPL5PTH
dc.w	BPL1PTH+18,$0000	;

dc.w	$9911,$fffe

Here2:
dc.w	BPL1PTH+00,$0000	; BPL1PTH
dc.w	BPL1PTH+02,$0000	; 
dc.w	BPL1PTH+04,$0000	; BPL2PTH
dc.w	BPL1PTH+06,$0000	; 
dc.w	BPL1PTH+08,$0000	; BPL3PTH
dc.w	BPL1PTH+10,$0000	;
dc.w	BPL1PTH+12,$0000	; BPL4PTH
dc.w	BPL1PTH+14,$0000	;
dc.w	BPL1PTH+16,$0000	; BPL5PTH
dc.w	BPL1PTH+18,$0000	;

dc.w	$ffff,$fffe

CopperListEnd:
even
; *
; *
; *** COPPERLIST END ****************************************

GfxBase:	blk.l	1,0

BPLAddrsTable:	blk.l	[PlaneDepth+1],0
OldCOPAddr:	blk.l	1,0
COPAddr:	blk.l	1,0
DynCopStartAddr:	blk.l	1,0
TotalCopMem:	blk.l	1,0
even
IncDecFlag:	dc.b	0
StopAction:	dc.b	0
even

Plane1:		dc.l	0	; /  8 /
Plane2:		dc.l	0	; / 12 /
Plane3:		dc.l	0
Plane4:		dc.l	0
Plane5:		dc.l	0
even


; *** CONSTANTS

even
GfxName:	dc.b	'graphics.library',0
even