I have been thinking about plotting some snowflakes over the time off work. They are very interesting, and generally make a decent pattern. I found Reiter's http://patarnott.com/pdf/SnowCrystalGrowth.pdf method which looked decent.
I have coded it, and although it is pretty processor intensive, I wondered if it was possible to make this much faster.
I am not a good programmer, but I can get things done, and they generally work. This does anyway.
Can you think of any ways to make it run faster?
Code: Select all
EnableExplicit
#width = 1000 ; Set Viewing Width
#height = 1000 ; Set Viewing Height
#width1 = 1000 ; Set Final Image Width - This can be greater than Viewing Width
#height1 = 1000 ; Set Final Image Height - This can be greater than Viewing Width
#max=100000000
Dim unreceptivetemp.d(#width1/6,#height1/5) ; Setup arrays for the 'points'
Dim receptive.d(#width1/6,#height1/5)
Dim unreceptive.d(#width1/6,#height1/5)
Dim receptivetemp.d(#width1/6,#height1/5)
Global colcho=1
Global r.i,ti.d
ti=0
Global r=0
Dim ared.i(360)
Dim agreen.i(360)
Dim ablue.i(360)
DataSection ; Setup Colour Arrays
Red:
Data.i 23,21,20,19,18,17,15,14,13,12,11,11,10,9,8,7,6,6,5,4,4,3,3,2,2,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,2,2,3,3,4,4,5,6,6,7,8,9,10,11,11,12,13,14,15,17,18,19,20,21,23,24,25,27,28,29,31,32,34,35,37,38,40,42,43,45,47,49,50,52,54,56,58,59,61,63,65,67,69,71,73,75,77,79,81,83,85,88,90,92,94,96,98,100,103,105,107,109,111,114,116,118,120,123,125,127,129,131,134,136,138,140,143,145,147,149,151,154,156,158,160,162,164,166,169,171,173,175,177,179,181,183,185,187,189,191,193,195,196,198,200,202,204,205,207,209,211,212,214,216,217,219,220,222,223,225,226,227,229,230,231,233,234,235,236,237,239,240,241,242,243,243,244,245,246,247,248,248,249,250,250,251,251,252,252,253,253,253,254,254,254,254,254,254,254,255,254,254,254,254,254,254,254,253,253,253,252,252,251,251,250,250,249,248,248,247,246,245,244,243,243,242,241,240,239,237,236,235,234,233,231,230,229,227,226,225,223,222,220,219,217,216,214,212,211,209,207,205,204,202,200,198,196,195,193,191,189,187,185,183,181,179,177,175,173,171,169,166,164,162,160,158,156,154,151,149,147,145,143,140,138,136,134,131,129,127,125,123,120,118,116,114,111,109,107,105,103,100,98,96,94,92,90,88,85,83,81,79,77,75,73,71,69,67,65,63,61,59,58,56,54,52,50,49,47,45,43,42,40,38,37,35,34,32,31,29,28,27,25,24
Green:
Data.i 108,106,104,102,101,99,97,96,94,92,90,89,87,85,83,82,80,78,77,75,73,72,70,68,67,65,63,62,60,59,57,55,54,52,51,49,48,46,45,43,42,41,39,38,36,35,34,32,31,30,29,27,26,25,24,23,22,21,20,19,17,17,16,15,14,13,12,11,10,10,9,8,7,7,6,6,5,4,4,3,3,2,2,2,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,2,2,2,3,3,4,4,5,6,6,7,7,8,9,10,10,11,12,13,14,15,16,17,17,19,20,21,22,23,24,25,26,27,29,30,31,32,34,35,36,38,39,41,42,43,45,46,48,49,51,52,54,55,57,59,60,62,63,65,67,68,70,72,73,75,77,78,80,82,83,85,87,89,90,92,94,96,97,99,101,102,104,106,108,109,111,113,115,116,118,120,121,123,125,126,128,130,131,133,135,136,138,139,141,143,144,146,147,149,150,152,153,155,156,157,159,160,162,163,164,166,167,168,169,171,172,173,174,175,176,177,178,179,181,181,182,183,184,185,186,187,188,188,189,190,191,191,192,192,193,194,194,195,195,196,196,196,197,197,197,198,198,198,198,198,198,198,198,199,198,198,198,198,198,198,198,198,197,197,197,196,196,196,195,195,194,194,193,192,192,191,191,190,189,188,188,187,186,185,184,183,182,181,181,179,178,177,176,175,174,173,172,171,169,168,167,166,164,163,162,160,159,157,156,155,153,152,150,149,147,146,144,143,141,139,138,136,135,133,131,130,128,126,125,123,121,120,118,116,115,113,111,109
Blue:
Data.i 124,126,128,131,133,135,137,139,141,143,146,148,150,152,154,156,158,160,162,165,167,169,171,173,175,177,179,181,182,184,186,188,190,192,194,195,197,199,201,202,204,206,207,209,210,212,214,215,217,218,219,221,222,223,225,226,227,228,230,231,232,233,234,235,236,237,238,239,239,240,241,242,242,243,244,244,245,245,246,246,247,247,247,248,248,248,248,248,248,248,249,248,248,248,248,248,248,248,247,247,247,246,246,245,245,244,244,243,242,242,241,240,239,239,238,237,236,235,234,233,232,231,230,228,227,226,225,223,222,221,219,218,217,215,214,212,210,209,207,206,204,202,201,199,197,195,194,192,190,188,186,184,182,181,179,177,175,173,171,169,167,165,162,160,158,156,154,152,150,148,146,143,141,139,137,135,133,131,128,126,124,122,120,117,115,113,111,109,107,105,102,100,98,96,94,92,90,88,86,83,81,79,77,75,73,71,69,67,66,64,62,60,58,56,54,53,51,49,47,46,44,42,41,39,38,36,34,33,31,30,29,27,26,25,23,22,21,20,18,17,16,15,14,13,12,11,10,9,9,8,7,6,6,5,4,4,3,3,2,2,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,2,2,3,3,4,4,5,6,6,7,8,9,9,10,11,12,13,14,15,16,17,18,20,21,22,23,25,26,27,29,30,31,33,34,36,38,39,41,42,44,46,47,49,51,53,54,56,58,60,62,64,66,67,69,71,73,75,77,79,81,83,86,88,90,92,94,96,98,100,102,105,107,109,111,113,115,117,120,122
EndDataSection
Restore Red
For r=1 To 360
Read.i ared(r)
Next
Restore Green
For r=1 To 360
Read.i agreen(r)
Next
Restore Blue
For r=1 To 360
Read.i ablue(r)
Next
#ImgGadget = 0
DataSection ; Setup hexagonal shape to be drawn at each 'pixel' - *This may not be necessary at all, at higher resolutions a square shape on hex grid may be fine, not sure.
Numbers:
Data.i 2,4,6,6,6,4,2
EndDataSection
; set various variables, some may not be necessary at this stage
Global.d g,z
Global.f d
Global.d t,const,background
Global.i j,count,loops,total,numbers,b,save,wi,he,action,re,gr,bl,col,tot
Global.i x,y,h,v,set,y1,x1,a,lineup,x1s,y1s
save=0
total=0
a=4
x=#width1/2:y=#height1/2
Enumeration ; More keys than I actually use, but sure, why not.
#Menu_Escape
#Menu_Space
#Menu_W
#Menu_C
#Menu_E
#Menu_P
#Menu_O
#Menu_A
EndEnumeration
count=1
wi=#width1/2
he=#height1/2
action=0
tot=0
background=0.4 ;set background value - all cells will be set to this initially and boundary cells set to this each iteration
For y1=1 To #height1/5
For x1=1 To #width1/6 ;set background values initial state in this loop
y=y1*5+a
z=3*Mod(y,2)
x=x1*6+4+z
lineup=Bool(z=0)
unreceptivetemp(x1-lineup,y1)=background
count=count+1
Next
Next
receptive(#width1/6/2+1,#height1/5/2)=1 ;set initial central seed
Procedure SDRAW(image.i)
Shared ared(),ablue(),agreen(),receptive(),receptivetemp(),unreceptive(),unreceptivetemp() ;set shared arrays
count=0
const=0.001 ;set constant value added ot receptive cells each iteration
;Debug col
re=aRed(Int(ti)) ;set colours
gr=aGreen(Int(ti))
bl=aBlue(Int(ti))
col=RGB(re,gr,bl)
ti=ti+2 ; ti sets the speed of change of colour - Higher = faster, it's a double so decimal numbers are okay.
If ti>360
ti=0
EndIf
Repeat
For y1=2 To #height1/5-2
For x1=2 To #width1/6-2
y=y1*5+a ;make hex grid from square grid
z=3*Mod(y,2)
x=x1*6+4+z
lineup=Bool(z=0)
If x1<=4 Or x1>=#width1/6-4 Or y1<=4 Or y1>=#height1/5-4 ; set boundary cells to background value - Not sure about this, but it seems to work until the Snowflake almost touches the walls
unreceptivetemp(x1,y1)=background
unreceptivetemp(x1-lineup,y1)=background
unreceptivetemp(x1-lineup-1,y1)=background
unreceptivetemp(x1-lineup+1,y1)=background
unreceptivetemp(x1,y1-1)=background
unreceptivetemp(x1,y1+1)=background
unreceptivetemp(x1-1,y1-1)=background
unreceptivetemp(x1-1,y1+1)=background
EndIf
;now carryout Iterations - Stage 1
If receptive(x1-lineup,y1)>=1 Or receptive(x1-1-lineup,y1)>=1 Or receptive(x1,y1-1)>=1 Or receptive(x1-1,y1-1)>=1 Or receptive(x1-1,y1+1)>=1 Or receptive(x1+1-lineup,y1)>=1 Or receptive(x1,y1+1)>=1
unreceptivetemp(x1-lineup,y1)=0
receptivetemp(x1-lineup,y1)=receptive(x1-lineup,y1)+const
Else
receptivetemp(x1-lineup,y1)=0
EndIf
Next
Next
For y1=2 To #height1/5-2
For x1=2 To #width1/6-2
y=y1*5+a ;make hex grid from square grid again for stage 2 and plotting
z=3*Mod(y,2)
x=x1*6+4+z
lineup=Bool(z=0)
;Iterations - Stage 2
unreceptive(x1-lineup,y1)=(1/2)*unreceptivetemp(x1-lineup,y1)+(unreceptivetemp(x1-1-lineup,y1)+unreceptivetemp(x1-1,y1-1)+unreceptivetemp(x1-1,y1+1)+unreceptivetemp(x1,y1-1)+unreceptivetemp(x1+1-lineup,y1)+unreceptivetemp(x1,y1+1))/12
receptive(x1-lineup,y1)=unreceptive(x1-lineup,y1)+receptivetemp(x1-lineup,y1)
If receptive(x1-lineup,y1)>=1
If Point(x,y)=0
For h=1 To 7
Read numbers
For v=1 To numbers
Plot (x+v-numbers/2,y+h-7/2,col)
Next
Next
Restore numbers
EndIf
EndIf
Next
Next
CopyArray(unreceptive(),unreceptivetemp())
action=action+1
Until action=10 ; Run it 10 times to save lag due to image generation
action=0
tot=tot+1
EndProcedure
Define.i Event, EventGadget, copy, quit, main, image, imagesc ; Setup up windows and images
main = OpenWindow(#PB_Any, 50, 0, #width-23, #height, "Drawing",#PB_Window_MinimizeGadget)
image = CreateImage(#PB_Any, #width1,#height1)
ImageGadget(#ImgGadget, 0, 0, #width1, #height1, ImageID(image))
CreateStatusBar(0, WindowID(main))
imagesc = CreateImage(#PB_Any, #width-StatusBarHeight(0),#height-StatusBarHeight(0))
ImageGadget(#ImgGadget, 0, 0, #width-StatusBarHeight(0), #height-StatusBarHeight(0), ImageID(imagesc))
AddKeyboardShortcut(main, #PB_Shortcut_Escape, #Menu_Escape) ; more than I need but I leave them
AddKeyboardShortcut(main, #PB_Shortcut_Space, #Menu_Space)
AddKeyboardShortcut(main, #PB_Shortcut_W, #Menu_W)
AddKeyboardShortcut(main, #PB_Shortcut_C, #Menu_C)
AddKeyboardShortcut(main, #PB_Shortcut_E, #Menu_E)
AddKeyboardShortcut(main, #PB_Shortcut_P, #Menu_P)
AddKeyboardShortcut(main, #PB_Shortcut_O, #Menu_O)
AddKeyboardShortcut(main, #PB_Shortcut_A, #Menu_A)
UseJPEGImageEncoder()
AddWindowTimer(main, 1, 100)
;CreateStatusBar(0, WindowID(main))
AddStatusBarField(130) ; too many here, but I use them elsewhere
AddStatusBarField(130)
AddStatusBarField(130)
AddStatusBarField(130)
AddStatusBarField(130)
AddStatusBarField(130)
AddStatusBarField(130)
Repeat ; Start main loop
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Timer
Select EventTimer()
Case 1
StartDrawing(ImageOutput(image))
DrawingMode(#PB_2DDrawing_Default)
SDRAW(image)
StopDrawing()
CopyImage(image, copy)
ResizeImage(copy, #width-StatusBarHeight(0), #height-StatusBarHeight(0))
If StartDrawing(ImageOutput(imagesc))
DrawImage(ImageID(copy), 0, 0)
StopDrawing()
;StatusBarText(0, 0, Str(sides), #PB_StatusBar_Center)
StatusBarText(0, 1, "tot= "+Str(tot), #PB_StatusBar_Center)
StatusBarText(0, 2, "count= "+Str(count), #PB_StatusBar_Center)
StatusBarText(0, 3, "total= "+Str(total), #PB_StatusBar_Center)
StatusBarText(0, 4, "ti= "+Str(ti), #PB_StatusBar_Center)
;StatusBarText(0, 5, "Loops="+Str(tick), #PB_StatusBar_Center)
;StatusBarText(0, 6, Str(count), #PB_StatusBar_Center)
;tick=tick+1
SetGadgetState(#ImgGadget, ImageID(imagesc))
; Delay(2000)
EndIf
EndSelect
Case #PB_Event_Menu
Select EventMenu()
Case #Menu_C
x=wi
y=he
Case #menu_E
x=wi+2000
y=he+2000
Case #Menu_O
; c=0
;blackon=600000
Case #Menu_P
; h=100000
Case #Menu_Escape
quit = #True
Case #Menu_Space
Delay(800)
Case #Menu_W
SaveImage(image,"Randraw - "+FormatDate("%yyyy%mm%dd_%hh%ii%ss", Date())+Str(Random(9999,1))+".jpg", #PB_ImagePlugin_JPEG,99)
StatusBarText(0, 0, "Saved Image " + Str(save), #PB_StatusBar_Right)
save=save+1
EndSelect
Case #PB_Event_Gadget
EventGadget = EventGadget()
Select EventGadget
EndSelect
Case #PB_Event_CloseWindow
Quit=#True
EndSelect
Until quit
Thanks for any help.