jmp run

; Titel 	: Dynamic Copperlist
; Author        : J. Van Houtven
; Address	: Fruithoflaan 105 bus 42,
;		  B-2600 Berchem, Belgium.
; Creation Date : July 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
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

; *** GRAPHICS.LIBRARY FUNCTION OFFSETS

InitRastPort=	-198
InitBitMap=	-390

; *** 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

move.l	GfxBase,a6
lea 	BitMap,a0
move.l	#PlaneDepth,d0
move.l	#PlaneWidth,d1
move.l	#PlaneHeight,d2
jsr	InitBitMap(a6)

move.l	GfxBase,a6
lea 	RastPort,a1
jsr	InitRastPort(a6)
move.l	#BitMap,RastBitMap

; Fill in the BitPlaneAddrs in the CopperList and in BitMap

lea	CopperBPLAddrs,a0	; BPL1PTH
add.l	#2,a0
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 
swap	d0
move.w	d0,(a0)			; fill in BPLxPTH
add.l	#8,a0			; 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
move.l	#$fffffffe,d0

CopCopyLoop:

move.l	(a0)+,d1
cmp.l	d0,d1
beq	CopCopyDone		; Stop copying when d1=$fffffffe
move.l	d1,(a1)+
bra	CopCopyLoop
CopCopyDone:
move.l	a1,DynCopStartAddr	; The address in a1 points
				; to the reserved memory
				; in the CopperList

move.l	#255,d0		; Loop Counter
move.l	#$2911,d1	; CWAIT-value
clr.w	d2		; Colorvalue = $000
sf	d3		; Math-flag = Add
DynCopLoop:
move.w	d1,(a1)+	; CWAIT-value
move.w	#$fffe,(a1)+	; CWAIT-mask
move.w	#$180,(a1)+	; CMOVE-addr
move.w	d2,(a1)+	; CMOVE-value
tst.b	d3		; Math-flag (add/substract)
beq	AddNewColor
SubNewColor:
tst.w	d2		; color-value = $000 (black) ?
bne	NotMinColorVal
sf	d3		; yes => switch to add
bra	NewColorDone
NotMinColorVal:
sub.w	#$111,d2
bra	NewColorDone
AddNewColor:
cmp.w	#$fff,d2	; color-value = $fff (white) ?
bne	NotMaxColorVal	;
st	d3		; yes => switch to substract
bra	NewColorDone
NotMaxColorVal:
add.w	#$111,d2
NewColorDone:
cmp.w	#$ff11,d1	; Did we reach line 255 ?
bne	NoOverScan
move.w	#$ff11,d1
move.l	#$ffdffffe,(a1)+
move.l	a1,DynCopOSAddr	; Save address of OverScan position 
NoOverScan:
add.w	#$0100,d1	; Next line
dbf	d0,DynCopLoop
move.l	#$fffffffe,(a1)	; CEND

; *** Fill BitPlanes
 
lea	BPLAddrsTable,a4
move.l	#PlaneDepth-1,d4	; Loop Counter
NextPlaneLoop:
add.l	#4,a4
move.l	(a4),a5

move.l	#[[[PlaneHeight*PlaneWidth]/32]-1],d5
move.l	#$aaaaaaaa,d3
lsl.w	d4,d3
swap	d3
lsr.w	d4,d3
swap	d3

FillPlaneLoop:
move.l	d3,(a5)+
dbf	d5,FillPlaneLoop

dbf	d4,NextPlaneLoop

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)

LMBTestLoop:
btst	#6,CIAAPRA
bne	LMBTestLoop

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)

move.l	DynCopStartAddr,a0	; The CopperInstructions from Start 
			; to Overscan line
add.l	#6,a0	; Point to COLOR Value
move.l	#214,d6
NextLine:
sub.w	#$111,(a0)
add.l	#8,a0
dbf	d6,NextLine

move.l	DynCopOSAddr,a0	; The CopperInstructions after the 
			; Overscan line start at this address
add.l	#6,a0	; Point to COLOR Value
move.l	#39,d6
NextOSLine:
sub.w	#$111,(a0)
add.l	#8,a0
dbf	d6,NextOSLine

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,$2981	; PAL LORES SCREEN 
dc.w	DIWSTOP,$29C1	; 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	$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
DynCopOSAddr:	blk.l	1,0
TotalCopMem:	blk.l	1,0

even
BitMap:
BytesPerRow:	dc.w	0
Bytes:		dc.w	0
Flags:		dc.b	0
Depht:		dc.b	0
Pad:		dc.w	0
Plane1:		dc.l	0	; /  8 /
Plane2:		dc.l	0	; / 12 /
Plane3:		dc.l	0
Plane4:		dc.l	0
Plane5:		dc.l	0
Planes:		blk.l	2,0
even
RastPort:	dc.l	0
RastBitMap:	dc.l	0
		blk.b	96


; *** CONSTANTS

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