Merry Christmas (snowflake growth simulator)

[Jolly_Roger]

Merry Christmas to everyone.

This is a programme that simulates snowflake crystal growth that I write with IBasic Pro last Christmas.

Code Select Expand


'Snowflake growth simulator
'Jolly Roger Dec 2005
'A simple implementation of the method found here: http://ww2.lafayette.edu/~reiterc/mvp/sfn/sfn_pp.pdf (1.2MB)
AUTODEFINE "OFF"
DEF win:WINDOW
CONST size=140:'Sets size of growing area.Snowflake size will be 40 less than this
DEF run,sitereceptive,x,y,iterations,neighbouringsite:INT
DEF sitebeenplotted[size,size]:INT
DEF sitevalue[size,size],receptivesitevalue[size,size],nonreceptivesitevalue[size,size]:FLOAT
DEF influx,background,newnonreceptivesitevalue[size,size],diffusion,d:FLOAT
DEF maxvalue,mult:FLOAT
DEF ymin,drawing,colour:INT
DEF dy[6]:INT
DEF dx[6,2],rowtype:INT
'Set offsets from site to six neighbouring sites
dx[0,0]=-1,0,-1,1,-1,0:'x offset when y is even
dx[0,1]=0,1,-1,1,0,1:'x offset when y is odd
dy=-1,-1,0,0,1,1
DEF hdc:INT

OPENWINDOW win,0,0,640,480,@MINBOX,0,"Snowflake growth simulator.Press spacebar",&mainwindow
SETWINDOWCOLOR win,RGB(150,150,255)

run = 1
WAITUNTIL run=0
CLOSEWINDOW win
END



SUB mainwindow
SELECT @class
ÂÃ,  ÂÃ, CASE @IDCLOSEWINDOW
run=0
ÂÃ,  ÂÃ, CASE @IDCHAR
IF @CODE = ASC("Q")| @CODE=ASC("q") THEN run = 0
ÂÃ,  ÂÃ,  IF @CODE=32
ÂÃ,  ÂÃ,  ÂÃ,  'Spacebar pressed
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, IF drawing=0 THEN GOSUB drawsnowflake
ÂÃ,  ÂÃ,  ENDIF
ENDSELECT
RETURN
ENDSUB



SUB drawsnowflake
ÂÃ,  SETCAPTION win,"Snowflake growth simulator"
ÂÃ,  drawing=1
'Clear screen
ÂÃ,  RECT win,0,0,640,480,RGB(150,150,255),RGB(150,150,255)
ÂÃ,  'Initialise variables
ÂÃ,  influx=.005+RND(.015):'Amount added to receptive sites each iteration
ÂÃ,  background=.5+RND(.4):'Initial value for sites
ÂÃ,  'NB diffusion 0 to 1/7
ÂÃ,  diffusion=1f/14+RND(1f/14):'Rate at which neighbouring nonreceptive sites average themselves out
ÂÃ,  iterations=0:ymin=10000
ÂÃ,  maxvalue=1
ÂÃ,  d=1-diffusion*6
ÂÃ,  FOR x=0 TO size-1
ÂÃ,  ÂÃ,  FOR y=0 TO size-1
ÂÃ,  ÂÃ,  ÂÃ, sitevalue[x,y]=background
ÂÃ,  ÂÃ,  ÂÃ, sitebeenplotted[x,y]=0
ÂÃ,  ÂÃ,  NEXT y
ÂÃ,  NEXT x
ÂÃ,  'Start with one ice crystal at middle of area
ÂÃ,  sitevalue[size/2,size/2]=1
ÂÃ,  'Main loop
ÂÃ,  DO
ÂÃ,  ÂÃ,  ÂÃ,  'Find receptive sites (sites which are ice (sitevalue>=1) or next to ice)
ÂÃ,  ÂÃ,  ÂÃ,  FOR y=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  rowtype=y&1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  FOR x=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  IF sitevalue[x,y]>=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  'Site is ice
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  sitereceptive=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ELSE
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  sitereceptive=0
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  FOR neighbouringsite=0 TO 5
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, IF sitevalue[x+dx[neighbouringsite,rowtype],y+dy[neighbouringsite]]>=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  'Neighbouring site is ice
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  neighbouringsite=5
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  sitereceptive=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, ENDIF
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  NEXT neighbouringsite
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ENDIF
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  'Set receptive and nonreceptive values for site
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  IF sitereceptive=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  receptivesitevalue[x,y]=sitevalue[x,y]+influx
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  nonreceptivesitevalue[x,y]=0
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ELSE
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  receptivesitevalue[x,y]=0
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  nonreceptivesitevalue[x,y]=sitevalue[x,y]
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ENDIF
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  NEXT x
ÂÃ,  ÂÃ,  ÂÃ,  NEXT y

ÂÃ,  ÂÃ,  ÂÃ,  'Average non receptive values with non receptive values for neighbours
ÂÃ,  ÂÃ,  ÂÃ,  FOR y=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  rowtype=y&1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  FOR x=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, newnonreceptivesitevalue[x,y]=nonreceptivesitevalue[x,y]*d
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, FOR neighbouringsite=0 TO 5
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, newnonreceptivesitevalue[x,y]=newnonreceptivesitevalue[x,y]+nonreceptivesitevalue[x+dx[neighbouringsite,rowtype],y+dy[neighbouringsite]]*diffusion
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, NEXT neighbouringsite
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  NEXT x
ÂÃ,  ÂÃ,  ÂÃ,  NEXT y

ÂÃ,  ÂÃ,  ÂÃ,  'Calculate new value for each site and plot any that are ice
ÂÃ,  ÂÃ,  ÂÃ,  'Draw without shading as much faster
ÂÃ,  ÂÃ,  ÂÃ,  hdc=GETHDC(win)
ÂÃ,  ÂÃ,  ÂÃ,  FOR y=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  FOR x=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  sitevalue[x,y]=receptivesitevalue[x,y]+newnonreceptivesitevalue[x,y]
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  IF sitevalue[x,y]>maxvalue THEN maxvalue=sitevalue[x,y]
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  'Draw ice sites
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  IF sitevalue[x,y]>=1 & sitebeenplotted[x,y]=0
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, RECT win,2*x+(y&1),2*y,2,2,0xFFFFFF,0xFFFFFF
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, sitebeenplotted[x,y]=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, IF y<ymin THEN ymin=y
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ENDIF
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  NEXT x
ÂÃ,  ÂÃ,  ÂÃ,  NEXT y
ÂÃ,  ÂÃ,  ÂÃ,  RELEASEHDC win,hdc
ÂÃ,  ÂÃ,  ÂÃ,  iterations=iterations+1
ÂÃ,  ÂÃ,  ÂÃ,  WAIT 1
ÂÃ,  ÂÃ, UNTIL run=0 | ymin<20 | iterations=500

ÂÃ,  IF run=1
ÂÃ,  ÂÃ,  'Draw snowflake with shading
ÂÃ,  ÂÃ,  FOR y=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  FOR x=1 TO size-2
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  IF sitevalue[x,y]>=1
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  mult=sitevalue[x,y]/maxvalue
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  colour=RGB(165+mult*90,165+mult*90,255)
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  RECT win,2*x+(y&1),2*y,2,2,colour,colour
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ENDIF
ÂÃ,  ÂÃ,  ÂÃ,  NEXT x
ÂÃ,  ÂÃ,  NEXT y
ÂÃ,  ENDIF

ÂÃ,  SETCAPTION win,"Snowflake growth simulator.Press spacebar"
ÂÃ,  drawing=0
RETURN
ENDSUB


[granada]

hello there,cool to see your still playing.I allways like the things you come up withÂÃ,  .

Dave

[Ionic Wind Support Team]

And glad to see the same avatar after all of these years