[comp.sources.amiga] cells.bas--A cellular automaton program in BASIC.

ahh@j.cc.purdue.edu (Brent L. Woods) (02/27/88)

Program Name:  cells.bas
Submitted By:  bnl!creutz@sbcs (michael creutz)
Summary:  A cellular automaton program like life.
Poster Boy:  Brent Woods  (ahh@j.cc.purdue.edu)
Tested.

NOTES:



Brent Woods, Co-Moderator, comp.{sources,binaries}.amiga

USENET:  ...!j.cc.purdue.edu!ahh     ARPANET:  ahh@j.cc.purdue.edu
BITNET:  PODUM@PURCCVM               PHONE:  +1 (317) 743-8421
USNAIL:  320 Brown St., #406  /  West Lafayette, IN  47906

================================================================

'
'
'    This AmigaBASIC program uses screen GET and PUT functions to 
' efficiently demonstrate Fredkin's addition modulo 2  cellular 
' automaton rule.  It runs considerably faster with nofastmem toggled.
' The framework can be easily generalized to other rules.  If anyone
' is interested, I have versions implementing Conway's life as well
' as a microcanonical Ising model.
'
'                  Michael Creutz
'                  creutz@bnlvma.bitnet
'                  creutz@bnl.arpa

DEFINT a-z
'size parameters
depth=2
xm=1      : ym=1
sx=300    : sy=185
xms=xm+sx : yms=ym+sy 
dimlat=3+depth*(sy+1)*INT((sx+16)/16)
DIM lat(dimlat)
DIM xnbr(4)
  xnbr(0)=xm   : ynbr(0)=ym       ' the neighbors of (xm,ym)
  xnbr(1)=xm+1 : ynbr(1)=ym
  xnbr(2)=xm   : ynbr(2)=ym+1
  xnbr(3)=xm-1 : ynbr(3)=ym 
  xnbr(4)=xm   : ynbr(4)=ym-1
       
SCREEN 1,320,200,depth,1
  WINDOW 2,"working window",,31,1
  WINDOW 3,"mod2",,31,1

' starting image; successive bit planes show older images 
' (try other initial pictures)
  size=30
  xmid=xm+sx/2 : ymid=ym+sy/2
  FOR m=1 TO depth
    CLS
    LINE (xmid-size,ymid-size)-(xmid+size,ymid+size),2^(m-1),bf
    GET (xm,ym)-(xms,yms),lat
    WINDOW OUTPUT 2
    PUT (xm,ym),lat,XOR
    GET (xm,ym)-(xms,yms),lat
    GOSUB mod2
  NEXT m

WHILE 1 : GOSUB mod2 :WEND    ' main loop

mod2:    ' XOR each site with its neighbors
  WINDOW OUTPUT 2
  FOR n=1 TO 4
    PUT (xnbr(n),ynbr(n)),lat
  NEXT n
  GOSUB periodic
  GET (xm,ym)-(xms,yms),lat
  WINDOW OUTPUT 3
  PUT (xm,ym),lat,PSET
RETURN

periodic:                        ' make lattice periodic
GET (xm+1,ym)-(xm+1,yms),lat     ' two rows at end repeated
PUT (xms,ym),lat,PSET           
GET (xms-1,ym)-(xms-1,yms),lat
PUT (xm,ym),lat,PSET
GET (xm,ym+1)-(xms,ym+1),lat
PUT (xm,yms),lat,PSET
GET (xm,yms-1)-(xms,yms-1),lat
PUT (xm,ym),lat,PSET
RETURN