home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fish 'n' More 2
/
fishmore-publicdomainlibraryvol.ii1991xetec.iso
/
fish
/
science
/
blittersand
/
blittersand.asm
< prev
next >
Wrap
Assembly Source File
|
1990-10-22
|
29KB
|
853 lines
;BlitterSand
;by Mike Creutz
; P.O. Box 204
; E. Moriches, NY 11940
; USA
;creutz@bnlux0.bnl.gov
;23 June 1990
;This program simulates the cellular automaton model presented
;by P. Bak, C. Tang, and K. Wiesenfeld (Phys. Rev. Lett. 59, 381 (1987);
;Phys. Rev. A38, 364 (1988)) to illustrate self organized criticality.
;Each site carries a positive integer representing the local slope of
;a sandpile. If the slope exceeds 3, the site is unstable and on
;updating it drops by 4, adding one to each of his neighbors.
;Sand is lost only at the edges. Any state will relax to stability
;through such sand loss.
;The colors representing slopes of 0 through 7 are white, black,
;red, green, yellow, blue, magenta, and cyan, respectively.
;Various keypresses do as follows:
; <esc>, q, or any control character exits
; p pauses; repeated presses single step; any other key restarts
; d doubles the lattice modulo 8
; a sets a flag to pause after each relaxation
;The program can be run from either CLI or Workbench. This code
;is completely self contained and will run directly through A68K
;followed by BLink without need for any include files.
;The program directly accesses the blitter for speed, but does
;so in a mode friendly to multitasking. To understand the program
;details you should have the Amiga Hardware Reference Manual.
;Technically, the show proceeds as follows:
;We start with ones on the borders and twos on the corners
;of a 288 by 188 lattice. For the first loop, whenever a stable state
;occurs, the heights are all doubled, and the system is allowed to
;relax back to stability. This eventually leads to a unique state
;that when doubled relaxes to itself. The system can be described
;as a large Abelian group and this state represents the identity.
;After the identity is found, the program proceeds to construct
;the inverse of the state with all cells unity. After this is found it
;is tripled to give the inverse of the minimally stable state with all
;cells being 3.
;After all this, to keep the show going, the identity is
;added to the system which then relaxes back to itself. This loops
;until intervention.
;If you hit 'd' on an active state early in the program, the search for
;the identity will be derailed and the program will go into a mode where
;the pattern is unlikely to repeat for the lifetime of the universe.
;After a few hours, however, it will probably look uninterestingly random.
; ******************************************************
; library offsets:
_LVOOpenLibrary EQU -552
_LVOCloseLibrary EQU -414
_LVOSetAPen EQU -342
_LVOSetBPen EQU -348
_LVOSetDrMd EQU -354
_LVOWritePixel EQU -324
_LVOMove EQU -240
_LVODraw EQU -246
_LVOText EQU -60
_LVOClipBlit EQU -552
_LVOOpenScreen EQU -198
_LVOOpenWindow EQU -204
_LVOCloseScreen EQU -66
_LVOCloseWindow EQU -72
_LVOGetMsg EQU -372
_LVOReplyMsg EQU -378
_LVOWaitPort EQU -384
_LVOLoadRGB4 EQU -192
_LVOOwnBlitter EQU -456
_LVODisownBlitter EQU -462
_LVOWaitBlit EQU -228
_LVOAllocMem EQU -198
_LVOFreeMem EQU -210
_LVOSetRast EQU -234
_LVOFindTask EQU -294
_LVOForbid EQU -132
;IDCMP Flags
CLOSEWINDOW EQU $200
VANILLAKEY EQU $200000
; window flags
WINDOWDRAG EQU $2
WINDOWDEPTH EQU $4
WINDOWCLOSE EQU $8
BACKDROP EQU $100
BORDERLESS EQU $800
ACTIVATE EQU $1000
; various useful numbers
MEMF_PUBLIC EQU 1
MEMF_CHIP EQU 2
MEMF_FAST EQU 4
MEMB_CLEAR EQU $10000
pr_CLI EQU 172
pr_MsgPort EQU 92
AbsExecBase EQU $4
JAM1 EQU 0
JAM2 EQU 1
COMPLEMENT EQU 2
INVERSID EQU 3
; custom chip register offsets
_custom EQU $DFF000
DMACONR EQU $002
BLTCON0 EQU $040
BLTCON1 EQU $042
BLTAFWM EQU $044
BLTALWM EQU $046
BLTCPT EQU $048
BLTBPT EQU $04C
BLTAPT EQU $050
BLTDPT EQU $054
BLTSIZE EQU $058
BLTCMOD EQU $060
BLTBMOD EQU $062
BLTAMOD EQU $064
BLTDMOD EQU $066
BLTCDAT EQU $070
BLTBDAT EQU $072
BLTADAT EQU $074
; various size parameters
xmin EQU 16 ; should be a multiple of 16
ymin EQU 11 ; 11 or more to avoid border effects
xmax EQU 303 ; -1+multiple of 16
ymax EQU 198
; a small system for testing:
;xmin equ 48
;xmax equ 127
;ymin equ 50
;ymax equ 150
startdisp EQU 2*(xmin/16)+ymin*40 ; shift from start of bitplane to lattice
modulo EQU 40-2*((xmax-xmin+1)/16) ; blitter modulo
enddisp EQU -modulo-2+((ymax-ymin+1)*40) ; shift to end of lattice
bsize EQU 20-(modulo/2)+$40*(ymax-ymin+1) ; for BLTSIZE
workspacesize EQU 40*(ymax-ymin+1)
; startup code for CLI or Workbench
; opens graphics and intuition libraries, calls 'Main' and exits
startup:
movem.l d2-d7/a2-a6,-(a7) ; save registers
move.l AbsExecBase,a6 ; exec base pointer
clr.l workbenchmessage
suba.l a1,a1 ; clear a1
jsr _LVOFindTask(a6) ; where is our task
move.l d0,a4
tst.l pr_CLI(a4) ; are we running from CLI?
bne fromcli ; if not then get workbench message
lea pr_MsgPort(a4),a0
jsr _LVOWaitPort(a6)
Jsr _LVOGetMsg(a6)
move.l d0,workbenchmessage ; save for exit
;open graphics and intuition libraries
fromcli lea GraphicsName(pc),a1 ; pointer to name of library
moveq #0,d0 ; accept any version
jsr _LVOOpenLibrary(a6)
move.l d0,GraphicsBase ; save graphics base
tst.l d0
beq.s Exit1 ; quit if trouble opening library
lea IntuitionName(pc),a1 ; pointer to name of library
moveq #0,d0 ; accept any version
jsr _LVOOpenLibrary(a6)
move.l d0,IntuitionBase ; save intuition base
tst.l d0
beq.s Exit2 ; quit if trouble opening library
; execute main program
bsr Main
;final cleanup
Exit3: movea.l IntuitionBase,a1 ; intuition base
movea.l AbsExecBase,a6 ; exec base pointer
jsr _LVOCloseLibrary(a6)
Exit2: movea.l GraphicsBase,a1 ; graphics base
jsr _LVOCloseLibrary(a6)
moveq.l #0,d0 ; return zero
Exit1: tst.l workbenchmessage ; are we a workbench program?
beq.s Exit0 ; if not goto exit0
jsr _LVOForbid(a6) ; because the RKM tells me so
movea.l workbenchmessage(pc),a1
jsr _LVOReplyMsg(a6) ; reply to workbench message
Exit0: movem.l (a7)+,d2-d7/a2-a6 ; restore registers
rts ; end of startup code
Main: move.l a7,oldstack ; save stack for exit
; allocate various working areas
moveq.l #7,d2 ; memory allocation loop counter
lea.l workingplane1(pc),a2
bra.s startalloc
allocloop move.l #workspacesize,d0 ; size for working area
move.l #MEMF_CHIP+MEMB_CLEAR,d1 ;get chip memory
jsr _LVOAllocMem(a6)
tst.l d0
beq quit1
move.l d0,(a2)+
startalloc dbf.s d2,allocloop
; open screen and window
move.l IntuitionBase(pc),a6
lea myscreen(pc),a0
jsr _LVOOpenScreen(a6) ; open custom screen
move.l d0,screen ; save screen structure pointer
beq quit1 ; quit if trouble
lea mywindow(pc),a0 ; open display window
jsr _LVOOpenWindow(a6)
move.l d0,window ; save address of window structure
beq quit2 ;quit if trouble
movea.l d0,a0
move.l 86(a0),userport
movea.l 50(a0),a0 ; rastport
move.l a0,rastport
move.l 4(a0),a0 ; bitmap structure
move.l 8(a0),bitplane1
move.l 12(a0),bitplane2
move.l 16(a0),bitplane3
addi.l #startdisp,bitplane1
addi.l #startdisp,bitplane2
addi.l #startdisp,bitplane3
;set colors
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
movea.l screen(pc),a0
adda.l #44,a0 ; viewport
lea.l colors(pc),a1
moveq.l #8,d0
jsr _LVOLoadRGB4(a6)
; show credits
bsr credits
;draw initial box of ones
movea.l rastport(pc),a1
moveq.w #1,d0
jsr _LVOSetAPen(a6) ; set pen color
movea.l rastport(pc),a1
moveq.w #JAM1,d0
jsr _LVOSetDrMd(a6) ; set drawing mode
movea.l rastport(pc),a1
move.w #xmin,d0
move.w #ymin,d1
jsr _LVOMove(a6) ; go to top left corner
movea.l rastport(pc),a0
move.w #xmax,d0
move.w #ymin,d1
jsr _LVODraw(a6) ; draw top line
movea.l rastport(pc),a0
move.w #xmax,d0
move.w #ymax,d1
jsr _LVODraw(a6) ; right side
movea.l rastport(pc),a0
move.w #xmin,d0
move.w #ymax,d1
jsr _LVODraw(a6) ; bottom
movea.l rastport(pc),a0
move.w #xmin,d0
move.w #ymin,d1
jsr _LVODraw(a6) ; left
;set corners to two
movea.l rastport(pc),a1
moveq.w #2,d0
jsr _LVOSetAPen(a6) ; new color for corners
movea.l rastport(pc),a1
move.w #xmin,d0
move.w #ymin,d1
jsr _LVOWritePixel(a6) ; nw corner
movea.l rastport(pc),a1
move.w #xmax,d0
move.w #ymin,d1
jsr _LVOWritePixel(a6) ; ne corner
movea.l rastport(pc),a1
move.w #xmax,d0
move.w #ymax,d1
jsr _LVOWritePixel(a6) ; se corner
movea.l rastport(pc),a1
move.w #xmin,d0
move.w #ymax,d1
jsr _LVOWritePixel(a6) ; sw corner
; showtime -- first double until identity found
firstloop: bsr relax
lea.l storage1(pc),a0 ; prepare to compare with storage
lea.l bitplane1(pc),a1
bsr compare2 ; see if lattices equal
btst.b #5,control(pc)
bne.s foundidentity
lea.l bitplane1(pc),a0
lea.l storage1(pc),a1
bsr copy2 ; copy bitplanes to storage
bsr double ; double things
bra.s firstloop
; save identity and set first storage plane to unity
foundidentity:
lea.l bitplane1(pc),a0
lea.l identity1(pc),a1
bsr copy2
lea.l storage1(pc),a0
bsr set1
; subtract first storage plane while adding identity
bra.s stillactive
secondloop: bsr sand
btst.b #5,control(pc) ; check if still active
beq.s stillactive
lea.l identity1(pc),a0
lea.l bitplane1(pc),a1
bsr addit
stillactive: bsr subtract1
btst.b #5,control(pc) ; check if more to subtract
bne.s tripleit
bsr checkmessage
bra.s secondloop
; triple to find inverse of minimally stable state
tripleit bsr relax
lea.l bitplane1(pc),a0
lea.l storage1(pc),a1
bsr copy2
bsr double
bsr relax
lea.l storage1(pc),a0
lea.l bitplane1(pc),a1
bsr addit
bsr relax
; to keep display moving, repeatedly add identity and relax
finalloop lea.l identity1(pc),a0
lea.l bitplane1(pc),a1
bsr addit
bsr relax
bra.s finalloop
; time to quit
getout:
; close windows and screen
movea.l window(pc),a0
move.l IntuitionBase(pc),a6
jsr _LVOCloseWindow(a6)
quit2 movea.l screen(pc),a0
jsr _LVOCloseScreen(a6)
; deallocate memory
quit1: movea.l AbsExecBase,a6
moveq.l #7,d2 ; memory deallocation loop counter
lea.l workingplane1(pc),a2
bra.s startdealloc
deallocloop move.l #workspacesize,d0 ; size for working area
movea.l (a2)+,a1
move.l a1,d1 ; to test if not zero
beq.s done
jsr _LVOFreeMem(a6) ; return memory
startdealloc dbf.s d2,deallocloop
done movea.l oldstack(pc),a7 ; reset stack pointer
rts ; all done
; subroutine to update lattice until relaxed
relax: bsr sand
btst.b #5,control(pc) ; check if still active
bne.s relaxed
bsr checkmessage
bra.s relax
relaxed: tst.w autopause ; should we pause
beq.s autooff
bsr waitformessage
autooff rts
; message handling subroutine
; message location returned in d0, class in d2, code in d3
; with VANILLAKEY code is ascii of pressed key
waitformessage: ; pause for a signal
movea.l AbsExecBase,a6
movea.l userport(pc),a0
jsr _LVOWaitPort(a6) ; wait for a message
checkmessage: ; enter here to not wait if no message
movea.l AbsExecBase,a6
movea.l userport(pc),a0
jsr _LVOGetMsg(a6)
tst.l d0
bne.s messagefound
rts
messagefound:
movea.l d0,a1
move.l 20(a1),d2 ; save class in d2
move.w 24(a1),d3 ; and code in d3
jsr _LVOReplyMsg(a6) ; reply to message
; check for various keypresses
cmpi.w #27,d3 ; esc
ble getout ; leave for escape or control characters
cmpi.w #'q',d3
beq getout ; quit for q
cmpi.w #'p',d3 ; p ; pause for p
bne.s not_p
movea.l userport(pc),a0
jsr _LVOWaitPort(a6) ; wait for a message
not_p cmpi.w #'d',d3 ; d
bne.s not_d ; double for d
bsr double
not_d cmpi.w #'a',d3 ; a
bne.s not_a
not.w autopause ; flip autopausing flag
not_a rts ; continue
; storage area
; window and screen parameters
mywindow dc.w 0,0,320,200 ; xmin,ymin,xsize,ysize
dc.b 0,0 ; detail pen, block pen
; (Intuition Direct Communication Message Port)
dc.l VANILLAKEY ; IDCMP Flags, ask for keypresses
dc.l ACTIVATE+BORDERLESS ;+BACKDROP ; flags (type in amigabasic)
dc.l 0 ; gadgets
dc.l 0 ; checkmark
dc.l title ; my title
screen dc.l 0 ;location of screen, fill later
dc.l 0 ;bitmap
dc.w 0,0,320,200 ;min-max window size
dc.w $f ; type: 1=wbenchscreen $F=customscreen
myscreen dc.w 0,0,320,200 ;size
dc.w 3 ;depth
dc.b 5,6 ;pens
dc.w $0 ;viewmodes- interlace=4, hires=$8000
; sprites=$4000, ham=$800, extra_halfbrite=$80
dc.w $f ;type: customscreen
dc.l textattr ;font
dc.l title ;title
dc.l 0 ;gadgets
dc.l 0 ;custombitmap
textattr dc.l fontname
dc.w 8 ;fontsize
dc.b 0,0 ;style and flags
colors dc.w $fff ; color table
dc.w $000
dc.w $f00
dc.w $0f0
dc.w $ff0
dc.w $00f
dc.w $f0f
dc.w $0ff
workbenchmessage dc.l 0
GraphicsBase dc.l 0
IntuitionBase dc.l 0
GraphicsName dc.b 'graphics.library',0
IntuitionName dc.b 'intuition.library',0
title dc.b 'BlitterSand -- <esc> to exit',0
fontname dc.b 'topaz.font',0
window dc.l 0
rastport dc.l 0
userport dc.l 0
bitplane1 dc.l 0
bitplane2 dc.l 0
bitplane3 dc.l 0
workingplane1 dc.l 0
workingplane2 dc.l 0
workingplane3 dc.l 0
storage1 dc.l 0
storage2 dc.l 0
identity1 dc.l 0
identity2 dc.l 0
control dc.w 0
autopause dc.w 0
oldstack dc.l 0
; primary updating routine
sand: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
jsr _LVOOwnBlitter(a6) ; grab blitter for my use
lea _custom,a5
move.l bitplane1(pc),d2 ;start of bitplane1
move.l bitplane2(pc),d3 ;start of bitplane2
move.l bitplane3(pc),d4 ;start of bitplane3
move.l workingplane1(pc),d5 ; start of working plane 1
move.l workingplane2(pc),d6 ; start of working plane 2
move.l workingplane3(pc),d7 ; start of working plane 3
; add left, top, and bottom neighbors to workspace
; work on first bit:
jsr _LVOWaitBlit(a6)
move.l d5,BLTDPT(a5) ; first workspace plane
move.l d4,d0
move.l d0,BLTAPT(a5) ; for left neighbor
addi.l #40,d0
move.l d0,BLTBPT(a5) ; for bottom neighbor
subi.l #80,d0
move.l d0,BLTCPT(a5) ; for top
move.w #0,BLTCON1(a5)
move.w #$1f96,BLTCON0(a5) ; odd number of source bits set
move.w #modulo,BLTAMOD(a5) ; set up modulos
move.w #modulo,BLTBMOD(a5)
move.w #modulo,BLTCMOD(a5)
move.w #modulo,BLTDMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$fffe,BLTALWM(a5) ; mask out last bit of row
move.w #bsize,BLTSIZE(a5) ; do it
; second bit
jsr _LVOWaitBlit(a6)
move.l d6,BLTDPT(a5) ; second plane of workspace
move.l d4,d0
move.l d0,BLTAPT(a5) ; reset bitplane pointers
addi.l #40,d0
move.l d0,BLTBPT(a5)
subi.l #80,d0
move.l d0,BLTCPT(a5)
move.w #$1fe8,BLTCON0(a5) ; 2 or more source bits set
move.w #bsize,BLTSIZE(a5) ; go to it
; add in fourth neighbor, third bit of result
jsr _LVOWaitBlit(a6)
move.l d4,d0
addi.l #enddisp,d0
move.l d0,BLTAPT(a5) ; end of lattice
move.l d7,d0
addi.l #enddisp,d0
move.l d0,BLTDPT(a5) ; end of third plane of workspace
move.l d5,d0
addi.l #enddisp,d0
move.l d0,BLTBPT(a5) ; first workspace plane
move.l d6,d0
addi.l #enddisp,d0 ; second workspace plane
move.l d0,BLTCPT(a5)
move.w #2,BLTCON1(a5) ; descending mode
move.w #$1f80,BLTCON0(a5) ; third bit only if all already set
move.w #$7fff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5) ; OK
; add in fourth neighbor, second bit of result
jsr _LVOWaitBlit(a6)
move.l d4,d0
addi.l #enddisp,d0
move.l d0,BLTAPT(a5)
move.l d6,d0
addi.l #enddisp,d0
move.l d0,BLTDPT(a5)
move.l d0,BLTCPT(a5)
move.l d5,d0
addi.l #enddisp,d0
move.l d0,BLTBPT(a5)
move.w #$1f6a,BLTCON0(a5) ; second bit only if appropriate
move.w #bsize,BLTSIZE(a5) ; here we go again
; add in fourth neighbor, first bit of result
jsr _LVOWaitBlit(a6)
move.l d4,d0
addi.l #enddisp,d0
move.l d0,BLTAPT(a5)
move.l d5,d0
addi.l #enddisp,d0
move.l d0,BLTDPT(a5)
move.l d0,BLTBPT(a5)
move.w #$1d3c,BLTCON0(a5) ; second bit from a xor b
move.w #bsize,BLTSIZE(a5) ; finish setting up workspace
; add it all up
jsr _LVOWaitBlit(a6) ; 2w,3w,2b to 3b
move.l d4,BLTDPT(a5)
move.l d3,BLTAPT(a5)
move.l d6,BLTBPT(a5)
move.l d7,BLTCPT(a5)
move.w #0,BLTCON1(a5) ; reset for ascending mode
move.w #$0fea,BLTCON0(a5)
move.w #$ffff,BLTALWM(a5) ; fix last word mask
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6) ; 2w,2b to 2b
move.l d3,BLTDPT(a5)
move.l d3,BLTAPT(a5)
move.l d6,BLTBPT(a5)
move.w #$0d3c,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6) ; 1w,1b,2b to 3w for carry
move.l d7,BLTDPT(a5)
move.l d2,BLTAPT(a5)
move.l d3,BLTBPT(a5)
move.l d5,BLTCPT(a5)
move.w #$0f80,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6) ; 1w, 1b to 2b
move.l d3,BLTDPT(a5)
move.l d2,BLTAPT(a5)
move.l d5,BLTBPT(a5)
move.l d3,BLTCPT(a5)
move.w #$0f6a,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6) ; final carry
move.l d4,BLTDPT(a5)
move.l d4,BLTAPT(a5)
move.l d7,BLTBPT(a5)
move.w #$0dfc,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6) ; 1w, 1b to 1b
move.w DMACONR(a5),control ; save control register for later
move.l d2,BLTDPT(a5)
move.l d2,BLTAPT(a5)
move.l d5,BLTBPT(a5)
move.w #$0d3c,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; I'm done for now
rts
; double main lattice
double: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
jsr _LVOOwnBlitter(a6)
lea _custom,a5
move.l bitplane1(pc),d2 ;start of bitplane1
move.l bitplane2(pc),d3 ;start of bitplane2
move.l bitplane3(pc),d4 ;start of bitplane3
; shift up all bitplanes
jsr _LVOWaitBlit(a6)
move.l d4,BLTDPT(a5) ; copy to plane 3
move.l d3,BLTAPT(a5) ; from plane 2
move.w #0,BLTCON1(a5)
move.w #$09f0,BLTCON0(a5)
move.w #modulo,BLTAMOD(a5)
move.w #modulo,BLTBMOD(a5)
move.w #modulo,BLTCMOD(a5)
move.w #modulo,BLTDMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$ffff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d3,BLTDPT(a5) ; copy to plane 2
move.l d2,BLTAPT(a5) ; from plane 1
move.w #$09f0,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d2,BLTDPT(a5) ; clear plane 1
move.w #$0100,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; give it back
rts
compare2 ; compare two planes, pointed to by (a0) and (a1)
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
lea _custom,a5
move.l (a0)+,d2 ;start of bitplane1
move.l (a0),d3 ;start of bitplane2
move.l (a1)+,d4 ;start of comparison bitplane1
move.l (a1),d5 ;start of comparison bitplane2
jsr _LVOOwnBlitter(a6) ; get blitter
jsr _LVOWaitBlit(a6)
move.l d2,BLTAPT(a5) ; plane 1
move.l d4,BLTBPT(a5) ; compare 1
move.w #0,BLTCON1(a5)
move.w #$0c3c,BLTCON0(a5)
move.w #modulo,BLTAMOD(a5)
move.w #modulo,BLTBMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$ffff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.w DMACONR(a5),control ; save control register for later
move.l d3,BLTAPT(a5) ; plane 2
move.l d5,BLTBPT(a5) ; compare 2
move.w #0,BLTCON1(a5)
move.w #$0c3c,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.w DMACONR(a5),d0
and.w d0,control ; save control register for later
jsr _LVODisownBlitter(a6) ; give it back
rts
copy2 ; copy two planes, pointed to by (a0) and (a1)
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
lea _custom,a5
move.l (a0)+,d2 ;start of bitplane1
move.l (a0),d3 ;start of bitplane2
move.l (a1)+,d4 ;start of copy bitplane1
move.l (a1),d5 ;start of copy bitplane2
jsr _LVOOwnBlitter(a6) ; prepare blitter
jsr _LVOWaitBlit(a6)
move.l d2,BLTAPT(a5) ; plane 1
move.l d4,BLTDPT(a5) ; copy 1
move.w #0,BLTCON1(a5)
move.w #$09f0,BLTCON0(a5) ; straight copy
move.w #modulo,BLTAMOD(a5)
move.w #modulo,BLTDMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$ffff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d3,BLTAPT(a5) ; plane 2
move.l d5,BLTDPT(a5) ; copy 2
move.w #0,BLTCON1(a5)
move.w #$09f0,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; give it back
rts
set1: ; set one plane to unity, pointed to by (a0)
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
lea _custom,a5
move.l (a0),d2 ;start of plane
jsr _LVOOwnBlitter(a6) ; get blitter
jsr _LVOWaitBlit(a6)
move.l d2,BLTDPT(a5) ; plane 1
move.w #0,BLTCON1(a5)
move.w #$01ff,BLTCON0(a5) ; straight set
move.w #modulo,BLTDMOD(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; give it back
rts
; subtract storage1 from nonzero lattice sites
subtract1: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
jsr _LVOOwnBlitter(a6)
lea _custom,a5
move.l bitplane1(pc),d2 ;start of bitplane1
move.l bitplane2(pc),d3 ;start of bitplane2
move.l workingplane1(pc),d5 ; start of working plane 1
move.l workingplane2(pc),d6 ; start of working plane 2
move.l storage1(pc),d7
jsr _LVOWaitBlit(a6)
move.l d5,BLTDPT(a5) ; new first plane to working plane
move.l d2,BLTAPT(a5) ; old first plane
move.l d3,BLTBPT(a5) ; old second plane
move.l d7,BLTCPT(a5) ; subtracting plane
move.w #0,BLTCON1(a5)
move.w #$0f58,BLTCON0(a5)
move.w #modulo,BLTAMOD(a5)
move.w #modulo,BLTBMOD(a5)
move.w #modulo,BLTCMOD(a5)
move.w #modulo,BLTDMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$ffff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d6,BLTDPT(a5) ; new second plane to working plane
move.l d2,BLTAPT(a5) ; old first plane
move.l d3,BLTBPT(a5) ; old second plane
move.l d7,BLTCPT(a5) ; subtracting plane
move.w #0,BLTCON1(a5)
move.w #$0fc4,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d7,BLTDPT(a5) ; new subtracting plane to storage
move.l d2,BLTAPT(a5) ; old first plane
move.l d3,BLTBPT(a5) ; old second plane
move.l d7,BLTCPT(a5) ; subtracting plane
move.w #0,BLTCON1(a5)
move.w #$0f02,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.w DMACONR(a5),control ; save control register for later
move.l d5,BLTAPT(a5) ; new plane 1
move.l d2,BLTDPT(a5) ; copy back
move.w #0,BLTCON1(a5)
move.w #$09f0,BLTCON0(a5) ; straight copy
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d6,BLTAPT(a5) ; new plane 2
move.l d3,BLTDPT(a5) ; copy back
move.w #0,BLTCON1(a5)
move.w #$09f0,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; give it back
rts
; add two lattices, source pointed at by (a0) and dest by (a1)
addit: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
lea _custom,a5
move.l (a1)+,d2 ;start of bitplane1
move.l (a1)+,d3 ;start of bitplane2
move.l (a1),d4 ;start of bitplane3
move.l (a0)+,d5 ;start of adding plane1
move.l (a0),d6 ;start of adding plane2
jsr _LVOOwnBlitter(a6) ; prepare to add identity to lattice
move.l workingplane3(pc),d7 ; for carry
jsr _LVOWaitBlit(a6)
move.l d7,BLTDPT(a5) ; carry
move.l d2,BLTAPT(a5) ; old first plane
move.l d5,BLTBPT(a5) ; identity1
move.w #0,BLTCON1(a5)
move.w #$0dc0,BLTCON0(a5)
move.w #modulo,BLTAMOD(a5)
move.w #modulo,BLTBMOD(a5)
move.w #modulo,BLTCMOD(a5)
move.w #modulo,BLTDMOD(a5)
move.w #$ffff,BLTAFWM(a5)
move.w #$ffff,BLTALWM(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d2,BLTDPT(a5) ; new first plane (assume old=0)
move.l d2,BLTAPT(a5) ; old first plane
move.l d5,BLTBPT(a5) ; identity1
move.w #0,BLTCON1(a5)
move.w #$0d3c,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d4,BLTDPT(a5) ; new third bit
move.l d3,BLTAPT(a5) ; old second plane
move.l d6,BLTBPT(a5) ; identity2
move.l d7,BLTCPT(a5) ; old carry
move.w #0,BLTCON1(a5)
move.w #$0fe8,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVOWaitBlit(a6)
move.l d3,BLTDPT(a5) ; new second bit
move.l d3,BLTAPT(a5) ; old second plane
move.l d6,BLTBPT(a5) ; identity2
move.l d7,BLTCPT(a5) ; old carry
move.w #0,BLTCON1(a5)
move.w #$0f96,BLTCON0(a5)
move.w #bsize,BLTSIZE(a5)
jsr _LVODisownBlitter(a6) ; give it back
rts
credits: ; display introductory comments
moveq.l #30,d2 ; length of lines
moveq.l #15,d3 ; number of lines
moveq.l #25,d4 ; starting row
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
lea.l mytext(pc),a3 ; start of text information
movea.l rastport(pc),a1
moveq.w #7,d0
jsr _LVOSetBPen(a6) ; set background pen color
movea.l rastport(pc),a1
moveq.w #JAM2,d0
jsr _LVOSetDrMd(a6) ; set drawing mode
bra startprint
myprint: movea.l rastport(pc),a1 ; rastport
move.l d4,d1 ; starting row
moveq.l #40,d0 ; starting column
jsr _LVOMove(a6) ; locate pen
movea.l rastport(pc),a1 ; rastport
move.b (a3)+,d0 ; get color
andi.l #7,d0 ; make sure color valid
jsr _LVOSetAPen(a6) ; set color
movea.l rastport(pc),a1 ; rastport
movea.l a3,a0 ; text location
move.l d2,d0 ; length of line
jsr _LVOText(a6) ; print line
adda.l d2,a3 ; next line
addi.l #8,d4 ; next row
startprint: dbf d3,myprint
bsr waitformessage ; wait for key press
movea.l GraphicsBase(pc),a6 ; graphics library address in a6
movea.l rastport(pc),a1
moveq.l #0,d0
jsr _LVOSetRast(a6) ; clear screen
rts
mytext: ; initial number represents color
dc.b 2,' '
dc.b 2,' BlitterSand '
dc.b 2,' '
dc.b 6,' by '
dc.b 2,' '
dc.b 5,' Michael Creutz '
dc.b 6,' creutz@bnlux0.bnl.gov '
dc.b 5,' '
dc.b 5,'<esc>, q exit '
dc.b 5,' p pause '
dc.b 5,' d double modulo 8 '
dc.b 5,' a pause after relax '
dc.b 1,' '
dc.b 1,' Press any key to start '
dc.b 2,' '
end