algorithm.
I have ported it to PureBasic and added many features.
Code: Select all
; originally written in Python script by Eric Burnett (https://github.com/EricBurnett/GameOfLife)
; ported to PureBasic, rewritten and enhanced by Mr.L (2016)
EnableExplicit
#MAXLEVEL = 60
#MAXMEM = 500 << 20
Enumeration
#Gadget_Canvas
#Gadget_Start
#Gadget_Step
#Gadget_Speed
#Gadget_Left
#Gadget_Right
#Gadget_Up
#Gadget_Down
#Gadget_Center
#Menu_Open
#Menu_Quit
#Menu_ShowQuadTree
#Menu_ShowDescription
#Menu_RuleGameOfLife
#Menu_RuleWireWorld
EndEnumeration
Structure POINT2Q
x.q
y.q
EndStructure
Structure POINT2D
x.d
y.d
EndStructure
Structure BOUNDS
b.q[4]
EndStructure
Structure Node
level.q
*hash.Node
*n.Node[4]
*next.Node
nextLevel.q
usage.b
EndStructure
Structure World
*root.Node
view_center.POINT2D
view_size.d
view_bounds.BOUNDS
cursor.POINT2Q
offset.POINT2Q
EndStructure
Structure Game
canvas.i
width.i
height.i
generations_per_update.q
delay_per_update.i
next_update_Time.i
redrawTime.i
iteration_count.q
drawTree.b
paused.b
description.s
*ruleProc
*world.World
EndStructure
Global NewList Nodes.Node()
Global Dim *zero.Node(#MAXLEVEL)
Global World.World
Global Game.Game
Global *FreeNodes, FreeNodeCount
Global Dim *hashTab.Node(1)
Global hashPrime.q, hashLimit.q, hashPop.q, hashFound.q
Global Dim Pow2.q(#MAXLEVEL)
Global Dim Rule(255, 255)
Global countPixel, countBox
LoadFont(0, "Consolas", 8, #PB_Font_Bold)
Declare Game_Draw()
Declare ParseFile(name.s)
Declare Game_OpenFile(path.s = "", filename.s = "", speed = 2)
; class Node
; A Node represents a square 2^N x 2^N cluster of cells.
; The Node class is based on the description of the HashLife algorithm found
; at http://drdobbs.com/high-performance-computing/184406478. It is a hash tree
; with agressive caching and de-duplication. In particular:
; * Nodes are defined recursively, with nw, ne, sw, and se being Nodes
; representing the 2^(N-1) x 2^(N-1) cells in a particular corner ([0|1] at
; the leaves).
; * Nodes are immutable. Once a Node is returned from Node.CanonicalNode(), the
; cells represented are guaranteed not to change.
; * Nodes are unique. They are constructed in such a way that no two Node
; objects can represent the same configuration of cells. In particular, this
; means that Nodes can be compared by equality by doing id(a)==id(b). This
; means that most node hierarchies take far less than 2^(2N) space to store.
; * One key operation on a Node is to return the inner core 2^(N-1) x 2^(N-1)
; cells forward a number of generations (usually 2^(N-2)). This is cached
; wherever possible, and, along with identical nodes being shared due to their
; uniqueness, means calculating the future inner core of a Node is usually far
; cheaper than the worst Case 2^(2N) operation.
Procedure.q min(a.q, b.q)
If a <= b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Procedure.q max(a.q, b.q)
If a >= b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Global Dim NodeColor(255)
;- -----------------------------------
Procedure.s DebugNode(*node.Node, level = 0)
If *node <= 0 : ProcedureReturn : EndIf
Protected text.s = "(" + Str(*node\level)
Debug RSet(Hex(*node), 12) + RSet(" ", (4 + level * 4), "_") + Hex(*node\n[0]) + "','" + Hex(*node\n[1]) + "','" + Hex(*node\n[2]) + "','" + Hex(*node\n[3])
If *node\level = 1
text + ", '" + Str(*node\n[0]) + "','" + Str(*node\n[1]) + "','" + Str(*node\n[2]) + "','" + Str(*node\n[3]) + "'"
ElseIf *node\level > 1
If *node\n[0]: text + DebugNode(*node\n[0], level + 1) : EndIf
If *node\n[1]: text + DebugNode(*node\n[1], level + 1) : EndIf
If *node\n[2]: text + DebugNode(*node\n[2], level + 1) : EndIf
If *node\n[3]: text + DebugNode(*node\n[3], level + 1) : EndIf
EndIf
ProcedureReturn text + ")"
EndProcedure
Macro SetBounds(b_, b0_, b1_, b2_, b3_)
b_\b[0] = (b0_)
b_\b[1] = (b1_)
b_\b[2] = (b2_)
b_\b[3] = (b3_)
EndMacro
; Various sum functions, for counting portions of a level-1 node.
Macro Node_Sum(node_, index_)
; index is the value To skip (i.e. count 3 of 4 cells).
(node_\n[0] + node_\n[1] + node_\n[2] + node_\n[3] - node_\n[index_])
EndMacro
Macro Node_SumLeft(node_)
(node_\n[0] + node_\n[2])
EndMacro
Macro Node_SumTop(node_)
(node_\n[0] + node_\n[1])
EndMacro
Macro Node_SumRight(node_)
(node_\n[1] + node_\n[3])
EndMacro
Macro Node_SumBottom(node_)
(node_\n[2] + node_\n[3])
EndMacro
Macro Node_Zero(level_)
*zero(level_)
EndMacro
Macro Node_IsZero(node_)
Bool(Node_Zero(node_\level) = node_)
EndMacro
Macro Node_MergeHorizontal(l_, r_)
Node_Canonical(l_\level, l_\n[1], r_\n[0], l_\n[3], r_\n[2])
EndMacro
Macro Node_MergeVertical(t_, b_)
Node_Canonical(t_\level, t_\n[2], t_\n[3], b_\n[0], b_\n[1])
EndMacro
Macro Node_MergeCenter(nw_, ne_, sw_, se_)
Node_Canonical(nw_\level, nw_\n[3], ne_\n[2], sw_\n[1], se_\n[0])
EndMacro
Macro Hash_Key(nw_, ne_, sw_, se_)
(5 * (nw_) + 17 * (ne_) + 257 * (sw_) + 65537 * (se_))
EndMacro
Procedure.q Hash_NextPrime(i.q)
i | 1
Protected j.q = 3
Repeat
i + 2
While (j * j < i) And (i % j)
j + 2
Wend
Until (j * j > i)
ProcedureReturn i
EndProcedure
Procedure Hash_Resize()
Protected nHashPrime.q = Hash_NextPrime(2 * hashPrime)
Protected Dim *nHashTab.Node(nHashPrime)
Protected h.q, i, q, *p.Node
For i = 0 To hashPrime - 1
*p = *hashTab(i)
While *p
Protected *np.Node = *p\hash
Protected nw = *p\n[0]
Protected ne = *p\n[1]
Protected sw = *p\n[2]
Protected se = *p\n[3]
h = Hash_Key(nw, ne, sw, se) % nHashPrime
*p\hash = *nHashTab(h)
*nHashTab(h) = *p
*p = *np
Wend
Next
CopyArray(*nHashTab(), *hashTab())
hashPrime = nHashPrime
hashLimit = hashPrime
EndProcedure
Procedure Node_Canonical(level, nw, ne, sw, se)
; Returns a canonical version of a new node.
Static h.q
Static.Node *canonical, *pred
h = Hash_Key(nw, ne, sw, se) % hashPrime
*pred = #Null
*canonical = *hashTab(h)
If *canonical
hashFound + 1
If *canonical\n[0] = nw And *canonical\n[1] = ne And *canonical\n[2] = sw And *canonical\n[3] = se
ProcedureReturn *canonical
Else
While *canonical\hash
*canonical = *canonical\hash
If *canonical\n[0] = nw And *canonical\n[1] = ne And *canonical\n[2] = sw And *canonical\n[3] = se
If *pred
*pred\hash = *canonical\hash
*canonical\hash = *hashTab(h)
*hashTab(h) = *canonical
EndIf
ProcedureReturn *canonical
EndIf
*pred = *canonical
Wend
EndIf
EndIf
*canonical = AddElement(Nodes())
*canonical\level = level
*canonical\n[0] = nw
*canonical\n[1] = ne
*canonical\n[2] = sw
*canonical\n[3] = se
*canonical\hash = *hashTab(h)
*hashTab(h) = *canonical
hashPop + 1
If hashpop > hashLimit
Hash_Resize()
EndIf
ProcedureReturn *canonical
EndProcedure
Procedure Node_Expand(*node.Node)
; Returns a node one level deeper, with the center being this node.
Static *zero.Node
*zero = Node_Zero(*node\level - 1)
ProcedureReturn Node_Canonical(*node\level + 1,
Node_Canonical(*node\level, *zero, *zero, *zero, *node\n[0]),
Node_Canonical(*node\level, *zero, *zero, *node\n[1], *zero),
Node_Canonical(*node\level, *zero, *node\n[2], *zero, *zero),
Node_Canonical(*node\level, *node\n[3], *zero, *zero, *zero))
EndProcedure
Procedure Node_Compact(*node.Node)
; Returns the smallest node (level >= 1) that will contain all the cells
; (without shifting the center).
If *node\level < 1
ProcedureReturn *node
EndIf
Static *zero.Node
*zero = Node_Zero(*node\level - 2)
While (*node\level > 2 And
(*node\n[0]\n[0] = *zero) And (*node\n[0]\n[1] = *zero) And (*node\n[0]\n[2] = *zero) And
(*node\n[1]\n[0] = *zero) And (*node\n[1]\n[1] = *zero) And (*node\n[1]\n[3] = *zero) And
(*node\n[2]\n[0] = *zero) And (*node\n[2]\n[2] = *zero) And (*node\n[2]\n[3] = *zero) And
(*node\n[3]\n[1] = *zero) And (*node\n[3]\n[2] = *zero) And (*node\n[3]\n[3] = *zero))
*node = Node_Canonical(*node\level - 1, *node\n[0]\n[3], *node\n[1]\n[2], *node\n[2]\n[1], *node\n[3]\n[0])
*zero = Node_Zero(*node\level - 2)
Wend
ProcedureReturn *node
EndProcedure
Procedure Node_Rule_WireWorld(*node.Node)
Static s0, s1, s2, s3, h
s0 = *node\n[0]\n[3]
s1 = *node\n[1]\n[2]
s2 = *node\n[2]\n[1]
s3 = *node\n[3]\n[0]
If s0 = 3
h = Bool(*node\n[0]\n[0] = 1) + Bool(*node\n[0]\n[1] = 1) + Bool(*node\n[0]\n[2] = 1) +
Bool(*node\n[1]\n[0] = 1) + Bool(*node\n[1]\n[2] = 1) +
Bool(*node\n[2]\n[0] = 1) + Bool(*node\n[2]\n[1] = 1) +
Bool(*node\n[3]\n[0] = 1)
If h = 1 Or h = 2 : s0 = 1 : EndIf
ElseIf s0
s0 + 1
EndIf
If s1 = 3
h = Bool(*node\n[0]\n[1] = 1) + Bool(*node\n[0]\n[3] = 1) + Bool(*node\n[1]\n[0] = 1) +
Bool(*node\n[1]\n[1] = 1) + Bool(*node\n[1]\n[3] = 1) +
Bool(*node\n[2]\n[1] = 1) +
Bool(*node\n[3]\n[0] = 1) + Bool(*node\n[3]\n[1] = 1)
If h = 1 Or h = 2 : s1 = 1 : EndIf
ElseIf s1
s1 + 1
EndIf
If s2 = 3
h = Bool(*node\n[0]\n[2] = 1) + Bool(*node\n[0]\n[3] = 1) +
Bool(*node\n[1]\n[2] = 1) +
Bool(*node\n[2]\n[0] = 1) + Bool(*node\n[2]\n[2] = 1) + Bool(*node\n[2]\n[3] = 1) +
Bool(*node\n[3]\n[0] = 1) + Bool(*node\n[3]\n[2] = 1)
If h = 1 Or h = 2 : s2 = 1 : EndIf
ElseIf s2
s2 + 1
EndIf
If s3 = 3
h = Bool(*node\n[0]\n[3] = 1) +
Bool(*node\n[1]\n[2] = 1) + Bool(*node\n[1]\n[3] = 1) +
Bool(*node\n[2]\n[1] = 1) + Bool(*node\n[2]\n[3] = 1) +
Bool(*node\n[3]\n[1] = 1) + Bool(*node\n[3]\n[2] = 1) + Bool(*node\n[3]\n[3] = 1)
If h = 1 Or h = 2 : s3 = 1 : EndIf
ElseIf s3
s3 + 1
EndIf
ProcedureReturn Node_Canonical(1, s0, s1, s2, s3)
EndProcedure
Procedure Node_Rule_GameOfLife(*node.Node)
Static countNW, countNE, countSW, countSE, i
countNW = (Node_Sum(*node\n[0], 3) + Node_SumLeft (*node\n[1]) + Node_SumTop (*node\n[2]) + *node\n[3]\n[0])
countNE = (Node_Sum(*node\n[1], 2) + Node_SumRight(*node\n[0]) + Node_SumTop (*node\n[3]) + *node\n[2]\n[1])
countSW = (Node_Sum(*node\n[2], 1) + Node_SumLeft (*node\n[3]) + Node_SumBottom(*node\n[0]) + *node\n[1]\n[2])
countSE = (Node_Sum(*node\n[3], 0) + Node_SumRight(*node\n[2]) + Node_SumBottom(*node\n[1]) + *node\n[0]\n[3])
i = *node\n[0]\n[3]
countNW = Rule(countNW, i)
i = *node\n[1]\n[2]
countNE = Rule(countNE, i)
i = *node\n[2]\n[1]
countSW = Rule(countSW, i)
i = *node\n[3]\n[0]
countSE = Rule(countSE, i)
ProcedureReturn Node_Canonical(1, countNW, countNE, countSW, countSE)
EndProcedure
Procedure Node_Forward(*node.Node, atLevel = #Null)
; Returns the inner 2^(level-1) x 2^(level-1) core of this node, forward in
; time. The number of generations will be 2^(atLevel-2), by calling Node_Forward
; twice at every level <= atLevel, And once For higher levels. This causes the
; exponential speedup to start at the specified level, being linear up till
; that point.
Protected.Node *n00, *n01, *n02, *n10, *n11, *n12, *n20, *n21, *n22
Protected.Node *nw, *ne, *sw, *se
If (atLevel = #Null) Or (atLevel > *node\level)
atLevel = *node\level
EndIf
If *node\next And (*node\nextLevel <> atLevel)
; Wipe the cache for now.
*node\next = #Null
*node\nextLevel = #Null
EndIf
If *node\next <> #Null
ProcedureReturn *node\next
EndIf
If *node\level = 2
*node\next = CallFunctionFast(Game\ruleProc, *node)
*node\nextLevel = atLevel
Else
*n00 = Node_Forward(*node\n[0], atLevel)
*n01 = Node_Forward(Node_MergeHorizontal(*node\n[0], *node\n[1]), atLevel)
*n02 = Node_Forward(*node\n[1], atLevel)
*n10 = Node_Forward(Node_MergeVertical(*node\n[0], *node\n[2]), atLevel)
*n11 = Node_Forward(Node_MergeCenter(*node\n[0], *node\n[1], *node\n[2], *node\n[3]), atLevel)
*n12 = Node_Forward(Node_MergeVertical(*node\n[1], *node\n[3]), atLevel)
*n20 = Node_Forward(*node\n[2], atLevel)
*n21 = Node_Forward(Node_MergeHorizontal(*node\n[2], *node\n[3]), atLevel)
*n22 = Node_Forward(*node\n[3], atLevel)
If atLevel <> *node\level
; Just merge the result from the lower levels without adding another
; forward phase - this takes out a factor of two in the recursion and
; allows us to step some number of generations forward < 2^(level-2).
*nw = Node_MergeCenter(*n00, *n01, *n10, *n11)
*ne = Node_MergeCenter(*n01, *n02, *n11, *n12)
*sw = Node_MergeCenter(*n10, *n11, *n20, *n21)
*se = Node_MergeCenter(*n11, *n12, *n21, *n22)
Else
*nw = Node_Forward(Node_Canonical(*node\level - 1, *n00, *n01, *n10, *n11))
*ne = Node_Forward(Node_Canonical(*node\level - 1, *n01, *n02, *n11, *n12))
*sw = Node_Forward(Node_Canonical(*node\level - 1, *n10, *n11, *n20, *n21))
*se = Node_Forward(Node_Canonical(*node\level - 1, *n11, *n12, *n21, *n22))
EndIf
*node\next = Node_Canonical(*node\level - 1, *nw, *ne, *sw, *se)
*node\nextLevel = atLevel
EndIf
ProcedureReturn *node\next
EndProcedure
Procedure Node_ForwardN(*node.Node, n.q)
If *node = #Null
ProcedureReturn 0
EndIf
; Returns a Node pointer, representing these cells forward n generations.
; It will automatically expand to be big enough to fit all cells.
; The most compact node centered at the appropriate location that contains
; all the cells is returned.
Static atLevel.q
atLevel = 2
While (n > 0)
If (n & 1)
While *node\level < (atLevel - 2)
*node = Node_Expand(*node)
Wend
; Expand twice extra To ensure the expanded cells will fit within the
; center forward one.
*node = Node_Expand(*node)
*node = Node_Expand(*node)
*node = Node_Forward(*node, atLevel)
EndIf
n >> 1
atLevel + 1
Wend
ProcedureReturn Node_Compact(*node)
EndProcedure
Procedure Node_SetPixel(*node.Node, size.q, xp.q, yp.q, state, x.q = 0, y.q = 0)
If (xp < x - size) Or (xp > x + size) Or (yp < y - size) Or (yp > y + size)
ProcedureReturn *node
EndIf
Protected a = *node\n[0]
Protected b = *node\n[1]
Protected c = *node\n[2]
Protected d = *node\n[3]
If (*node\level = 1)
If (x - 1 = xp) And (y - 1 = yp) : a = state : EndIf
If (x = xp) And (y - 1 = yp) : b = state : EndIf
If (x - 1 = xp) And (y = yp) : c = state : EndIf
If (x = xp) And (y = yp) : d = state : EndIf
Else
size >> 1
a = Node_SetPixel(a, size, xp, yp, state, x - size, y - size)
b = Node_SetPixel(b, size, xp, yp, state, x + size, y - size)
c = Node_SetPixel(c, size, xp, yp, state, x - size, y + size)
d = Node_SetPixel(d, size, xp, yp, state, x + size, y + size)
EndIf
ProcedureReturn Node_Canonical(*node\level, a, b, c, d)
EndProcedure
Procedure Node_GetPixel(*node.Node, x.q, y.q)
Protected.q xp, yp, size = Pow2(World\root\level - 1)
Repeat
size >> 1
If y < yp
If x < xp
*node = *node\n[0]
xp - size
Else
*node = *node\n[1]
xp + size
EndIf
yp - size
Else
If x < xp
*node = *node\n[2]
xp - size
Else
*node = *node\n[3]
xp + size
EndIf
yp + size
EndIf
Until size = 0
ProcedureReturn *node
EndProcedure
Procedure Node_SetPixelState(x, y, state)
While (World\root\level < #MAXLEVEL) And max(Abs(x), Abs(y)) > Pow2(World\root\level - 1)
World\root = Node_Expand(World\root)
Wend
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, state)
; World_Center(World\root, #True)
EndProcedure
Procedure Node_GarbageCollectionMark(*node.Node)
If *node = #Null Or *node\usage Or *node\level < 3 : ProcedureReturn #False : EndIf
*node\usage = 1
Node_GarbageCollectionMark(*node\n[0])
Node_GarbageCollectionMark(*node\n[1])
Node_GarbageCollectionMark(*node\n[3])
Node_GarbageCollectionMark(*node\n[2])
Node_GarbageCollectionMark(*node\next)
EndProcedure
Procedure Node_GarbageCollection()
StartDrawing(CanvasOutput(Game\canvas))
DrawText(10, OutputHeight() - 50, "Garbage collection", RGB(255, 0, 0), 0)
StopDrawing()
ForEach Nodes()
Nodes()\usage = 0
Next
hashPop = 0
FillMemory(@ *hashTab(), (ArraySize(*hashTab()) + 1) * SizeOf(Integer))
Node_GarbageCollectionMark(World\root)
ForEach Nodes()
If (Node_IsZero(Nodes()) = 0) And (Nodes()\usage = 0) And (Nodes()\level > 2)
DeleteElement(Nodes())
Else
Protected nw = Nodes()\n[0]
Protected ne = Nodes()\n[1]
Protected sw = Nodes()\n[2]
Protected se = Nodes()\n[3]
Protected h.q = Hash_Key(nw, ne, sw, se) % hashPrime
Nodes()\hash = *hashTab(h)
*hashTab(h) = Nodes()
hashPop + 1
EndIf
Next
EndProcedure
Procedure Node_Draw(*node.Node, size.q, x.d, y.d)
If *node = 0 Or Node_IsZero(*node) : ProcedureReturn : EndIf
Static s.d, xo.q, yo.q, i
s = World\view_size * size
xo = (x - World\view_center\x) * World\view_size
yo = (y - World\view_center\y) * World\view_size
If s <= 0.5
countPixel + 1
Box(xo, yo, 1, 1, RGB(255, 255, 255))
ProcedureReturn
ElseIf (*node\level = 1)
i = *node\n[0]
If *node\n[0]: countBox + 1 : Box(xo - s, yo - s, s, s, NodeColor(i)): EndIf
i = *node\n[1]
If *node\n[1]: countBox + 1 : Box(xo, yo - s, s, s, NodeColor(i)): EndIf
i = *node\n[2]
If *node\n[2]: countBox + 1 : Box(xo - s, yo, s, s, NodeColor(i)): EndIf
i = *node\n[3]
If *node\n[3]: countBox + 1 : Box(xo, yo, s, s, NodeColor(i)): EndIf
ProcedureReturn
ElseIf (xo + s < 0) Or (xo - s > OutputWidth()) Or (yo + s < 0) Or (yo - s > OutputHeight())
ProcedureReturn
EndIf
size >> 1
Node_Draw(*node\n[0], size, x - size, y - size)
Node_Draw(*node\n[1], size, x + size, y - size)
Node_Draw(*node\n[2], size, x - size, y + size)
Node_Draw(*node\n[3], size, x + size, y + size)
EndProcedure
Procedure Box2(x.q, y.q, w.q, h.q, col)
; draw a box that is clipped to the output size
If x > 0 Or x + w < OutputWidth() Or y > 0 Or y + h < OutputHeight()
If x < 0 : w + x + 1 : x = -1 : ElseIf x > OutputWidth() : w - (OutputWidth() - x) : x = OutputWidth() + 1 : EndIf
If y < 0 : h + y + 1 : y = -1 : ElseIf y > OutputHeight() : h - (OutputHeight() - y) : y = OutputHeight() + 1 : EndIf
w = min(w, OutputWidth())
h = min(h, OutputHeight())
Box(x, y, w, h, col)
EndIf
EndProcedure
Procedure Node_DrawQuadTree(*node.Node, size.q, x.d, y.d)
Protected s.d = World\view_size * size * 2
If (s < 8) : ProcedureReturn : EndIf
Protected xo.q = (x - World\view_center\x - size) * World\view_size
Protected yo.q = (y - World\view_center\y - size) * World\view_size
Box2(xo, yo, s, s, RGB(125, 150, 225))
If (*node\level < 2) Or Node_IsZero(*node) Or (xo + s < 0) Or (xo - s > OutputWidth()) Or (yo + s < 0) Or (yo - s > OutputHeight())
ProcedureReturn
EndIf
size >> 1
Node_DrawQuadTree(*node\n[0], size, x - size, y - size)
Node_DrawQuadTree(*node\n[2], size, x - size, y + size)
Node_DrawQuadTree(*node\n[1], size, x + size, y - size)
Node_DrawQuadTree(*node\n[3], size, x + size, y + size)
EndProcedure
;- -----------------------------------
; Manages the world of cells, infinite in size.
;
; Handles drawing, iteration, and tracking various statistics about what is happening.
Procedure World_Iterate(num_generations.q)
; Updates the state of the current world by n generations.
hashFound = 0
Game\iteration_count + num_generations
World\root = Node_ForwardN(World\root, num_generations)
If (ListSize(Nodes()) * SizeOf(Node)) > #MAXMEM
Node_GarbageCollection()
EndIf
EndProcedure
Procedure World_ShiftView(direction, step_size)
; Shifts the current view by a number of screen pixels.
; view_center is in terms of cells, so shift by the corresponding number of
; cells instead.
Protected cells.q = max(1, step_size / World\view_size)
If direction = #PB_Shortcut_Up Or direction = #Gadget_Up
World\view_center\y - cells
ElseIf direction = #PB_Shortcut_Down Or direction = #Gadget_Down
World\view_center\y + cells
ElseIf direction = #PB_Shortcut_Right Or direction = #Gadget_Right
World\view_center\x + cells
ElseIf direction = #PB_Shortcut_Left Or direction = #Gadget_Left
World\view_center\x - cells
EndIf
EndProcedure
Procedure World_GetBounds(*node.Node, i, *bounds.BOUNDS, size.q, x.q = 0, y.q = 0)
If Node_IsZero(*node) : ProcedureReturn : EndIf
If *node\level = 1
If i = 0
If (*node\n[0] Or *node\n[1]) : *bounds\b[0] = min(*bounds\b[0], y - 1) : EndIf
If (*node\n[2] Or *node\n[3]) : *bounds\b[0] = min(*bounds\b[0], y) : EndIf
EndIf
If i = 1
If (*node\n[0] Or *node\n[1]) : *bounds\b[1] = max(*bounds\b[1], y - 1) : EndIf
If (*node\n[2] Or *node\n[3]) : *bounds\b[1] = max(*bounds\b[1], y) : EndIf
EndIf
If i = 2
If (*node\n[0] Or *node\n[2]) : *bounds\b[2] = min(*bounds\b[2], x - 1) : EndIf
If (*node\n[1] Or *node\n[3]) : *bounds\b[2] = min(*bounds\b[2], x) : EndIf
EndIf
If i = 3
If (*node\n[0] Or *node\n[2]) : *bounds\b[3] = max(*bounds\b[3], x - 1) : EndIf
If (*node\n[1] Or *node\n[3]) : *bounds\b[3] = max(*bounds\b[3], x) : EndIf
EndIf
ProcedureReturn
ElseIf (i = 0 And y - size >= *bounds\b[0]) Or
(i = 1 And y + size <= *bounds\b[1]) Or
(i = 2 And x - size >= *bounds\b[2]) Or
(i = 3 And x + size <= *bounds\b[3])
ProcedureReturn
EndIf
size >> 1
World_GetBounds(*node\n[0], i, *bounds, size, x - size, y - size)
World_GetBounds(*node\n[1], i, *bounds, size, x + size, y - size)
World_GetBounds(*node\n[2], i, *bounds, size, x - size, y + size)
World_GetBounds(*node\n[3], i, *bounds, size, x + size, y + size)
EndProcedure
Procedure World_Center(*node.Node, dontMove = #False)
If *node\level < 1
ProcedureReturn
EndIf
Protected size.q = Pow2(*node\level - 1)
SetBounds(World\view_bounds, size, -size, size, -size)
World_GetBounds(*node, 0, World\view_bounds, size, 0, 0)
World_GetBounds(*node, 1, World\view_bounds, size, 0, 0)
World_GetBounds(*node, 2, World\view_bounds, size, 0, 0)
World_GetBounds(*node, 3, World\view_bounds, size, 0, 0)
World\view_bounds\b[1] + 1
World\view_bounds\b[3] + 1
If dontMove = #False
Protected width.d = Abs(World\view_bounds\b[3] - World\view_bounds\b[2])
Protected height.d = Abs(World\view_bounds\b[1] - World\view_bounds\b[0])
If width = 0 Or height = 0
ProcedureReturn
EndIf
If (Game\width / width) < (Game\height / height)
World\view_size = (Game\width - 100) / width
Else
World\view_size = (Game\height - 100) / height
EndIf
World\view_center\x = World\view_bounds\b[2] + (width / 2)
World\view_center\y = World\view_bounds\b[0] + (height / 2)
EndIf
EndProcedure
;- -----------------------------------
Procedure Game_SetRule(rule.s)
FreeArray(NodeColor())
Global Dim NodeColor(255)
Select UCase(rule)
Case "GAMEOFLIFE"
NodeColor(0) = RGB(255, 255, 255)
NodeColor(1) = RGB(255, 255, 255)
Game\ruleProc = @Node_Rule_GameOfLife()
Case "WIREWORLD"
NodeColor(0) = RGB(128, 128, 128)
NodeColor(1) = RGB(0, 128, 255)
NodeColor(2) = RGB(255, 255, 255)
NodeColor(3) = RGB(255, 128, 0)
Game\ruleProc = @Node_Rule_WireWorld()
EndSelect
EndProcedure
Procedure Game_SetSpeed(value)
Game\delay_per_update = 0
Game\generations_per_update = 0
Select value
Case 0 : Game\delay_per_update = 1000
Case 1 : Game\delay_per_update = 500
Case 2 : Game\delay_per_update = 250
Case 3 : Game\delay_per_update = 125
Case 4 : Game\generations_per_update = 1
Case 5 : Game\generations_per_update = 2
Case 6 : Game\generations_per_update = 3
Case 7 : Game\generations_per_update = 4
Case 8 : Game\generations_per_update = 5
Case 9 : Game\generations_per_update = 6
Case 10 : Game\generations_per_update = 7
EndSelect
SetGadgetState(#Gadget_Speed, value)
EndProcedure
Procedure Game_Draw()
If (World\root) = #Null Or (World\root\level < 1)
ProcedureReturn
EndIf
StartDrawing(CanvasOutput(#Gadget_Canvas))
DrawingFont(FontID(0))
Box(0, 0, OutputWidth(), OutputHeight(), RGB(0, 0, 0))
countPixel = 0
countBox = 0
Node_Draw(World\root, Pow2(World\root\level - 1), (Game\width / 2) / World\view_size, (Game\height / 2) / World\view_size)
Protected s.d = World\view_size
If s > 4
Protected x.d = Mod( - World\view_center\x * s + Game\width / 2, s)
Protected y.d = Mod( - World\view_center\y * s + Game\height / 2, s)
While y < OutputHeight()
LineXY(0, y, OutputWidth(), y, RGB(32, 32, 32))
y + s
Wend
While x < OutputWidth()
LineXY(x, 0, x, OutputHeight(), RGB(32, 32, 32))
x + s
Wend
EndIf
If Game\drawTree
DrawingMode(#PB_2DDrawing_Outlined)
Node_DrawQuadTree(World\root, Pow2(World\root\level - 1), (Game\width / 2) / World\view_size, (Game\height / 2) / World\view_size)
DrawingMode(#PB_2DDrawing_Default)
EndIf
Protected py = OutputHeight() - 200
DrawingMode(#PB_2DDrawing_Transparent)
If Game\ruleProc = @Node_Rule_GameOfLife()
DrawText(10, py, "Rule: Game of Life", RGB(128, 128, 0))
Else
DrawText(10, py, "Rule: Wireworld", RGB(128, 128, 0))
EndIf
DrawText(10, py + 20, "iteration count : " + Str(Game\iteration_count), RGB(128, 128, 128))
If Game\delay_per_update > 0
DrawText(10, py + 40, "generations/update : " + Str(Game\delay_per_update) + " ms", RGB(128, 128, 128))
Else
DrawText(10, py + 40, "generations/update : 8^" + Str(Game\generations_per_update), RGB(128, 128, 128))
EndIf
DrawText(10, py + 60, "Hash size : " + Str((hashPop * SizeOf(Node)) >> 20) + " / " + Str((hashLimit * SizeOf(Node)) >> 20) + " MB", RGB(128, 128, 128))
DrawText(10, py + 80, "hash usage : " + Str(hashFound), RGB(128, 128, 128))
DrawText(10, py + 100, "width / height : " + Str(World\view_bounds\b[3] - World\view_bounds\b[2]) + " / " + Str(World\view_bounds\b[1] - World\view_bounds\b[0]) + " level:" + Str(World\root\level), RGB(128, 128, 128))
DrawText(10, py + 120, "x / y : " + Str(World\cursor\x) + " / " + Str(World\cursor\y), RGB(128, 128, 128))
DrawText(10, OutputHeight() - 25, "box: " + Str(countBox) + " pixel:" + Str(countPixel), RGB(0, 255, 0))
StopDrawing ()
EndProcedure
Procedure Game_Tick()
If Game\paused
ProcedureReturn
EndIf
Static time
time = ElapsedMilliseconds()
If time > Game\next_update_Time
World_Iterate(Pow(8, Game\generations_per_update))
Game\next_update_Time = time + Game\delay_per_update
EndIf
EndProcedure
Procedure Game_Run()
Protected event
Repeat
; Update anything that happens over time.
Game_Tick()
If ElapsedMilliseconds() > Game\redrawTime
; Re-draw the screen.
Game_Draw()
Game\redrawTime = ElapsedMilliseconds() + 125
EndIf
Repeat
event = WindowEvent()
If event = #PB_Event_CloseWindow
End
EndIf
Until event = 0
ForEver
EndProcedure
Procedure Game_Pause(state)
Game\paused = state
If Game\paused
SetGadgetText(#Gadget_Start, "START")
Else
SetGadgetText(#Gadget_Start, "PAUSE")
EndIf
EndProcedure
Procedure Game_Quit()
End
EndProcedure
;- -----------------------------------
Procedure ReadRule(line.s)
Protected ruleFound = #False
line = LCase(line)
If Left(line, 5) = "#rule"
line = RemoveString(Mid(line, 6), " ")
ruleFound = #True
ElseIf Left(line, 3) = "#r "
line = RemoveString(Mid(line, 4), " ")
ruleFound = #True
ElseIf FindString(line, "rule")
line = StringField(RemoveString(line, " "), 2, "rule=")
ruleFound = #True
EndIf
If ruleFound
If FindString(line, "b") = 0 And FindString(line, "s") = 0 And FindString(line, "/")
line = "s" + StringField(line, 1, "/") + "/b" + StringField(line, 2, "/")
EndIf
FreeArray(Rule())
Dim Rule(255, 255)
Protected *c.Character = @line, rIndex
While *c\c
If *c\c = 'b'
rIndex = 1
ElseIf *c\c = 's'
rIndex = 2
EndIf
*c + SizeOf(Character)
While rIndex And (*c\c >= '0' And *c\c <= '9')
Rule(Val(Chr(*c\c)), rIndex - 1) = 1
*c + SizeOf(Character)
Wend
Wend
EndIf
ProcedureReturn ruleFound
EndProcedure
Procedure ParseFileCells(name.s)
Protected file = ReadFile(#PB_Any, name)
Protected x.q, y.q
If IsFile(file)
ReadRule("#R B3/S23")
Game\description = ""
World\root = Node_Zero(#MAXLEVEL)
While Not Eof(file)
Protected line.s = Trim(ReadString(file))
If Left(line, 1) = "!"
Game\description + line + #CRLF$
Else
Protected *c.Character = @line
While *c\c
If *c\c = '.'
x + 1
ElseIf *c\c = 'O'
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, 1)
x + 1
EndIf
*c + SizeOf(Character)
Wend
y + 1
x = 0
EndIf
Wend
CloseFile(file)
World\root = Node_Compact(World\root)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure ParseFileLIF(name.s)
Protected file = ReadFile(#PB_Any, name)
Protected.q ofsX, x, y
ReadRule("#R B3/S23")
Game\description = ""
If IsFile(file)
World\root = Node_Zero(#MAXLEVEL)
Protected line.s = Trim(ReadString(file))
If Trim(LCase(line)) = "#life 1.05"
While Not Eof(file)
line.s = Trim(ReadString(file))
If Left(line, 1) = "#"
Game\description + line + #CRLF$
EndIf
Protected ruleFound
If ruleFound = #False
ruleFound = ReadRule(line)
EndIf
Protected *c.Character = @line
If line = "" Or *c\c = '!'
Continue
ElseIf *c\c = '#'
If FindString(line, "#P")
ofsX = Val(StringField(line, 2, " "))
y = Val(StringField(line, 3, " "))
EndIf
Else
x = ofsX
While *c\c
If *c\c = 10 Or *c\c = 13
Break
ElseIf *c\c <> '.'
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, 1)
EndIf
x + 1
*c + SizeOf(Character)
Wend
y + 1
EndIf
Wend
ElseIf Trim(LCase(line)) = "#life 1.06"
While Not Eof(file)
line.s = Trim(ReadString(file))
If ruleFound = #False
ruleFound = ReadRule(line)
EndIf
If Left(line, 1) = "#" : Continue : EndIf
x = Val(StringField(line, 1, " "))
y = -Val(StringField(line, 2, " "))
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, 1)
Wend
EndIf
CloseFile(file)
World\root = Node_Compact(World\root)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure ParseFileRLE(name.s)
Protected file = ReadFile(#PB_Any, name)
Protected.q x, y, i, count
Protected l.s
If IsFile(file)
ReadRule("#R B3/S23")
Game\description = ""
World\root = Node_Zero(#MAXLEVEL)
While Not Eof(file)
Protected line.s = Trim(ReadString(file))
Protected *c.Character = @line
If Left(line, 1) = "#"
Game\description + line + #CRLF$
EndIf
If *c\c = '#' : Continue : EndIf
Protected ruleFound
If ruleFound = #False
ruleFound = ReadRule(line)
EndIf
If *c\c = 'x' : Continue : EndIf
While *c\c
l = ""
While (*c\c >= '0' And *c\c <= '9')
l + Chr(*c\c)
*c + SizeOf(Character)
Wend
count = max(1, Val(l))
Select *c\c
Case '!'
Break
Case 'b'
x + count
Case '$'
y + count
x = 0
Case 'o'
For i = 1 To count
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, 1)
x + 1
Next
EndSelect
*c + SizeOf(Character)
Wend
Wend
CloseFile(file)
World\root = Node_Compact(World\root)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure ParseFileMCL(name.s)
Protected file = ReadFile(#PB_Any, name)
Protected.q x, y, i, count
Protected l.s
If IsFile(file)
ReadRule("#R B3/S23")
Game\description = ""
World\root = Node_Zero(#MAXLEVEL)
While Not Eof(file)
Protected line.s = Trim(ReadString(file))
If Left(line, 1) = "#"
Game\description + line + #CRLF$
If FindString(UCase(line), "WIREWORLD")
Game_SetRule("WIREWORLD")
EndIf
EndIf
Protected ruleFound
If ruleFound = #False
ruleFound = ReadRule(line)
EndIf
If Left(Line, 2) <> "#L"
Continue
EndIf
line = Mid(line, 4)
Protected *c.Character = @line
While *c\c
l = ""
While (*c\c >= '0' And *c\c <= '9')
l + Chr(*c\c)
*c + SizeOf(Character)
Wend
count = max(1, Val(l))
Select *c\c
Case '.'
x + count
Case '$'
y + count
x = 0
Case 'A' To 'X'
i = 1
While i <= count
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, *c\c - 'A' + 1)
x + 1
i + 1
Wend
EndSelect
*c + SizeOf(Character)
Wend
Wend
CloseFile(file)
World\root = Node_Compact(World\root)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure ParseFileMC(name.s)
Protected file = ReadFile(#PB_Any, name)
Protected.q x, y, l, n
Dim *pts(32000)
If IsFile(file)
ReadRule("#R B3/S23")
Game\description = ""
Dim pts(7, 7)
While Not Eof(file)
Protected line.s = Trim(ReadString(file))
If Left(line, 1) = "#"
Game\description + line + #CRLF$
If FindString(UCase(line), "WIREWORLD")
Game_SetRule("WIREWORLD")
EndIf
EndIf
Protected *c.Character = @line
If *c\c = '[' Or *c\c = '#'
Continue
EndIf
If *c\c = '$' Or *c\c = '*' Or *c\c = '.'
FreeArray(pts())
Dim pts(7, 7)
x = 0
y = 0
While *c\c
If *c\c = '$'
y + 1
x = 0
Else
pts(x, y) = Bool(*c\c = '*')
x + 1
EndIf
*c + SizeOf(Character)
Wend
; 0 1 2 3
; 01 23 45 67
;0 0 **|**|**|**
; 1 **|**|**|**
; --+--+--+--
;1 2 **|**|**|**
; 3 **|**|**|**
; --+--+--+--
;2 4 **|**|**|**
; 5 **|**|**|**
; --+--+--+--
;4 6 **|**|**|**
; 7 **|**|**|**
Protected lv, *n1, *n2, *n3, *n4
Dim *n(3, 3)
y = 0
While y < 4
x = 0
While x < 4
*n(x, y) = Node_Canonical(1, pts(x * 2, y * 2), pts(x * 2 + 1, y * 2), pts(x * 2, y * 2 + 1), pts(x * 2 + 1, y * 2 + 1))
x + 1
Wend
y + 1
Wend
lv = 3
*n1 = Node_Canonical(2, *n(0, 0), *n(1, 0), *n(0, 1), *n(1, 1))
*n2 = Node_Canonical(2, *n(2, 0), *n(3, 0), *n(2, 1), *n(3, 1))
*n3 = Node_Canonical(2, *n(0, 2), *n(1, 2), *n(0, 3), *n(1, 3))
*n4 = Node_Canonical(2, *n(2, 2), *n(3, 2), *n(2, 3), *n(3, 3))
Else
lv = Val(StringField(line, 1, " "))
*n1 = Val(StringField(line, 2, " "))
*n2 = Val(StringField(line, 3, " "))
*n3 = Val(StringField(line, 4, " "))
*n4 = Val(StringField(line, 5, " "))
If lv > 1
*n1 = *pts(*n1)
*n2 = *pts(*n2)
*n3 = *pts(*n3)
*n4 = *pts(*n4)
If *n1 = 0 : *n1 = Node_Zero(lv - 1): EndIf
If *n2 = 0 : *n2 = Node_Zero(lv - 1): EndIf
If *n3 = 0 : *n3 = Node_Zero(lv - 1): EndIf
If *n4 = 0 : *n4 = Node_Zero(lv - 1): EndIf
EndIf
EndIf
n + 1
If n > ArraySize(*pts())
ReDim *pts(ArraySize(*pts()) + 1000)
EndIf
*pts(n) = Node_Canonical(lv, *n1, *n2, *n3, *n4)
World\root = *pts(n)
Wend
CloseFile(file)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure ParseFile(name.s)
Protected res
Select LCase(GetExtensionPart(name))
Case "cells"
res = ParseFileCells(name)
Case "lif", "life"
res = ParseFileLIF(name)
Case "mc"
res = ParseFileMC(name)
Case "rle"
res = ParseFileRLE(name)
Case "mcl"
res = ParseFileMCL(name)
EndSelect
If res
SetWindowTitle(0, GetFilePart(name))
ProcedureReturn res
EndIf
ProcedureReturn #False
EndProcedure
Procedure Game_OpenFile(path.s = "", filename.s = "", speed = 2)
If path And filename
If ReceiveHTTPFile(path, filename) = 0
MessageRequester("", "failed to download file: " + #CRLF$ + path)
EndIf
ElseIf FileSize(filename) < 0
ProcedureReturn
EndIf
ClearList(Nodes())
Game\width = GadgetWidth(#Gadget_Canvas)
Game\height = GadgetHeight(#Gadget_Canvas)
Game\iteration_count = 0
Game\world = @World
Game_Pause(1)
Game_SetSpeed(speed)
Game_SetRule("GAMEOFLIFE")
hashPop = 0
hashPrime = Hash_NextPrime(1000)
hashLimit = hashPrime
FreeArray(*hashTab())
Dim *hashTab(hashPrime)
Define l
Pow2(0) = Pow(2, 0)
For l = 1 To #MAXLEVEL
Pow2(l) = Pow(2, l)
*zero(l) = Node_Canonical(l, *zero(l - 1), *zero(l - 1), *zero(l - 1), *zero(l - 1))
Next
If ParseFile(filename) = 0
ReadRule("#R B3/S23")
World\root = Node_Zero(#MAXLEVEL)
Protected x, y
Restore xypoints
Repeat
Read.i x
Read.i y
If x = -999
Break
Else
World\root = Node_SetPixel(World\root, Pow2(World\root\level - 1), x, y, 1)
EndIf
ForEver
EndIf
; Initialize the world. xypoints is a list of coordinates in the world
; that should be set to true, as (x,y) tuples.
If World\root
World\root = Node_Compact(World\root)
World_Center(World\root)
EndIf
DataSection
xypoints:
Data.i - 2, -2, -2, -1, -2, 2, -1, -2, -1, 1, 0, -2, 0, 1, 0, 2, 1, 0, 2, -2, 2, 0, 2, 1, 2, 2
Data.i - 999, -999
EndDataSection
EndProcedure
Procedure Event_Gadget()
Select EventGadget()
Case #Gadget_Start
If Game\paused
Game_Pause(0)
Else
Game_Pause(1)
EndIf
Case #Gadget_Step
Game_Pause(1)
World_Iterate(1)
Game_Draw()
Case #Gadget_Speed
Game_SetSpeed(GetGadgetState(#Gadget_Speed))
Case #Gadget_Center
World_Center(World\root)
Case #Gadget_Left, #Gadget_Right, #Gadget_Up, #Gadget_Down
World_ShiftView(EventGadget(), 50)
Case #Gadget_Canvas
Protected mx = GetGadgetAttribute(#Gadget_Canvas, #PB_Canvas_MouseX)
Protected my = GetGadgetAttribute(#Gadget_Canvas, #PB_Canvas_MouseY)
Protected scale.d = 0.0
World\cursor\x = ((mx - (Game\width + World\view_size) * 0.5) / World\view_size) + World\view_center\x
World\cursor\y = ((my - (Game\height + World\view_size) * 0.5) / World\view_size) + World\view_center\y
If EventType() = #PB_EventType_MouseWheel
If GetGadgetAttribute(#Gadget_Canvas, #PB_Canvas_WheelDelta) > 0
scale = 1 / 0.75
Else
scale = 1 * 0.75
EndIf
If World\view_size * scale < 256
World\view_size * scale
Else
scale = 0
EndIf
ElseIf EventType() = #PB_EventType_KeyDown
Protected key = GetGadgetAttribute(#Gadget_Canvas, #PB_Canvas_Key)
Select key
Case #PB_Shortcut_F
World_Center(World\root)
Case #PB_Shortcut_G
Node_GarbageCollection()
Case #PB_Shortcut_1
Node_SetPixelState(World\cursor\x, World\cursor\y, 0)
Case #PB_Shortcut_2
Node_SetPixelState(World\cursor\x, World\cursor\y, 1)
Case #PB_Shortcut_3
Node_SetPixelState(World\cursor\x, World\cursor\y, 2)
Case #PB_Shortcut_4
Node_SetPixelState(World\cursor\x, World\cursor\y, 3)
Case #PB_Shortcut_Down, #PB_Shortcut_Up, #PB_Shortcut_Left, #PB_Shortcut_Right
World_ShiftView(key, 50)
Case #PB_Shortcut_PageDown, #PB_Shortcut_A
; Zoom in.
scale = 1 / 0.75
If World\view_size * scale < 256
World\view_size * scale
Else
scale = 0
EndIf
Case #PB_Shortcut_PageUp, #PB_Shortcut_Y
; Zoom out.
scale = 1 * 0.75
If World\view_size * scale > 0
World\view_size * scale
Else
scale = 0
EndIf
EndSelect
Game\redrawTime = 0
EndIf
If scale
mx - Game\width / 2
my - Game\height / 2
World\view_center\x - ((mx - mx * scale) / World\view_size)
World\view_center\y - ((my - my * scale) / World\view_size)
Game\redrawTime = 0
EndIf
EndSelect
If EventGadget() <> #Gadget_Canvas
SetActiveGadget(#Gadget_Canvas)
EndIf
EndProcedure
Procedure Event_Menu()
Select EventMenu()
Case #Menu_Open
Game_OpenFile("", OpenFileRequester("", #PB_Compiler_FilePath, "Cell-Files|*.cells;*.lif;*.life;*.mc;*.rle;*.mcl", 0))
Case #Menu_Quit
Game_Quit()
Case #Menu_RuleGameOfLife
Game_SetRule("GAMEOFLIFE")
SetMenuItemState(0, #Menu_RuleGameOfLife, 1)
SetMenuItemState(0, #Menu_RuleWireWorld, 0)
Case #Menu_RuleWireWorld
Game_SetRule("WIREWORLD")
SetMenuItemState(0, #Menu_RuleGameOfLife, 0)
SetMenuItemState(0, #Menu_RuleWireWorld, 1)
Case #Menu_ShowQuadTree
If GetMenuItemState(0, #Menu_ShowQuadTree) = 0
SetMenuItemState(0, #Menu_ShowQuadTree, 1)
Else
SetMenuItemState(0, #Menu_ShowQuadTree, 0)
EndIf
Game\drawTree = GetMenuItemState(0, #Menu_ShowQuadTree)
Case #Menu_ShowDescription
If game\description
MessageRequester("Description", game\description)
Else
MessageRequester("Description", "No Description")
EndIf
EndSelect
SetActiveGadget(#Gadget_Canvas)
EndProcedure
OpenWindow(0, 0, 0, 800, 600, "HashLife", #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_Maximize)
CreateMenu(0, WindowID(0))
MenuTitle("File")
MenuItem(#Menu_Open, "Open")
MenuItem(#Menu_Quit, "Quit")
MenuTitle("Options")
OpenSubMenu("Rule")
MenuItem(#Menu_RuleGameOfLife, "Game of life")
MenuItem(#Menu_RuleWireWorld, "Wireworld")
CloseSubMenu()
MenuItem(#Menu_ShowQuadTree, "Draw QuadTree")
MenuItem(#Menu_ShowDescription, "Show Description")
SetMenuItemState(0, #Menu_RuleGameOfLife, 1)
SetMenuItemState(0, #Menu_ShowQuadTree, 0)
CanvasGadget(#Gadget_Canvas, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 40, #PB_Canvas_Keyboard | #PB_Canvas_Border | #PB_Canvas_Container)
TrackBarGadget(#Gadget_Speed, 10, 10, 100, 25, 0, 10, #PB_TrackBar_Ticks)
ButtonGadget(#Gadget_Step, 10, 40, 100, 25, "Step")
ButtonGadget(#Gadget_Start, 10, 70, 100, 35, "")
ButtonGadget(#Gadget_Up, 50, 120, 20, 20, "↑")
ButtonGadget(#Gadget_Center, 35, 140, 50, 50, "Center")
ButtonGadget(#Gadget_Down, 50, 190, 20, 20, "↓")
ButtonGadget(#Gadget_Left, 15, 155, 20, 20, "←")
ButtonGadget(#Gadget_Right, 85, 155, 20, 20, "→")
CloseGadgetList()
SetActiveGadget(#Gadget_Canvas)
BindGadgetEvent(#Gadget_Start, @Event_Gadget())
BindGadgetEvent(#Gadget_Step, @Event_Gadget())
BindGadgetEvent(#Gadget_Canvas, @Event_Gadget())
BindGadgetEvent(#Gadget_Speed, @Event_Gadget())
BindGadgetEvent(#Gadget_Center, @Event_Gadget())
BindGadgetEvent(#Gadget_Left, @Event_Gadget())
BindGadgetEvent(#Gadget_Right, @Event_Gadget())
BindGadgetEvent(#Gadget_Up, @Event_Gadget())
BindGadgetEvent(#Gadget_Down, @Event_Gadget())
BindMenuEvent(0, #Menu_Open, @Event_Menu())
BindMenuEvent(0, #Menu_Quit, @Event_Menu())
BindMenuEvent(0, #Menu_RuleGameOfLife, @Event_Menu())
BindMenuEvent(0, #Menu_RuleWireWorld, @Event_Menu())
BindMenuEvent(0, #Menu_ShowQuadTree, @Event_Menu())
BindMenuEvent(0, #Menu_ShowDescription, @Event_Menu())
Game_OpenFile()
Game_OpenFile("https://github.com/ngmsoftware/hashlife/raw/master/metapixel-galaxy.mc", GetTemporaryDirectory() + "metapixel-galaxy.mc" , 5)
;Game_OpenFile("https://github.com/jimblandy/golly/raw/master/src/Patterns/WireWorld/primes.mc", GetTemporaryDirectory() + "primes.mc", 5)
Game_Run()
