http://rectangleworld.com/blog/archives/587
Lot's of other cool stuff there
It is based on bird flocking behaviour and cellular automata and particularly boid's algorithm which models flocks of birds using the behavioural principles separation, alignment and cohesion.
It looks fairly blocky in the screen-shot below but there are lots of tweaks you can make, it looks really good with a 1px x 1px grid but don't go too big on the window size or your CPU will melt
Interestingly, a fairly naive analysis (Task manger 
) indicates that PB's canvas runs about 3 times faster than the one in firefox size for size.
It should work on Mac but only tested on xubuntu 12.10 and Windows Vista.
Code: Select all
;-- separation: if a cell’s color is too close to that of one of its neighbors, move away from that color.
;-- alignment: adjust the rate of change of a cell’s color towards the average rate of change of its neighbors.
;-- cohesion: move the color of a cell towards the average color of its neighbors.
;-- 1000mS / 25 = 40mS
#mSRedraw = 40
#minDist = 8
#minDistSquare = #minDist * #minDist
#sepNormMag = 4
#Easing = 0.67
;-- Smaller cells and a bigger canvas will eat your CPU!
CanvWidth.w = 600
CanvHeight.w = 400
Cellwidth.w= CanvWidth / 20
CellHeight.w = CanvHeight / 30
ArrayX = CanvWidth/Cellwidth
ArrayY = CanvHeight/CellHeight
Structure CELL
X.w
Y.w
;-- Colours
R.f
G.f
B.f
bufferR.f
bufferG.f
bufferB.f
;-- Velocities
RVel.f
GVel.f
BVel.f
bufferRVel.f
bufferGVel.f
bufferBVel.f
List *neighbours()
neighbourCnt.w
EndStructure
Dim Cells.CELL(ArrayX, ArrayY)
Procedure InitialiseCells(Canvas)
Shared Cells(), ArrayX, ArrayY, CellWidth, CellHeight
If StartDrawing(CanvasOutput(Canvas))
For i = 0 To ArrayX
For j = 0 To ArrayY
Cells(i,j)\X = i * Cellwidth
Cells(i,j)\Y = j * CellHeight
Cells(i,j)\bufferRVel = 0
Cells(i,j)\bufferGVel = 0
Cells(i,j)\bufferBVel = 0
Cells(i,j)\RVel = 0
Cells(i,j)\GVel = 0
Cells(i,j)\BVel = 0
Cells(i,j)\R = Random(255)
Cells(i,j)\G = Random(255)
Cells(i,j)\B = Random(255)
Cells(i,j)\bufferR = Cells(i,j)\R
Cells(i,j)\bufferG = Cells(i,j)\G
Cells(i,j)\bufferB = Cells(i,j)\B
Box(Cells(i,j)\X, Cells(i,j)\Y, Cellwidth, CellHeight, RGB(Cells(i,j)\R, Cells(i,j)\G, Cells(i,j)\B))
Next
Next
StopDrawing()
EndIf
EndProcedure
Procedure InitialiseNeighbours()
Shared Cells(), ArrayX, ArrayY
For i = 0 To ArrayX
For j = 0 To ArrayY
If i > 0
AddElement(Cells(i, j)\neighbours())
Cells(i, j)\neighbours() = @Cells(i - 1, j)
AddElement(Cells(i - 1, j)\neighbours())
Cells(i - 1, j)\neighbours() = @Cells(i, j)
EndIf
If j > 0
AddElement(Cells(i, j)\neighbours())
Cells(i, j)\neighbours() = @Cells(i, j - 1)
AddElement(Cells(i, j - 1)\neighbours())
Cells(i, j - 1)\neighbours() = @Cells(i, j)
EndIf
neighbourCnt = ListSize(Cells(i,j)\neighbours())
Next
Next
;-- Go through again and get the number of neighbours
For i = 0 To ArrayX
For j = 0 To ArrayY
Cells(i,j)\neighbourCnt = ListSize(Cells(i,j)\neighbours())
Next
Next
EndProcedure
Procedure UpdateCells(Canvas)
Shared Cells(), ArrayX, ArrayY, CellWidth, CellHeight
If StartDrawing(CanvasOutput(Canvas))
For i = 0 To ArrayX
For j = 0 To ArrayY
rAve = 0
gAve = 0
bAve = 0
rVelAve = 0
gVelAve = 0
bVelAve = 0
rSep = 0
gSep = 0
bSep = 0
ForEach Cells(i,j)\neighbours()
*neighbour.CELL = Cells(i, j)\neighbours()
rAve + *neighbour\R
gAve + *neighbour\G
bAve + *neighbour\B
rVelAve + *neighbour\RVel
gVelAve + *neighbour\GVel
bVelAve + *neighbour\BVel
dr = Cells(i,j)\R - *neighbour\R
dg = Cells(i,j)\G - *neighbour\G
db = Cells(i,j)\B - *neighbour\B
If dr*dr + dg*dg + db*db < #minDistSquare
rSep + dr
gSep + dg
bSep + db
EndIf
Next
f.f = 1 / Cells(i,j)\neighbourCnt
rAve = rAve * f
gAve = gAve * f
bAve = bAve * f
rVelAve = rVelAve * f
gVelAve = gVelAve * f
bVelAve = bVelAve * f
;-- normalize separation vector
If (rSep <> 0) Or (gSep <> 0) Or (bSep <> 0)
sepMagRecip = #sepNormMag / Sqr(rSep * rSep + gSep * gSep + bSep * bSep)
rSep = rSep * sepMagRecip
gSep = gSep * sepMagRecip
bSep = bSep * sepMagRecip
EndIf
;-- Update velocity by combining separation, alignment and cohesion effects.
;-- Change velocity only by Easing ratio.
Cells(i,j)\bufferRVel + #Easing * (rSep + rVelAve + rAve - Cells(i,j)\R - Cells(i,j)\bufferRVel)
Cells(i,j)\bufferGVel + #Easing * (gSep + gVelAve + gAve - Cells(i,j)\G - Cells(i,j)\bufferGVel)
Cells(i,j)\bufferBVel + #Easing * (bSep + bVelAve + bAve - Cells(i,j)\B - Cells(i,j)\bufferBVel)
;-- update colors according to color velocities
Cells(i,j)\bufferR + Cells(i,j)\bufferRVel
Cells(i,j)\bufferG + Cells(i,j)\bufferGVel
Cells(i,j)\bufferB + Cells(i,j)\bufferBVel
;-- bounce colors off of color cube boundaries
If Cells(i,j)\bufferR < 0
Cells(i,j)\bufferR = 0
Cells(i,j)\bufferRVel = Cells(i,j)\bufferRVel * -1
ElseIf Cells(i,j)\bufferR > 255
Cells(i,j)\bufferR = 255
Cells(i,j)\bufferRVel = Cells(i,j)\bufferRVel * -1
EndIf
If Cells(i,j)\bufferG < 0
Cells(i,j)\bufferG = 0
Cells(i,j)\bufferGVel = Cells(i,j)\bufferGVel * -1
ElseIf Cells(i,j)\bufferG > 255
Cells(i,j)\bufferG = 255
Cells(i,j)\bufferGVel = Cells(i,j)\bufferGVel * -1
EndIf
If Cells(i,j)\bufferB < 0
Cells(i,j)\bufferB = 0
Cells(i,j)\bufferBVel = Cells(i,j)\bufferBVel * -1
ElseIf Cells(i,j)\bufferB > 255
Cells(i,j)\bufferB = 255
Cells(i,j)\bufferBVel = Cells(i,j)\bufferBVel * -1
EndIf
Next
Next
;-- now loop through again, copy buffer values and draw
For i = 0 To ArrayX
For j = 0 To ArrayY
Cells(i,j)\R = Cells(i,j)\bufferR
Cells(i,j)\G = Cells(i,j)\bufferG
Cells(i,j)\B = Cells(i,j)\bufferB
Cells(i,j)\RVel = Cells(i,j)\bufferRVel
Cells(i,j)\GVel = Cells(i,j)\bufferGVel
Cells(i,j)\BVel = Cells(i,j)\bufferBVel
Box(Cells(i,j)\X, Cells(i,j)\Y, Cellwidth, CellHeight, RGB(Cells(i,j)\R, Cells(i,j)\G, Cells(i,j)\B))
Next
Next
StopDrawing()
EndIf
EndProcedure
Procedure MaxWindow()
Shared Cells(), Canvas, CanvWidth, CanvHeight, ArrayX, ArrayY, CellWidth, CellHeight
ExamineDesktops()
CanvWidth = DesktopWidth(0)
CanvHeight = DesktopHeight(0)
Cellwidth= CanvWidth / 20
CellHeight = CanvHeight / 30
ArrayX = CanvWidth/Cellwidth
ArrayY = CanvHeight/CellHeight
Dim Cells.CELL(ArrayX, ArrayY)
InitialiseCells(Canvas)
InitialiseNeighbours()
ResizeGadget(Canvas, #PB_Ignore, #PB_Ignore, CanvWidth, CanvHeight)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
gtk_window_fullscreen_(WindowID(0))
CompilerEndIf
EndProcedure
Procedure MinWindow()
Shared Cells(), Canvas, CanvWidth, CanvHeight, ArrayX, ArrayY, CellWidth, CellHeight
CanvWidth = WindowWidth(0)
Debug CanvWidth
CanvHeight = WindowHeight(0)
Cellwidth= CanvWidth / 20
CellHeight = CanvHeight / 30
ArrayX = CanvWidth/Cellwidth
ArrayY = CanvHeight/CellHeight
Dim Cells.CELL(ArrayX, ArrayY)
InitialiseCells(Canvas)
InitialiseNeighbours()
ResizeGadget(Canvas, #PB_Ignore, #PB_Ignore, CanvWidth, CanvHeight)
EndProcedure
If OpenWindow(0, 0, 0, CanvWidth, CanvHeight, "Flocking Cellular Automaton", #PB_Window_BorderLess | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered)
AddWindowTimer(0, 666, #mSRedraw)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 1)
AddKeyboardShortcut(0, #PB_Shortcut_Tab, 2)
Canvas = CanvasGadget(#PB_Any, 0, 0, CanvWidth, CanvHeight)
GadgetToolTip(Canvas, "Flocking Cellular Automaton" + #CRLF$ + "Left click to reset" + #CRLF$ + "Tab toggles fullscreen" + #CRLF$ + "Esc to exit")
InitialiseCells(Canvas)
InitialiseNeighbours()
Repeat
Event = WaitWindowEvent(5)
Type = EventType()
If Event = #PB_Event_MaximizeWindow
MaxWindow()
ElseIf Event = #PB_Event_RestoreWindow
MinWindow()
ElseIf Event = #PB_Event_SizeWindow
MinWindow()
ElseIf Event = #PB_Event_Timer And EventTimer() = 666
UpdateCells(Canvas)
ElseIf Event = #PB_Event_Gadget
If Type = #PB_EventType_LeftClick
InitialiseCells(Canvas)
UpdateCells(Canvas)
EndIf
ElseIf Event = #PB_Event_Menu
Menu = EventMenu()
If Menu = 1
Break
ElseIf Menu = 2
State ! 1
If State = 1
SetWindowState(0, #PB_Window_Maximize)
Else
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
gtk_window_unfullscreen_(WindowID(0))
CompilerEndIf
SetWindowState(0, #PB_Window_Normal)
EndIf
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
