;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