*** Dual-Playfield & Scroll Demo ***

;CustomChip-Register

INTENA   = $9A ;Interrupt-Enable-Register (write)
INTREQR  = $1e ;Interrupt-Request-Register (read)
DMACON  = $96  ;DMA-Control register (write)
COLOR00 = $180 ;Color palette register 0
VPOSR   = $4   ;half line position (read)

;Copper Register

COP1LC  = $80 ;Address of 1. Copperlist
COP2LC  = $84 ;Address of 2. Copperlist
COPJMP1 = $88 ;Jump to Copperlist 1
COPJMP2 = $8a ;Jump to Copperlist 2

;Bitplane Register

BPLCON0 = $100 ;Bitplane control register 0
BPLCON1 = $102 ;1 (Scroll value)
BPLCON2 = $104 ;2 (Sprite<>Playfield Priority)
BPL1PTH = $0E0 ;Pointer to 1. Bitplane
BPL1PTL = $0E2 ;
BPL1MOD = $108 ;Modulo-Value for odd Bit-Planes
BPL2MOD = $10A ;Module-value for even Bit-Planes
DIWSTRT = $08E ;Start of screen windows
DIWSTOP = $090 ;End of screen windows
DDFSTRT = $092 ;Bit-Plane DMA Start
DDFSTOP = $094 ;Bit-Plane DMA Stop

;CIA-A Port register A (Mouse key)
CIAAPRA = $bfe001

;Exec Library Base Offsets

OpenLibrary = -30-522 ;LibName,Version/a1,d0
Forbid      = -30-102
Permit      = -30-108
AllocMem    = -30-168 ;ByteSize,Requirements/d0,d1
FreeMem     = -30-180 ;MemoryBlock,ByteSize/a1,d0

;graphics base

StartList   = 38

;Misc Labels

Execbase    = 4
Planesize   = 52*345         ;Size of the Bitplane
Planewidth  = 52
CLsize      = 5*4            ;The Copperlist contains 5 commands
Chip        = 2              ;request Chip-RAM
Clear       = Chip+$10000    ;clear previous Chip-RAM

;*** Pre-programm ***

Start:

;Request memory for Bitplanes

 move.l Execbase,a6
 move.l #Planesize*2,d0      ;memory size of the Planes
 move.l #clear,d1
 jsr    AllocMem(a6)         ;Request memory
 move.l d0,Planeadr
 beq    Ende                 ;Error! -> End

;Request memory for the Copperlist

 moveq  #Clsize,d0
 moveq  #chip,d1
 jsr    AllocMem(a6)
 move.l d0,CLadr
 beq    FreePlane            ;Error! -> Free memory for the Planes

;Build Copperlist

 moveq  #1,d4                ;two Bitplanes
 move.l d0,a0
 move.l Planeadr,d1
 move.w #bpl1pth,d3

MakeCL: move.w d3,(a0)+
 addq.w #2,d3
 swap   d1
 move.w d1,(a0)+
 move.w d3,(a0)+
 addq.w #2,d3
 swap   d1
 move.w d1,(a0)+
 add.l  #planesize,d1        ;Address of the next Plane

 dbf    d4,MakeCL

 move.l #$fffffffe,(a0)      ;End of the Copperlist

;*** Main programm ***

;DMA and Task switching off

 jsr    forbid(a6)
 lea    $dff000,a5
 move.w #$01e0,dmacon(a5)

;Copper initialization

 move.l CLadr,cop1lc(a5)
 clr.w  copjmp1(a5)

;Playfield initialization

 move.w #0,color00(a5)
 move.w #$0f00,color00+2(a5)
 move.w #$000f,color00+18(a5)
 move.w #$1a64,diwstrt(a5)   ;26,100
 move.w #$39d1,diwstop(a5)   ;313,465
 move.w #$0020,ddfstrt(a5)   ;read one extra word
 move.w #$00d8,ddfstop(a5)
 move.w #%0010011000000000,bplcon0(a5) ;Dual-Playfield and
 clr.w  bplcon1(a5)          ;Scroll to start on 0
 clr.w  bplcon2(a5)          ;Playfield 1 or Playfield 2
 move.w #4,bpl1mod(a5)       ;Modulo on 2 Words
 move.w #4,bpl2mod(a5)

;DMA on
 move.w #$8180,dmacon(a5)

;Bitplanes filled with checker pattern

 move.l planeadr,a0
 move.w #planesize/2-1,d0    ;loop value
 move.w #13*16,d1            ;Height = 16 Lines
 move.l #$ffff0000,d2        ;checker pattern
 move.w d1,d3

fill:   move.l d2,(a0)+
 subq.w #1,d3
 bne.s  continue
 swap   d2                   ;pattern change
 move.w d1,d3
continue: dbf d0,fill

;Playfields scroll

 clr.l  d0                   ;vertical Scroll position
 clr.l  d1                   ;horizontal Scroll position
 move.l CLadr,a1             ;Address of the Copperlist
 move.l Planeadr,a0          ;Address of the first Bitplane

;Wait on Raster line 16  (for the  Exec-Interrupts)

wait:  move.l vposr(a5),d2   ;read Position
 and.l #$0001FF00,d2         ;horizontal Bits masked
 cmp.l #$00001000,d2         ;wait on line 16
 bne.s wait

;Playfield 1 vertical scroll

 addq.b #2,d0                ;raise vertical Scroll value
 cmp.w  #$80,d0              ;already  128 (4*32)?
 bne.S  novover
 clr.l  d0                   ;Then back to  0
novover:
 move.l d0,d2                ;copy scroll value
 lsr.w  #2,d2                ;copy divided by 4 s
 mulu   #52,d2               ;Number Bytes per line * Scroll position
 add.l  a0,d2                ;plus Address of first Plane
 add.l  #Planesize,d2        ;plus Plane size
 move.w d2,14(a1)            ;give End address for Copperlist
 swap   d2
 move.w d2,10(a1)

;Playfield 2 horizontal scroll

 addq.b #1,d1                ;raise horizontal Scroll value
 cmp.w  #$80,d1              ;already 128 (4*32)
 bne.S  nohover
 clr.l  d1                   ;then back to 0
nohover:
 move.l d1,d2                ;copy scroll value
 lsr.w  #2,d2                ;copy divided by 4
 move.l d2,d3                ;copy Scroll position
 and.w  #$FFF0,d2            ;lower  4 Bit masked
 sub.w  d2,d3                ;lower 4 Bit in d3 isolated
 move.w d4,bplcon1(a5)       ;last Value in BPLCON1
 move.w d3,d4                ;new scroll value to  d4
 lsr.w  #3,d2                ;new Address for Copperlist
 add.l  a0,d2                ;calculate
 move.w d2,6(a1)             ;and write in Copperlist
 swap   d2
 move.w d2,2(a1)

 btst   #6,ciaapra           ;Mouse key pressed?
 bne.s  wait                 ;NO -> continue

;*** Check programm ***

;Activate old Copperlist

 move.l #GRname,a1           ;Set parameter for OpenLibrary
 clr.l  d0
 jsr    OpenLibrary(a6)      ;Graphics Library open
 move.l d0,a4
 move.l StartList(a4),cop1lc(a5)
 clr.w  copjmp1(a5)
 move.w #$83e0,dmacon(a5)
 jsr    permit(a6)           ;Task-Switching permitted

;Free memeory used by Copperlist

 move.l CLadr,a1             ;Set parameter for FreeMem
 moveq  #CLsize,d0
 jsr    FreeMem(a6)          ;Free memory

;Free memory used by Bitplanes
FreePlane:
 move.l Planeadr,a1
 move.l #Planesize*2,d0
 jsr    FreeMem(a6)

Ende:
 clr.l  d0
 rts                         ;Program ends

;Variables

CLadr:    dc.l 0
Planeadr: dc.l 0
test:     dc.l 0

;Constants

GRname:  dc.b "graphics.library",0

 end
;Program end