home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 423.lha / BlitterSand / BlitterSand.asm < prev    next >
Encoding:
Assembly Source File  |  1990-08-28  |  28.4 KB  |  853 lines
  1. ;BlitterSand 
  2. ;by Mike Creutz
  3. ;   P.O. Box 204
  4. ;   E. Moriches, NY 11940
  5. ;   USA
  6. ;creutz@bnlux0.bnl.gov
  7. ;23 June 1990 
  8.  
  9. ;This program simulates the cellular automaton model presented
  10. ;by P. Bak, C. Tang, and K. Wiesenfeld (Phys. Rev. Lett. 59, 381 (1987);
  11. ;Phys. Rev. A38, 364 (1988)) to illustrate self organized criticality.
  12. ;Each site carries a positive integer representing the local slope of 
  13. ;a sandpile.  If the slope exceeds 3, the site is unstable and on
  14. ;updating it drops by 4, adding one to each of his neighbors.
  15. ;Sand is lost only at the edges.  Any state will relax to stability
  16. ;through such sand loss.
  17.  
  18. ;The colors representing slopes of 0 through 7 are white, black,
  19. ;red, green, yellow, blue, magenta, and cyan, respectively.
  20.  
  21. ;Various keypresses do as follows:
  22. ;     <esc>, q, or any control character exits
  23. ;     p     pauses; repeated presses single step; any other key restarts
  24. ;     d     doubles the lattice modulo 8
  25. ;     a     sets a flag to pause after each relaxation
  26.  
  27. ;The program can be run from either CLI or Workbench.  This code
  28. ;is completely self contained and will run directly through A68K 
  29. ;followed by BLink without need for any include files. 
  30.  
  31. ;The program directly accesses the blitter for speed, but does
  32. ;so in a mode friendly to multitasking.  To understand the program 
  33. ;details you should have the Amiga Hardware Reference Manual.  
  34.  
  35. ;Technically, the show proceeds as follows:
  36.  
  37. ;We start with ones on the borders and twos on the corners
  38. ;of a 288 by 188 lattice.  For the first loop, whenever a stable state 
  39. ;occurs, the heights are all doubled, and the system is allowed to 
  40. ;relax back to stability.  This eventually leads to a unique state 
  41. ;that when doubled relaxes to itself.  The system can be described 
  42. ;as a large Abelian group and this state represents the identity.
  43.  
  44. ;After the identity is found, the program proceeds to construct
  45. ;the inverse of the state with all cells unity.  After this is found it
  46. ;is tripled to give the inverse of the minimally stable state with all 
  47. ;cells being 3.
  48.  
  49. ;After all this, to keep the show going, the identity is 
  50. ;added to the system which then relaxes back to itself.  This loops
  51. ;until intervention.
  52.  
  53. ;If you hit 'd' on an active state early in the program, the search for
  54. ;the identity will be derailed and the program will go into a mode where
  55. ;the pattern is unlikely to repeat for the lifetime of the universe. 
  56. ;After a few hours, however, it will probably look uninterestingly random.
  57. ; ******************************************************
  58.  
  59. ; library offsets:
  60. _LVOOpenLibrary EQU -552
  61. _LVOCloseLibrary EQU -414 
  62. _LVOSetAPen EQU -342 
  63. _LVOSetBPen EQU -348 
  64. _LVOSetDrMd EQU -354 
  65. _LVOWritePixel EQU -324 
  66. _LVOMove EQU -240
  67. _LVODraw EQU -246
  68. _LVOText EQU -60
  69. _LVOClipBlit EQU -552 
  70. _LVOOpenScreen EQU -198 
  71. _LVOOpenWindow EQU -204 
  72. _LVOCloseScreen EQU -66 
  73. _LVOCloseWindow EQU -72
  74. _LVOGetMsg EQU -372 
  75. _LVOReplyMsg EQU -378 
  76. _LVOWaitPort EQU -384 
  77. _LVOLoadRGB4 EQU -192 
  78. _LVOOwnBlitter EQU -456 
  79. _LVODisownBlitter EQU -462 
  80. _LVOWaitBlit EQU -228 
  81. _LVOAllocMem EQU -198 
  82. _LVOFreeMem EQU -210 
  83. _LVOSetRast EQU -234
  84. _LVOFindTask EQU -294 
  85. _LVOForbid EQU -132 
  86.  
  87. ;IDCMP Flags 
  88. CLOSEWINDOW EQU $200
  89. VANILLAKEY  EQU $200000
  90. ; window flags
  91. WINDOWDRAG  EQU $2
  92. WINDOWDEPTH EQU $4      
  93. WINDOWCLOSE EQU $8
  94. BACKDROP    EQU $100 
  95. BORDERLESS  EQU $800
  96. ACTIVATE    EQU $1000
  97. ; various useful numbers
  98. MEMF_PUBLIC EQU 1
  99. MEMF_CHIP   EQU 2
  100. MEMF_FAST   EQU 4
  101. MEMB_CLEAR  EQU $10000
  102. pr_CLI      EQU 172
  103. pr_MsgPort  EQU 92
  104. AbsExecBase EQU $4
  105. JAM1        EQU 0
  106. JAM2        EQU 1
  107. COMPLEMENT  EQU 2
  108. INVERSID    EQU 3
  109.  
  110. ; custom chip register offsets
  111. _custom EQU $DFF000
  112. DMACONR EQU $002
  113. BLTCON0 EQU $040
  114. BLTCON1 EQU $042
  115. BLTAFWM EQU $044
  116. BLTALWM EQU $046
  117. BLTCPT  EQU $048
  118. BLTBPT  EQU $04C
  119. BLTAPT  EQU $050
  120. BLTDPT  EQU $054
  121. BLTSIZE EQU $058
  122. BLTCMOD EQU $060
  123. BLTBMOD EQU $062
  124. BLTAMOD EQU $064
  125. BLTDMOD EQU $066
  126. BLTCDAT EQU $070
  127. BLTBDAT EQU $072
  128. BLTADAT EQU $074
  129.  
  130. ; various size parameters
  131. xmin EQU 16  ; should be a multiple of 16
  132. ymin EQU 11  ; 11 or more to avoid border effects
  133. xmax EQU 303 ; -1+multiple of 16
  134. ymax EQU 198  
  135.  
  136. ; a small system for testing:
  137. ;xmin equ 48
  138. ;xmax equ 127
  139. ;ymin equ 50
  140. ;ymax equ 150  
  141.  
  142. startdisp EQU 2*(xmin/16)+ymin*40 ; shift from start of bitplane to lattice
  143. modulo    EQU 40-2*((xmax-xmin+1)/16) ; blitter modulo
  144. enddisp   EQU -modulo-2+((ymax-ymin+1)*40)      ; shift to end of lattice
  145. bsize     EQU 20-(modulo/2)+$40*(ymax-ymin+1)   ; for BLTSIZE
  146. workspacesize EQU 40*(ymax-ymin+1)
  147.  
  148.  ; startup code for CLI or Workbench
  149.  ; opens graphics and intuition libraries, calls 'Main' and exits
  150. startup:
  151.   movem.l d2-d7/a2-a6,-(a7) ; save registers
  152.   move.l AbsExecBase,a6     ; exec base pointer
  153.   clr.l workbenchmessage
  154.   suba.l a1,a1              ; clear a1
  155.   jsr _LVOFindTask(a6)      ; where is our task
  156.   move.l d0,a4
  157.   tst.l pr_CLI(a4)          ; are we running from CLI?
  158.   bne fromcli               ; if not then get workbench message
  159.   lea pr_MsgPort(a4),a0
  160.   jsr _LVOWaitPort(a6)
  161.   Jsr _LVOGetMsg(a6)
  162.   move.l d0,workbenchmessage ; save for exit
  163. ;open graphics and intuition libraries
  164. fromcli  lea GraphicsName(pc),a1  ; pointer to name of library
  165.     moveq #0,d0         ; accept any version
  166.     jsr _LVOOpenLibrary(a6)
  167.     move.l d0,GraphicsBase    ; save graphics base
  168.     tst.l d0
  169.     beq.s Exit1          ; quit if trouble opening library
  170.   lea IntuitionName(pc),a1  ; pointer to name of library
  171.     moveq #0,d0         ; accept any version
  172.     jsr _LVOOpenLibrary(a6)
  173.     move.l d0,IntuitionBase ; save intuition base
  174.     tst.l d0
  175.     beq.s Exit2          ; quit if trouble opening library
  176.  
  177. ; execute main program
  178.     bsr Main          
  179.  
  180. ;final cleanup
  181. Exit3: movea.l IntuitionBase,a1    ; intuition base
  182.        movea.l AbsExecBase,a6      ; exec base pointer
  183.        jsr _LVOCloseLibrary(a6)
  184. Exit2: movea.l GraphicsBase,a1     ; graphics base
  185.        jsr _LVOCloseLibrary(a6)
  186.        moveq.l #0,d0               ; return zero
  187. Exit1: tst.l workbenchmessage ; are we a workbench program?
  188.        beq.s Exit0            ; if not goto exit0
  189.          jsr _LVOForbid(a6)     ; because the RKM tells me so
  190.          movea.l workbenchmessage(pc),a1
  191.          jsr _LVOReplyMsg(a6)   ; reply to workbench message
  192. Exit0: movem.l (a7)+,d2-d7/a2-a6   ; restore registers
  193.        rts ; end of startup code
  194.  
  195. Main: move.l a7,oldstack ; save stack for exit
  196. ; allocate various working areas
  197.    moveq.l #7,d2 ; memory allocation loop counter
  198.    lea.l workingplane1(pc),a2
  199.    bra.s startalloc
  200. allocloop move.l #workspacesize,d0 ; size for working area
  201.           move.l #MEMF_CHIP+MEMB_CLEAR,d1  ;get chip memory 
  202.           jsr _LVOAllocMem(a6)
  203.           tst.l d0
  204.           beq quit1
  205.            move.l d0,(a2)+        
  206. startalloc dbf.s d2,allocloop
  207.  
  208. ; open screen and window
  209.      move.l IntuitionBase(pc),a6
  210.      lea myscreen(pc),a0
  211.      jsr _LVOOpenScreen(a6) ; open custom screen
  212.        move.l d0,screen     ; save screen structure pointer
  213.        beq quit1            ; quit if trouble
  214.      lea mywindow(pc),a0    ; open display window
  215.      jsr  _LVOOpenWindow(a6) 
  216.        move.l d0,window     ; save address of window structure
  217.        beq quit2            ;quit if trouble
  218.        movea.l d0,a0
  219.        move.l 86(a0),userport
  220.        movea.l 50(a0),a0 ; rastport
  221.        move.l a0,rastport
  222.        move.l 4(a0),a0 ; bitmap structure
  223.        move.l 8(a0),bitplane1
  224.        move.l 12(a0),bitplane2
  225.        move.l 16(a0),bitplane3
  226.        addi.l #startdisp,bitplane1
  227.        addi.l #startdisp,bitplane2
  228.        addi.l #startdisp,bitplane3
  229. ;set colors
  230.      movea.l GraphicsBase(pc),a6          ; graphics library address in a6
  231.      movea.l screen(pc),a0
  232.      adda.l #44,a0      ; viewport
  233.      lea.l colors(pc),a1
  234.      moveq.l #8,d0
  235.      jsr _LVOLoadRGB4(a6)   
  236. ; show credits
  237.      bsr credits      
  238. ;draw initial box of ones
  239.      movea.l rastport(pc),a1    
  240.      moveq.w #1,d0
  241.      jsr _LVOSetAPen(a6) ; set pen color
  242.        movea.l rastport(pc),a1    
  243.        moveq.w #JAM1,d0
  244.      jsr _LVOSetDrMd(a6) ; set drawing mode      
  245.        movea.l rastport(pc),a1    
  246.        move.w #xmin,d0
  247.        move.w #ymin,d1
  248.      jsr _LVOMove(a6) ; go to top left corner
  249.        movea.l rastport(pc),a0    
  250.        move.w #xmax,d0
  251.        move.w #ymin,d1
  252.      jsr _LVODraw(a6) ; draw top line
  253.        movea.l rastport(pc),a0    
  254.        move.w #xmax,d0
  255.        move.w #ymax,d1
  256.      jsr _LVODraw(a6) ; right side
  257.        movea.l rastport(pc),a0    
  258.        move.w #xmin,d0
  259.        move.w #ymax,d1
  260.      jsr _LVODraw(a6) ; bottom
  261.        movea.l rastport(pc),a0    
  262.        move.w #xmin,d0
  263.        move.w #ymin,d1
  264.      jsr _LVODraw(a6) ; left
  265. ;set corners to two
  266.        movea.l rastport(pc),a1    
  267.        moveq.w #2,d0
  268.      jsr _LVOSetAPen(a6) ; new color for corners
  269.        movea.l rastport(pc),a1    
  270.        move.w #xmin,d0
  271.        move.w #ymin,d1
  272.      jsr _LVOWritePixel(a6) ; nw corner
  273.        movea.l rastport(pc),a1    
  274.        move.w #xmax,d0
  275.        move.w #ymin,d1
  276.      jsr _LVOWritePixel(a6) ; ne corner
  277.        movea.l rastport(pc),a1    
  278.        move.w #xmax,d0
  279.        move.w #ymax,d1
  280.      jsr _LVOWritePixel(a6) ; se corner
  281.        movea.l rastport(pc),a1    
  282.        move.w #xmin,d0
  283.        move.w #ymax,d1
  284.      jsr _LVOWritePixel(a6) ; sw corner
  285.  
  286. ; showtime -- first double until identity found
  287. firstloop: bsr relax
  288.         lea.l storage1(pc),a0 ; prepare to compare with storage
  289.         lea.l bitplane1(pc),a1
  290.         bsr compare2  ; see if lattices equal
  291.         btst.b #5,control(pc)    
  292.         bne.s foundidentity
  293.          lea.l bitplane1(pc),a0
  294.          lea.l storage1(pc),a1
  295.          bsr copy2              ; copy bitplanes to storage
  296.          bsr double             ; double things 
  297.          bra.s firstloop
  298. ; save identity and set first storage plane to unity
  299. foundidentity:
  300.          lea.l bitplane1(pc),a0
  301.          lea.l identity1(pc),a1
  302.          bsr copy2
  303.          lea.l storage1(pc),a0
  304.          bsr set1 
  305. ; subtract first storage plane while adding identity 
  306.             bra.s stillactive
  307. secondloop: bsr sand
  308.             btst.b #5,control(pc) ; check if still active   
  309.             beq.s stillactive
  310.              lea.l identity1(pc),a0
  311.              lea.l bitplane1(pc),a1    
  312.              bsr addit 
  313. stillactive: bsr subtract1
  314.              btst.b #5,control(pc) ; check if more to subtract   
  315.              bne.s tripleit
  316.               bsr checkmessage 
  317.               bra.s secondloop
  318. ; triple to find inverse of minimally stable state
  319. tripleit bsr relax 
  320.          lea.l bitplane1(pc),a0
  321.          lea.l storage1(pc),a1
  322.          bsr copy2
  323.          bsr double 
  324.          bsr relax
  325.          lea.l storage1(pc),a0
  326.          lea.l bitplane1(pc),a1    
  327.          bsr addit
  328.          bsr relax
  329. ; to keep display moving, repeatedly add identity and relax
  330. finalloop lea.l identity1(pc),a0
  331.           lea.l bitplane1(pc),a1    
  332.           bsr addit
  333.           bsr relax
  334.           bra.s finalloop
  335.  
  336. ; time to quit
  337. getout:
  338.  ; close windows and screen 
  339.       movea.l window(pc),a0
  340.       move.l IntuitionBase(pc),a6
  341.       jsr _LVOCloseWindow(a6)
  342. quit2 movea.l screen(pc),a0
  343.       jsr _LVOCloseScreen(a6)
  344. ; deallocate memory
  345. quit1: movea.l AbsExecBase,a6
  346.        moveq.l #7,d2 ; memory deallocation loop counter
  347.        lea.l workingplane1(pc),a2
  348.        bra.s startdealloc
  349. deallocloop  move.l #workspacesize,d0 ; size for working area
  350.              movea.l (a2)+,a1
  351.              move.l a1,d1        ; to test if not zero
  352.              beq.s done 
  353.              jsr _LVOFreeMem(a6) ; return memory
  354. startdealloc dbf.s d2,deallocloop
  355. done movea.l oldstack(pc),a7   ; reset stack pointer
  356.      rts ; all done
  357.  
  358. ; subroutine to update lattice until relaxed
  359. relax: bsr sand
  360.        btst.b #5,control(pc) ; check if still active   
  361.        bne.s relaxed
  362.         bsr checkmessage 
  363.         bra.s relax
  364. relaxed: tst.w autopause   ; should we pause
  365.          beq.s autooff    
  366.           bsr waitformessage
  367. autooff  rts      
  368.  
  369. ; message handling subroutine
  370. ; message location returned in d0, class in d2, code in d3 
  371. ; with VANILLAKEY code is ascii of pressed key 
  372. waitformessage:  ; pause for a signal
  373.       movea.l AbsExecBase,a6  
  374.       movea.l userport(pc),a0
  375.       jsr _LVOWaitPort(a6)   ; wait for a message
  376. checkmessage:   ; enter here to not wait if no message        
  377.       movea.l AbsExecBase,a6
  378.       movea.l userport(pc),a0
  379.       jsr _LVOGetMsg(a6)
  380.        tst.l d0
  381.        bne.s messagefound
  382.         rts
  383. messagefound:
  384.        movea.l d0,a1       
  385.        move.l 20(a1),d2    ; save class in d2
  386.        move.w 24(a1),d3    ; and code in d3
  387.       jsr _LVOReplyMsg(a6) ; reply to message
  388. ; check for various keypresses
  389.       cmpi.w #27,d3 ; esc
  390.        ble getout ; leave for escape or control characters
  391.       cmpi.w #'q',d3
  392.        beq getout ; quit for q
  393.       cmpi.w #'p',d3 ; p ; pause for p
  394.        bne.s not_p        
  395.         movea.l userport(pc),a0
  396.         jsr _LVOWaitPort(a6)   ; wait for a message
  397. not_p cmpi.w #'d',d3 ; d
  398.        bne.s not_d ; double for d
  399.         bsr double
  400. not_d cmpi.w #'a',d3 ; a
  401.        bne.s not_a
  402.         not.w autopause ; flip autopausing flag
  403. not_a rts  ; continue
  404.  
  405. ; storage area         
  406. ; window and screen parameters
  407. mywindow dc.w 0,0,320,200     ; xmin,ymin,xsize,ysize
  408.          dc.b 0,0             ; detail pen, block pen
  409.            ; (Intuition Direct Communication Message Port)
  410.          dc.l VANILLAKEY      ; IDCMP Flags, ask for keypresses 
  411.          dc.l ACTIVATE+BORDERLESS ;+BACKDROP ; flags (type in amigabasic)
  412.          dc.l 0               ; gadgets  
  413.          dc.l 0               ; checkmark
  414.          dc.l title           ; my title
  415. screen   dc.l 0               ;location of screen, fill later
  416.          dc.l 0               ;bitmap
  417.          dc.w 0,0,320,200     ;min-max window size
  418.          dc.w $f              ; type: 1=wbenchscreen $F=customscreen
  419. myscreen dc.w 0,0,320,200 ;size
  420.          dc.w 3           ;depth
  421.          dc.b 5,6         ;pens
  422.          dc.w $0          ;viewmodes- interlace=4, hires=$8000 
  423.                           ; sprites=$4000, ham=$800, extra_halfbrite=$80
  424.          dc.w $f          ;type: customscreen
  425.          dc.l textattr    ;font
  426.          dc.l title       ;title
  427.          dc.l 0           ;gadgets    
  428.          dc.l 0           ;custombitmap
  429. textattr dc.l fontname
  430.          dc.w 8   ;fontsize
  431.          dc.b 0,0    ;style and flags
  432. colors dc.w $fff ; color table
  433.        dc.w $000 
  434.        dc.w $f00
  435.        dc.w $0f0
  436.        dc.w $ff0
  437.        dc.w $00f
  438.        dc.w $f0f
  439.        dc.w $0ff
  440.  
  441. workbenchmessage dc.l 0
  442. GraphicsBase     dc.l 0
  443. IntuitionBase    dc.l 0
  444. GraphicsName     dc.b 'graphics.library',0
  445. IntuitionName    dc.b 'intuition.library',0 
  446. title            dc.b 'BlitterSand -- <esc> to exit',0
  447. fontname         dc.b 'topaz.font',0
  448. window           dc.l 0
  449. rastport         dc.l 0
  450. userport         dc.l 0
  451. bitplane1        dc.l 0
  452. bitplane2        dc.l 0
  453. bitplane3        dc.l 0
  454. workingplane1    dc.l 0
  455. workingplane2    dc.l 0
  456. workingplane3    dc.l 0
  457. storage1         dc.l 0
  458. storage2         dc.l 0
  459. identity1        dc.l 0
  460. identity2        dc.l 0
  461. control          dc.w 0
  462. autopause        dc.w 0
  463. oldstack         dc.l 0
  464.  
  465. ; primary updating routine
  466. sand: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  467.      jsr _LVOOwnBlitter(a6)      ; grab blitter for my use  
  468.      lea _custom,a5
  469.      move.l bitplane1(pc),d2     ;start of bitplane1
  470.      move.l bitplane2(pc),d3     ;start of bitplane2
  471.      move.l bitplane3(pc),d4     ;start of bitplane3
  472.      move.l workingplane1(pc),d5 ; start of working plane 1
  473.      move.l workingplane2(pc),d6 ; start of working plane 2
  474.      move.l workingplane3(pc),d7 ; start of working plane 3
  475.  ; add left, top, and bottom neighbors to workspace
  476.  ; work on first bit: 
  477.      jsr _LVOWaitBlit(a6)
  478.       move.l d5,BLTDPT(a5) ; first workspace plane
  479.       move.l d4,d0 
  480.       move.l d0,BLTAPT(a5) ; for left neighbor
  481.       addi.l #40,d0
  482.       move.l d0,BLTBPT(a5) ; for bottom neighbor
  483.       subi.l #80,d0
  484.       move.l d0,BLTCPT(a5) ; for top
  485.       move.w #0,BLTCON1(a5)
  486.       move.w #$1f96,BLTCON0(a5) ; odd number of source bits set
  487.       move.w #modulo,BLTAMOD(a5)     ; set up modulos
  488.       move.w #modulo,BLTBMOD(a5)
  489.       move.w #modulo,BLTCMOD(a5)
  490.       move.w #modulo,BLTDMOD(a5)
  491.       move.w #$ffff,BLTAFWM(a5)
  492.       move.w #$fffe,BLTALWM(a5) ; mask out last bit of row
  493.       move.w #bsize,BLTSIZE(a5) ; do it
  494.  ; second bit
  495.      jsr _LVOWaitBlit(a6)
  496.       move.l d6,BLTDPT(a5) ; second plane of workspace 
  497.       move.l d4,d0
  498.       move.l d0,BLTAPT(a5) ; reset bitplane pointers
  499.       addi.l #40,d0
  500.       move.l d0,BLTBPT(a5)
  501.       subi.l #80,d0
  502.       move.l d0,BLTCPT(a5)
  503.       move.w #$1fe8,BLTCON0(a5) ; 2 or more source bits set
  504.       move.w #bsize,BLTSIZE(a5) ; go to it
  505. ; add in fourth neighbor, third bit of result
  506.      jsr _LVOWaitBlit(a6)
  507.       move.l d4,d0
  508.       addi.l #enddisp,d0 
  509.       move.l d0,BLTAPT(a5) ; end of lattice
  510.       move.l d7,d0
  511.       addi.l #enddisp,d0
  512.       move.l d0,BLTDPT(a5) ; end of third plane of workspace
  513.       move.l d5,d0
  514.       addi.l #enddisp,d0
  515.       move.l d0,BLTBPT(a5) ; first workspace plane
  516.       move.l d6,d0
  517.       addi.l #enddisp,d0   ; second workspace plane
  518.       move.l d0,BLTCPT(a5)
  519.       move.w #2,BLTCON1(a5) ; descending mode
  520.       move.w #$1f80,BLTCON0(a5) ; third bit only if all already set
  521.       move.w #$7fff,BLTALWM(a5)
  522.       move.w #bsize,BLTSIZE(a5) ; OK
  523. ; add in fourth neighbor, second bit of result
  524.      jsr _LVOWaitBlit(a6)
  525.       move.l d4,d0
  526.       addi.l #enddisp,d0
  527.       move.l d0,BLTAPT(a5)
  528.       move.l d6,d0
  529.       addi.l #enddisp,d0
  530.       move.l d0,BLTDPT(a5)
  531.       move.l d0,BLTCPT(a5)
  532.       move.l d5,d0
  533.       addi.l #enddisp,d0
  534.       move.l d0,BLTBPT(a5)
  535.       move.w #$1f6a,BLTCON0(a5) ; second bit only if appropriate
  536.       move.w #bsize,BLTSIZE(a5) ; here we go again
  537. ; add in fourth neighbor, first bit of result
  538.      jsr _LVOWaitBlit(a6)
  539.       move.l d4,d0
  540.       addi.l #enddisp,d0
  541.       move.l d0,BLTAPT(a5)
  542.       move.l d5,d0
  543.       addi.l #enddisp,d0
  544.       move.l d0,BLTDPT(a5)
  545.       move.l d0,BLTBPT(a5)
  546.       move.w #$1d3c,BLTCON0(a5) ; second bit from a xor b
  547.       move.w #bsize,BLTSIZE(a5) ; finish setting up workspace
  548. ; add it all up
  549.      jsr _LVOWaitBlit(a6) ; 2w,3w,2b to 3b
  550.       move.l d4,BLTDPT(a5)
  551.       move.l d3,BLTAPT(a5)
  552.       move.l d6,BLTBPT(a5)
  553.       move.l d7,BLTCPT(a5)  
  554.       move.w #0,BLTCON1(a5) ; reset for ascending mode
  555.       move.w #$0fea,BLTCON0(a5) 
  556.       move.w #$ffff,BLTALWM(a5) ; fix last word mask
  557.       move.w #bsize,BLTSIZE(a5)
  558.      jsr _LVOWaitBlit(a6) ; 2w,2b to 2b
  559.       move.l d3,BLTDPT(a5)
  560.       move.l d3,BLTAPT(a5)
  561.       move.l d6,BLTBPT(a5)
  562.       move.w #$0d3c,BLTCON0(a5) 
  563.       move.w #bsize,BLTSIZE(a5)
  564.      jsr _LVOWaitBlit(a6) ; 1w,1b,2b to 3w for carry
  565.       move.l d7,BLTDPT(a5)
  566.       move.l d2,BLTAPT(a5)
  567.       move.l d3,BLTBPT(a5)
  568.       move.l d5,BLTCPT(a5) 
  569.       move.w #$0f80,BLTCON0(a5) 
  570.       move.w #bsize,BLTSIZE(a5)
  571.      jsr _LVOWaitBlit(a6) ; 1w, 1b to 2b
  572.       move.l d3,BLTDPT(a5)
  573.       move.l d2,BLTAPT(a5)
  574.       move.l d5,BLTBPT(a5)
  575.       move.l d3,BLTCPT(a5) 
  576.       move.w #$0f6a,BLTCON0(a5) 
  577.       move.w #bsize,BLTSIZE(a5)
  578.      jsr _LVOWaitBlit(a6) ; final carry
  579.       move.l d4,BLTDPT(a5)
  580.       move.l d4,BLTAPT(a5)
  581.       move.l d7,BLTBPT(a5)
  582.       move.w #$0dfc,BLTCON0(a5) 
  583.       move.w #bsize,BLTSIZE(a5)
  584.      jsr _LVOWaitBlit(a6) ; 1w, 1b to 1b
  585.       move.w DMACONR(a5),control ; save control register for later
  586.       move.l d2,BLTDPT(a5)
  587.       move.l d2,BLTAPT(a5)
  588.       move.l d5,BLTBPT(a5)
  589.       move.w #$0d3c,BLTCON0(a5) 
  590.       move.w #bsize,BLTSIZE(a5)
  591.    jsr _LVODisownBlitter(a6) ; I'm done for now
  592.      rts
  593.  
  594. ; double main lattice
  595. double: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  596.     jsr _LVOOwnBlitter(a6)  
  597.      lea _custom,a5
  598.      move.l bitplane1(pc),d2 ;start of bitplane1
  599.      move.l bitplane2(pc),d3 ;start of bitplane2
  600.      move.l bitplane3(pc),d4 ;start of bitplane3
  601. ; shift up all bitplanes
  602.      jsr _LVOWaitBlit(a6)
  603.       move.l d4,BLTDPT(a5) ; copy to plane 3
  604.       move.l d3,BLTAPT(a5) ; from plane 2
  605.       move.w #0,BLTCON1(a5)
  606.       move.w #$09f0,BLTCON0(a5)
  607.       move.w #modulo,BLTAMOD(a5)
  608.       move.w #modulo,BLTBMOD(a5)
  609.       move.w #modulo,BLTCMOD(a5)
  610.       move.w #modulo,BLTDMOD(a5)
  611.       move.w #$ffff,BLTAFWM(a5)
  612.       move.w #$ffff,BLTALWM(a5)
  613.       move.w #bsize,BLTSIZE(a5)
  614.      jsr _LVOWaitBlit(a6)
  615.       move.l d3,BLTDPT(a5) ; copy to plane 2
  616.       move.l d2,BLTAPT(a5) ; from plane 1
  617.       move.w #$09f0,BLTCON0(a5) 
  618.       move.w #bsize,BLTSIZE(a5)
  619.      jsr _LVOWaitBlit(a6)
  620.       move.l d2,BLTDPT(a5) ; clear plane 1
  621.       move.w #$0100,BLTCON0(a5)
  622.       move.w #bsize,BLTSIZE(a5)
  623.      jsr _LVODisownBlitter(a6) ; give it back
  624.      rts
  625.  
  626. compare2 ; compare two planes, pointed to by (a0) and (a1)
  627.     movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  628.      lea _custom,a5
  629.      move.l (a0)+,d2 ;start of bitplane1
  630.      move.l (a0),d3 ;start of bitplane2
  631.      move.l (a1)+,d4 ;start of comparison bitplane1
  632.      move.l (a1),d5 ;start of comparison bitplane2
  633.     jsr _LVOOwnBlitter(a6)  ; get blitter
  634.      jsr _LVOWaitBlit(a6)
  635.       move.l d2,BLTAPT(a5) ; plane 1
  636.       move.l d4,BLTBPT(a5) ; compare 1
  637.       move.w #0,BLTCON1(a5)
  638.       move.w #$0c3c,BLTCON0(a5)
  639.       move.w #modulo,BLTAMOD(a5)
  640.       move.w #modulo,BLTBMOD(a5)
  641.       move.w #$ffff,BLTAFWM(a5)
  642.       move.w #$ffff,BLTALWM(a5)
  643.       move.w #bsize,BLTSIZE(a5)
  644.      jsr _LVOWaitBlit(a6)
  645.       move.w DMACONR(a5),control ; save control register for later
  646.       move.l d3,BLTAPT(a5) ; plane 2
  647.       move.l d5,BLTBPT(a5) ; compare 2
  648.       move.w #0,BLTCON1(a5)
  649.       move.w #$0c3c,BLTCON0(a5)
  650.       move.w #bsize,BLTSIZE(a5)
  651.      jsr _LVOWaitBlit(a6)
  652.       move.w DMACONR(a5),d0
  653.       and.w d0,control ; save control register for later
  654.      jsr _LVODisownBlitter(a6) ; give it back
  655.      rts
  656.  
  657. copy2 ; copy two planes, pointed to by (a0) and (a1)
  658.     movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  659.      lea _custom,a5
  660.      move.l (a0)+,d2 ;start of bitplane1
  661.      move.l (a0),d3 ;start of bitplane2
  662.      move.l (a1)+,d4 ;start of copy bitplane1
  663.      move.l (a1),d5 ;start of copy bitplane2
  664.     jsr _LVOOwnBlitter(a6)  ; prepare blitter
  665.      jsr _LVOWaitBlit(a6)
  666.       move.l d2,BLTAPT(a5) ; plane 1
  667.       move.l d4,BLTDPT(a5) ; copy 1
  668.       move.w #0,BLTCON1(a5)
  669.       move.w #$09f0,BLTCON0(a5) ; straight copy
  670.       move.w #modulo,BLTAMOD(a5)
  671.       move.w #modulo,BLTDMOD(a5)
  672.       move.w #$ffff,BLTAFWM(a5)
  673.       move.w #$ffff,BLTALWM(a5)
  674.       move.w #bsize,BLTSIZE(a5)
  675.      jsr _LVOWaitBlit(a6)
  676.       move.l d3,BLTAPT(a5) ; plane 2
  677.       move.l d5,BLTDPT(a5) ; copy 2
  678.       move.w #0,BLTCON1(a5)
  679.       move.w #$09f0,BLTCON0(a5)
  680.       move.w #bsize,BLTSIZE(a5)
  681.      jsr _LVODisownBlitter(a6) ; give it back
  682.      rts
  683.  
  684. set1: ; set one plane to unity, pointed to by (a0)
  685.     movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  686.      lea _custom,a5
  687.      move.l (a0),d2 ;start of plane
  688.     jsr _LVOOwnBlitter(a6)  ; get blitter
  689.      jsr _LVOWaitBlit(a6)
  690.       move.l d2,BLTDPT(a5) ; plane 1
  691.       move.w #0,BLTCON1(a5)
  692.       move.w #$01ff,BLTCON0(a5) ; straight set
  693.       move.w #modulo,BLTDMOD(a5)
  694.       move.w #bsize,BLTSIZE(a5)
  695.      jsr _LVODisownBlitter(a6) ; give it back
  696.      rts
  697.  
  698. ; subtract storage1 from nonzero lattice sites
  699. subtract1: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  700.     jsr _LVOOwnBlitter(a6)
  701.      lea _custom,a5
  702.      move.l bitplane1(pc),d2 ;start of bitplane1
  703.      move.l bitplane2(pc),d3 ;start of bitplane2
  704.      move.l workingplane1(pc),d5 ; start of working plane 1
  705.      move.l workingplane2(pc),d6 ; start of working plane 2
  706.      move.l storage1(pc),d7
  707.      jsr _LVOWaitBlit(a6)
  708.       move.l d5,BLTDPT(a5) ; new first plane to working plane
  709.       move.l d2,BLTAPT(a5) ; old first plane
  710.       move.l d3,BLTBPT(a5) ; old second plane
  711.       move.l d7,BLTCPT(a5) ; subtracting plane
  712.       move.w #0,BLTCON1(a5)
  713.       move.w #$0f58,BLTCON0(a5)
  714.       move.w #modulo,BLTAMOD(a5)
  715.       move.w #modulo,BLTBMOD(a5)
  716.       move.w #modulo,BLTCMOD(a5)
  717.       move.w #modulo,BLTDMOD(a5)
  718.       move.w #$ffff,BLTAFWM(a5)
  719.       move.w #$ffff,BLTALWM(a5)
  720.       move.w #bsize,BLTSIZE(a5)
  721.      jsr _LVOWaitBlit(a6)
  722.       move.l d6,BLTDPT(a5) ; new second plane to working plane
  723.       move.l d2,BLTAPT(a5) ; old first plane
  724.       move.l d3,BLTBPT(a5) ; old second plane
  725.       move.l d7,BLTCPT(a5) ; subtracting plane
  726.       move.w #0,BLTCON1(a5)
  727.       move.w #$0fc4,BLTCON0(a5)
  728.       move.w #bsize,BLTSIZE(a5)
  729.      jsr _LVOWaitBlit(a6)
  730.       move.l d7,BLTDPT(a5) ; new subtracting plane to storage
  731.       move.l d2,BLTAPT(a5) ; old first plane
  732.       move.l d3,BLTBPT(a5) ; old second plane
  733.       move.l d7,BLTCPT(a5) ; subtracting plane
  734.       move.w #0,BLTCON1(a5)
  735.       move.w #$0f02,BLTCON0(a5)
  736.       move.w #bsize,BLTSIZE(a5)
  737.      jsr _LVOWaitBlit(a6)
  738.       move.w DMACONR(a5),control ; save control register for later
  739.       move.l d5,BLTAPT(a5) ; new plane 1
  740.       move.l d2,BLTDPT(a5) ; copy back
  741.       move.w #0,BLTCON1(a5)
  742.       move.w #$09f0,BLTCON0(a5) ; straight copy
  743.       move.w #bsize,BLTSIZE(a5)
  744.      jsr _LVOWaitBlit(a6)
  745.       move.l d6,BLTAPT(a5) ; new plane 2
  746.       move.l d3,BLTDPT(a5) ; copy back
  747.       move.w #0,BLTCON1(a5)
  748.       move.w #$09f0,BLTCON0(a5)
  749.       move.w #bsize,BLTSIZE(a5)
  750.     jsr _LVODisownBlitter(a6) ; give it back
  751.      rts
  752.  
  753. ; add two lattices, source pointed at by (a0) and dest by (a1)
  754. addit: movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  755.      lea _custom,a5
  756.      move.l (a1)+,d2 ;start of bitplane1
  757.      move.l (a1)+,d3 ;start of bitplane2
  758.      move.l (a1),d4  ;start of bitplane3
  759.      move.l (a0)+,d5 ;start of adding plane1
  760.      move.l (a0),d6  ;start of adding plane2
  761.     jsr _LVOOwnBlitter(a6) ; prepare to add identity to lattice
  762.      move.l workingplane3(pc),d7 ; for carry
  763.     jsr _LVOWaitBlit(a6)
  764.       move.l d7,BLTDPT(a5) ; carry
  765.       move.l d2,BLTAPT(a5) ; old first plane
  766.       move.l d5,BLTBPT(a5) ; identity1
  767.       move.w #0,BLTCON1(a5)
  768.       move.w #$0dc0,BLTCON0(a5)
  769.       move.w #modulo,BLTAMOD(a5)
  770.       move.w #modulo,BLTBMOD(a5)
  771.       move.w #modulo,BLTCMOD(a5)
  772.       move.w #modulo,BLTDMOD(a5)
  773.       move.w #$ffff,BLTAFWM(a5)
  774.       move.w #$ffff,BLTALWM(a5)
  775.       move.w #bsize,BLTSIZE(a5)
  776.     jsr _LVOWaitBlit(a6)
  777.       move.l d2,BLTDPT(a5) ; new first plane (assume old=0)
  778.       move.l d2,BLTAPT(a5) ; old first plane
  779.       move.l d5,BLTBPT(a5) ; identity1
  780.       move.w #0,BLTCON1(a5)
  781.       move.w #$0d3c,BLTCON0(a5)
  782.       move.w #bsize,BLTSIZE(a5)
  783.     jsr _LVOWaitBlit(a6)
  784.       move.l d4,BLTDPT(a5) ; new third bit
  785.       move.l d3,BLTAPT(a5) ; old second plane
  786.       move.l d6,BLTBPT(a5) ; identity2
  787.       move.l d7,BLTCPT(a5) ; old carry
  788.       move.w #0,BLTCON1(a5)
  789.       move.w #$0fe8,BLTCON0(a5)
  790.       move.w #bsize,BLTSIZE(a5)
  791.     jsr _LVOWaitBlit(a6)
  792.       move.l d3,BLTDPT(a5) ; new second bit
  793.       move.l d3,BLTAPT(a5) ; old second plane
  794.       move.l d6,BLTBPT(a5) ; identity2
  795.       move.l d7,BLTCPT(a5) ; old carry
  796.       move.w #0,BLTCON1(a5)
  797.       move.w #$0f96,BLTCON0(a5)
  798.       move.w #bsize,BLTSIZE(a5)
  799.     jsr _LVODisownBlitter(a6) ; give it back
  800.     rts
  801.  
  802. credits: ; display introductory comments    
  803.     moveq.l #30,d2 ; length of lines
  804.     moveq.l #15,d3  ; number of lines
  805.     moveq.l #25,d4 ; starting row
  806.     movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  807.     lea.l mytext(pc),a3 ; start of text information
  808.       movea.l rastport(pc),a1    
  809.       moveq.w #7,d0
  810.     jsr _LVOSetBPen(a6) ; set background pen color
  811.       movea.l rastport(pc),a1    
  812.       moveq.w #JAM2,d0
  813.     jsr _LVOSetDrMd(a6) ; set drawing mode      
  814.     bra startprint 
  815. myprint:   movea.l rastport(pc),a1 ; rastport
  816.            move.l d4,d1  ; starting row
  817.            moveq.l #40,d0 ; starting column
  818.          jsr _LVOMove(a6) ; locate pen
  819.            movea.l rastport(pc),a1 ; rastport
  820.            move.b (a3)+,d0 ; get color
  821.            andi.l #7,d0 ; make sure color valid 
  822.          jsr _LVOSetAPen(a6) ; set color
  823.            movea.l rastport(pc),a1 ; rastport
  824.            movea.l a3,a0 ; text location
  825.            move.l d2,d0  ; length of line
  826.          jsr _LVOText(a6) ; print line
  827.          adda.l d2,a3 ; next line
  828.          addi.l #8,d4 ; next row 
  829. startprint: dbf d3,myprint      
  830.      bsr waitformessage ; wait for key press
  831.      movea.l GraphicsBase(pc),a6 ; graphics library address in a6
  832.        movea.l rastport(pc),a1
  833.        moveq.l #0,d0
  834.      jsr _LVOSetRast(a6) ; clear screen
  835.     rts
  836. mytext: ; initial number represents color
  837.   dc.b 2,'                              '
  838.   dc.b 2,'         BlitterSand          '
  839.   dc.b 2,'                              '
  840.   dc.b 6,'             by               '
  841.   dc.b 2,'                              '
  842.   dc.b 5,'        Michael Creutz        '
  843.   dc.b 6,'     creutz@bnlux0.bnl.gov    '
  844.   dc.b 5,'                              '
  845.   dc.b 5,'<esc>, q  exit                '
  846.   dc.b 5,'  p       pause               '
  847.   dc.b 5,'  d       double modulo 8     '
  848.   dc.b 5,'  a       pause after relax   '
  849.   dc.b 1,'                              '
  850.   dc.b 1,'    Press any key to start    '
  851.   dc.b 2,'                              '
  852.    end
  853.