This is a game, only if you consider a "game" something quite boring where you don't have many things to do.. :roll:
The rules are very simple:
- When you click on a cylinder, it rotates 90° clockwise.
- If one of the "arms" on the top of the cylinder touches one arms of another cylinder, the two rotates 90° again.
- You score 1 point for each rotating cylinder.
- If there's no more rotating cylinder, your score goes back to zero.
- The goal is to initiate the longest possible chain reaction, and thus to get the highest score.
Controls:
- Right-click: mouse look
- + / - (or mouse wheel): Zoom / unzoom
- Space: randomize all cylinders' positions
Note:
This program uses CEgui; you'll need to unzip the "GUI" directory in this file http://keleb.free.fr/codecorner/downloa ... ic/GUI.zip ) in the game directory, or else the crash is pretty violent

Have fun!
Code: Select all
;- Initialization
Global FullScreen.b
Resultat = MessageRequester("Contact!","Full Screen ?",#PB_MessageRequester_YesNo)
If Resultat = 6
FullScreen=#True
Else
FullScreen=#False
EndIf
If InitEngine3D("engine3d.dll") = 0
MessageRequester( "Error" , "Can't initialize 3D, check if engine3D.dll is available" , 0 )
End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester( "Error" , "Can't find DirectX 7.0 or above" , 0 )
End
EndIf
Add3DArchive(".", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\schemes", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\imagesets", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\fonts", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\looknfeel", #PB_3DArchive_FileSystem)
Add3DArchive("GUI\layouts", #PB_3DArchive_FileSystem)
If Fullscreen = #True
OpenScreen(800,600,32,"Contact!")
Else
OpenWindow(0,0, 0, 800 , 600 ,"Contact!")
OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf
;- Structures and global definitions
Structure Vertex
px.f
py.f
pz.f
nx.f
ny.f
nz.f
Couleur.l
U.f
V.f
EndStructure
Structure Polygon
numVert1.w
numVert2.w
numVert3.w
EndStructure
Enumeration
#tetrahedron
#cube
#octahedron
#dodecahedron
#icosahedron
EndEnumeration
Enumeration
#Window3D
#Score
EndEnumeration
Enumeration
#CYLCAP_NONE
#CYLCAP_BOTH
#CYLCAP_TOP
#CYLCAP_BOTTOM
EndEnumeration
Structure coord3D
X.f
Y.f
Z.f
EndStructure
Structure plateau
boardSizeX.l
boardSizeY.l
nbcylinders.l
EndStructure
Structure cylinder_struct
rot.f ; angle Y of the contact
status.l ; 0=facing north; 1=east; 2=south; 3=west
rotToDo.f ; rotation left To target position
isRotating.b ; indicate If the cylinder is rotating Or Not
north.b ; can a contact be made To north
east.b
south.b
west.b
cylinderToNorth.l ; What cylinder is to the north of this one ? (0 = none)
cylinderToEast.l
cylinderToSouth.l
cylinderToWest.l
numBaseNode.l
EndStructure
Structure doneMoving_struct
numCylinder.l
*ptrMovingToDelete
EndStructure
; Initialization
Global contactMade.b,mouseHidden.b
Global mousePosX.l,movex.l,mousePosY.l,moveY.l,moveZ.l
Global score.l, oldScore.l, bestScore.l
Global selectedEntity.l,selectedCylinder.l,oldSelected.l
Global num.l, i.l
; Initializes the game board
Global thisBoard.plateau
thisBoard\boardSizeX=16:thisBoard\boardSizeY=16
thisBoard\nbcylinders=thisBoard\boardSizeX*thisBoard\boardSizeY
; Initializes the cylinders
Global Dim cylinder.cylinder_struct(thisBoard\nbcylinders)
Global NewList moving.l()
Global NewList doneMoving.doneMoving_struct()
Global angle.f,angle2.f
Global Dim armsAngle.f(90)
; Camera variables
Global camcenter.coord3D
Global camdist.f,bearing.f,azimuth.f
Global camchanged.b
Global cylinderAtCenter.l
; forced-timing variables
Global Dim timer(10)
Global currentTimer.l,oldTimer.l,numTimer.l,speedFactor.f
;- ------ Procedures ------
EnableExplicit
;- -- Meshes and entities --
;************************************************************************************
; Name: createBoxMesh
; Purpose: create a "box" mesh
; Parameters:
; - number of subdivisions (given "3", each face of the box will be a 3x3 grid)
; - sizeX, sizeY, sizeZ : size of the box
; - pivotX, pivotY, pivotZ : location of the pivot of the box, around which it rotates (default = center = 0,0,0)
; - Uorigin, Vorigin : UV map coordinates (default = top left of the map = 0,0)
; - Uscale, Vscale : UV map scale (default = 1,1)
; - color of the vertices (default = white)
; Return-Value: number of the resulting mesh, -1 if creation failed
;************************************************************************************
Procedure.l createBoxMesh(nbdiv.w,sizeX.f,sizeY.f,sizeZ.f,pivotX.f = 0,pivotY.f = 0,pivotZ.f = 0,Uorigin.f = 0,Vorigin.f = 0,Uscale.f = 0,Vscale.f = 0,color.l = $FFFFFF)
Protected sizediv.f
Protected x1.f,y1.f,z1.f ; vertex position
Protected x2.f,y2.f,z2.f ; vertex position
Protected x3.f,y3.f,z3.f ; vertex position
Protected x4.f,y4.f,z4.f ; vertex position
Protected nx.f,ny.f,nz.f ; vertex normals
Protected u.f,v.f ; vertex UV coords (texture mapping)
Protected numvert.w,numvert0.w ; vertices of a poly
Protected *PtrV.Vertex,*PtrV0.Vertex ; vertices buffer in memory
Protected *ptrP.Polygon,*ptrP0.Polygon ; Polys buffer in memory
Protected *vertexBuffer.l
Protected *polygonBuffer.l
Protected num.l,i.l,j.l,nbtri.l,nbvert
Protected maxSize.f
Protected newmesh.l ; Procedure Result
nbtri = 6 * (nbDiv * nbDiv * 2) ; 6 sides * nb divisions * nb divisions * 2 triangles per division
nbvert = 6 * (nbDiv * nbDiv * 4) ; 6 sides * nb divisions * nb divisions * 4 vertices per division
; Allocate the needed memory for vertices
*vertexBuffer = AllocateMemory(SizeOf(Vertex)*nbVert)
*PtrV = *vertexBuffer
; Allocate the needed memory for faces info
*polygonBuffer=AllocateMemory(SizeOf(Polygon)*nbTri)
*ptrP=*polygonBuffer
sizeDiv = 1/nbDiv
; Top
x1=-0.5:y1=0.5:z1=-0.5
x2=-0.5+sizeDiv:y2=0.5:z2 = z1
x3=x2:y3=0.5:z3=-0.5+sizeDiv
x4=x1:y4=0.5:z4=z3
For i=1 To nbDiv
For j=1 To nbDiv
; 1 square = 4 vertices
*PtrV\px = x1
*PtrV\py = y1
*PtrV\pz = z1
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = color
*PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
*PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
*PtrV + SizeOf(Vertex)
*PtrV\px = x2
*PtrV\py = y2
*PtrV\pz = z2
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = color
*PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
*PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
*PtrV + SizeOf(Vertex)
*PtrV\px = x3
*PtrV\py = y3
*PtrV\pz = z3
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = color
*PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
*PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
*PtrV + SizeOf(Vertex)
*PtrV\px = x4
*PtrV\py = y4
*PtrV\pz = z4
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = color
*PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
*PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
*PtrV + SizeOf(Vertex)
; 1 square = 2 triangles
*ptrP\numVert1=numvert+3
*ptrP\numVert2=numvert+2
*ptrP\numVert3=numvert
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert
*ptrP\numVert2=numvert+2
*ptrP\numVert3=numvert+1
*ptrP + SizeOf(Polygon)
numvert+4
z1=z4
z2=z3
z3+sizeDiv
z4=z3
Next j
x1=x2
x4=x3
x2+sizeDiv
x3=x2
z1=-0.5
z2=z1
z3=-0.5+sizeDiv
z4=z3
Next i
numvert0=numvert
; Bottom
*PtrV0 = *vertexBuffer
For i=1 To numvert0
*PtrV\px = -*PtrV0\px
*PtrV\py = -*PtrV0\py
*PtrV\pz = *PtrV0\pz
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = *PtrV0\couleur
*PtrV\u = *PtrV0\u
*PtrV\v = *PtrV0\v
*PtrV + SizeOf(Vertex)
*PtrV0 + SizeOf(Vertex)
numvert+1
If i%4=0
*ptrP\numVert1=numvert - 2
*ptrP\numVert2=numvert - 3
*ptrP\numVert3=numvert - 4
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert - 4
*ptrP\numVert2=numvert - 1
*ptrP\numVert3=numvert - 2
*ptrP + SizeOf(Polygon)
EndIf
Next i
; Right
*PtrV0 = *vertexBuffer
For i=1 To numvert0
*PtrV\px = *PtrV0\py
*PtrV\py = -*PtrV0\px
*PtrV\pz = *PtrV0\pz
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = *PtrV0\couleur
*PtrV\u = 1-*PtrV0\v
*PtrV\v = *PtrV0\u
*PtrV + SizeOf(Vertex)
*PtrV0 + SizeOf(Vertex)
numvert+1
If i%4=0
*ptrP\numVert1=numvert - 2
*ptrP\numVert2=numvert - 3
*ptrP\numVert3=numvert - 4
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert - 4
*ptrP\numVert2=numvert - 1
*ptrP\numVert3=numvert - 2
*ptrP + SizeOf(Polygon)
EndIf
Next i
; Left
*PtrV0 = *vertexBuffer
For i=1 To numvert0
*PtrV\px = -*PtrV0\py
*PtrV\py = -*PtrV0\px
*PtrV\pz = *PtrV0\pz
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = *PtrV0\couleur
*PtrV\u = *PtrV0\v
*PtrV\v = *PtrV0\u
*PtrV + SizeOf(Vertex)
*PtrV0 + SizeOf(Vertex)
numvert+1
If i%4=0
*ptrP\numVert1=numvert - 4
*ptrP\numVert2=numvert - 3
*ptrP\numVert3=numvert - 2
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert - 2
*ptrP\numVert2=numvert - 1
*ptrP\numVert3=numvert - 4
*ptrP + SizeOf(Polygon)
EndIf
Next i
; Front
*PtrV0 = *vertexBuffer
For i=1 To numvert0
*PtrV\px = -*PtrV0\pz
*PtrV\py = -*PtrV0\px
*PtrV\pz = -*PtrV0\py
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = *PtrV0\couleur
*PtrV\u = *PtrV0\v
*PtrV\v = *PtrV0\u
*PtrV + SizeOf(Vertex)
*PtrV0 + SizeOf(Vertex)
numvert+1
If i%4=0
*ptrP\numVert1=numvert - 4
*ptrP\numVert2=numvert - 3
*ptrP\numVert3=numvert - 2
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert - 2
*ptrP\numVert2=numvert - 1
*ptrP\numVert3=numvert - 4
*ptrP + SizeOf(Polygon)
EndIf
Next i
; Back
*PtrV0 = *vertexBuffer
For i=1 To numvert0
*PtrV\px = -*PtrV0\pz
*PtrV\py = -*PtrV0\px
*PtrV\pz = *PtrV0\py
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
*PtrV\couleur = *PtrV0\couleur
*PtrV\u = 1-*PtrV0\v
*PtrV\v = *PtrV0\u
*PtrV + SizeOf(Vertex)
*PtrV0 + SizeOf(Vertex)
numvert+1
If i%4=0
*ptrP\numVert1=numvert - 2
*ptrP\numVert2=numvert - 3
*ptrP\numVert3=numvert - 4
*ptrP + SizeOf(Polygon)
*ptrP\numVert1=numvert - 4
*ptrP\numVert2=numvert - 1
*ptrP\numVert3=numvert - 2
*ptrP + SizeOf(Polygon)
EndIf
Next i
; Resize
If sizeX<>1 Or sizeY<>1 Or sizeZ<>1
*ptrV = *vertexBuffer
For i=1 To nbVert
*PtrV\px = *PtrV\px*sizeX - pivotX
*PtrV\py = *PtrV\py*sizeY - pivotY
*PtrV\pz = *PtrV\pz*sizeZ - pivotZ
*PtrV+SizeOf(vertex)
Next i
EndIf
; Create mesh from stored infos
maxSize = sizeX
If sizeY > sizeX
maxSize = sizeY
EndIf
If sizeZ > maxSize
maxSize = sizeZ
EndIf
newMesh = CreateMesh(#PB_Any,maxSize)
If IsMesh(newMesh)
SetMeshData(newMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,*vertexBuffer,nbVert)
SetMeshData(newMesh,#PB_Mesh_Face,*polygonBuffer,nbTri)
FreeMemory(*vertexBuffer)
FreeMemory(*polygonBuffer)
ProcedureReturn newMesh
Else
; free memory if "createMesh" has failed
FreeMemory(*vertexBuffer)
FreeMemory(*polygonBuffer)
ProcedureReturn -1
EndIf
EndProcedure
;************************************************************************************
; Name: createCylinderMesh
; Purpose: create a cylinder mesh
; Parameters:
; - number of sides ("3" gives a prism, "4" gives a box)
; - height
; - radius
; - uncapped (=0), caps on top an bottom (=1), top cap only (=2), bottom cap only (=3). (default = 1)
; - color of the vertices (default = white)
; Return-Value: number of the resulting mesh, -1 if creation failed
;************************************************************************************
Procedure.l createCylinderMesh(nbSides.l,height.f,radius.f,capped.b = 1,coul.l = $FFFFFF)
Protected *PtrV.Vertex,*vertexBuffer.l ; vertices buffer in memory
Protected *PtrF.Polygon,*facetriBuffer.l ; Faces buffer in memory
Protected i.l,nbVert.l,nbTri.l, numVertTop.l,numVertBottom.l
Protected h2.f,theta.f
Protected newmesh.l ; Procedure Result
If nbSides<3
ProcedureReturn 0
EndIf
h2 = height / 2.0
nbVert = 4*(nbSides+1)+2
If capped = #CYLCAP_TOP Or capped = #CYLCAP_BOTTOM
nbVert-1
Else
If capped = #CYLCAP_NONE
nbVert-2
EndIf
EndIf
*vertexBuffer = AllocateMemory(SizeOf(Vertex)*nbVert)
*PtrV = *vertexBuffer
;Vertices at the bottom of the cylinder
For i = 0 To nbSides
theta =2*#PI*i/nbSides
*PtrV\px = radius*Cos(theta)
*PtrV\py = -h2
*PtrV\pz = radius*Sin(theta)
*PtrV\nx = Cos(theta)
*PtrV\ny = 0
*PtrV\nz = Sin(theta)
*PtrV\couleur = Coul
*PtrV\u = Theta / (2.0*#PI)
*PtrV\v = 0
*PtrV + SizeOf(Vertex)
Next i
;Vertices at the top of the cylinder
For i = 0 To nbSides
theta =2*#PI*i/nbSides
*PtrV\px = radius*Cos(theta)
*PtrV\py = h2
*PtrV\pz = radius*Sin(theta)
*PtrV\nx = Cos(theta)
*PtrV\ny = 0
*PtrV\nz = Sin(theta)
*PtrV\couleur = Coul
*PtrV\u = Theta / (2.0*#PI)
*PtrV\v = 1
*PtrV + SizeOf(Vertex)
Next i
;Vertices at the bottom of the cylinder
For i = 0 To nbSides
theta =2*#PI*i/nbSides
*PtrV\px = radius*Cos(theta)
*PtrV\py = -h2
*PtrV\pz = radius*Sin(theta)
*PtrV\nx = 0
*PtrV\ny = -1
*PtrV\nz = 0
*PtrV\couleur = Coul
*PtrV\u = Theta / (2.0*#PI)
*PtrV\v = 1
*PtrV + SizeOf(Vertex)
Next i
;Vertices at the top of the cylinder
For i = 0 To nbSides
theta =2*#PI*i/nbSides
*PtrV\px = radius*Cos(theta)
*PtrV\py = h2
*PtrV\pz = radius*Sin(theta)
*PtrV\nx = 0
*PtrV\ny = 1
*PtrV\nz = 0
*PtrV\couleur = Coul
*PtrV\u = Theta / (2.0*#PI)
*PtrV\v = 1
*PtrV + SizeOf(Vertex)
Next i
;Bottom cap center
If capped = #CYLCAP_BOTH Or capped = #CYLCAP_BOTTOM
numVertBottom = (*PtrV - *vertexBuffer) / SizeOf(Vertex)
*PtrV\px = 0
*PtrV\py = -h2
*PtrV\pz = 0
*PtrV\nx = 0
*PtrV\ny = -1
*PtrV\nz = 0
*PtrV\couleur = Coul
*PtrV\u = 0.5
*PtrV\v = 0.5
*PtrV + SizeOf(Vertex)
EndIf
;Top cap center
If capped = #CYLCAP_BOTH Or capped = #CYLCAP_TOP
numVertTop = (*PtrV - *vertexBuffer) / SizeOf(Vertex)
*PtrV\px = 0
*PtrV\py = h2
*PtrV\pz = 0
*PtrV\nx = 0
*PtrV\ny = 1
*PtrV\nz = 0
*PtrV\couleur = Coul
*PtrV\u = 0.5
*PtrV\v = 0.5
EndIf
;Facets
nbTri = 4*nbSides
If capped = #CYLCAP_BOTTOM Or capped = #CYLCAP_TOP
nbTri - nbSides
Else
If capped = #CYLCAP_NONE
nbTri - (nbSides*2)
EndIf
EndIf
*facetriBuffer=AllocateMemory(SizeOf(Polygon)*nbTri)
*PtrF=*facetriBuffer
For i=0 To nbSides-1
*PtrF\numVert3=i
*PtrF\numVert2=i + 1
*PtrF\numVert1=nbSides + i + 2
*PtrF + SizeOf(Polygon)
*PtrF\numVert1=i
*PtrF\numVert3=nbSides + i + 2
*PtrF\numVert2=nbSides + i + 1
*PtrF + SizeOf(Polygon)
Next i
;Bottom cap
If capped = #CYLCAP_BOTH Or capped = #CYLCAP_BOTTOM
For i=0 To nbSides-1
*PtrF\numVert1= numVertBottom
*PtrF\numVert2= 2 * nbSides + 2 + i
*PtrF\numVert3= 2 * nbSides + 3 + i
*PtrF + SizeOf(Polygon)
Next i
EndIf
;Top cap
If capped = #CYLCAP_BOTH Or capped = #CYLCAP_TOP
For i=0 To nbSides-1
*PtrF\numVert1= numVertTop
*PtrF\numVert3= 3 * nbSides + 3 + i
*PtrF\numVert2= 3 * nbSides + 4 + i
*PtrF + SizeOf(Polygon)
Next i
EndIf
; Create mesh from stored infos
newmesh = CreateMesh(#PB_Any,radius)
If IsMesh(newmesh)
SetMeshData(newmesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,*vertexBuffer,nbVert)
SetMeshData(newmesh,#PB_Mesh_Face,*facetriBuffer,nbTri)
; and don't forget to free memory
FreeMemory(*vertexBuffer)
FreeMemory(*facetriBuffer)
ProcedureReturn newmesh
Else
; even if "createMesh" has failed
FreeMemory(*vertexBuffer)
FreeMemory(*facetriBuffer)
ProcedureReturn -1
EndIf
EndProcedure
;************************************************************************************
; Name: createCylinderEntities
; Purpose: Constructs a "board" of X x Y cylinders, each one made of 8 entities
; Parameters:
; - X size of the Board
; - Y size of the Board
; Return-Value: none
;************************************************************************************
Procedure createCylinderEntities(boardSizeX.l,boardSizeY.l)
Protected cylMesh.l,cylMesh2.l ; cylinder meshes
Protected armPart11.l,armPart12.l,armPart13.l,armPart21.l,armPart22.l,armPart23.l ; "arms" meshes
Protected i.l,j.l,c.l
Protected numEntity.l,numCylinder.l
Protected numMaterial.l
; Create meshes
cylMesh = CreateCylinderMesh(12,5,4,2,RGB(255,0,0))
cylMesh2 = CreateCylinderMesh(6,2,0.5,2,RGB(0,0,255))
armPart11 = createBoxMesh(1,1.5,0.2,1, -0.75,0,0,0,0,1,1,RGB(0,127,255))
armPart12 = createBoxMesh(1,1.2,0.2,1, -0.6,0,0,0,0,1,1,RGB(0,191,255))
armPart13 = createBoxMesh(1,1.2,0.2,1, -0.6,0,0,0,0,1,1,RGB(0,255,255))
armPart21 = createBoxMesh(1,1,0.2,1.5, 0,0,0.75,0,0,1,1,RGB(0,127,255))
armPart22 = createBoxMesh(1,1,0.2,1.2, 0,0,0.6,0,0,1,1,RGB(0,191,255))
armPart23 = createBoxMesh(1,1,0.2,1.2, 0,0,0.6,0,0,1,1,RGB(0,255,255))
; Create textures
CreateImage(1,128,128)
StartDrawing(ImageOutput(1))
Box(0,0,127,127,$FFFFFF)
SaveImage(1,"temp2.bmp")
For i=1 To 10
c=100+Random(127)
Box(Random(120),Random(120),Random(40),Random(40),RGB(c,c,c))
Next i
StopDrawing()
SaveImage(1,"temp1.bmp")
FreeImage(1)
LoadTexture(1,"temp1.bmp")
LoadTexture(2,"temp2.bmp")
DeleteFile("temp1.bmp")
DeleteFile("temp2.bmp")
; Create materials
; 0 = default cylinder
; 1 -> 90 = materials for rotating cylinders (gradient from green to blue)
; 99 = material for the "arms"
; 999 = white material for selected cylinder
CreateMaterial(0,TextureID(1))
MaterialAmbientColor(0, #PB_Material_AmbientColors)
For i=1 To 90
CreateMaterial(i,TextureID(1))
MaterialAmbientColor(i,RGB(i,75+(i*2),255-(i*2)) )
Next i
CreateMaterial(99,TextureID(2))
MaterialAmbientColor(99, #PB_Material_AmbientColors)
CreateMaterial(999,TextureID(2))
; Create the cylinders
numEntity=1:numCylinder=1
numMaterial = MaterialID(99)
For j=1 To boardSizeY
For i=1 To boardSizeX
; The first 8 entities are created, the others are copied from these first ones
If numEntity=1
CreateEntity(numEntity,MeshID(cylMesh),MaterialID(0))
CreateEntity(numEntity+1,MeshID(cylMesh2),numMaterial)
CreateEntity(numEntity+2,MeshID(armPart21),numMaterial)
CreateEntity(numEntity+3,MeshID(armPart22),numMaterial)
CreateEntity(numEntity+4,MeshID(armPart23),numMaterial)
CreateEntity(numEntity+5,MeshID(armPart11),numMaterial)
CreateEntity(numEntity+6,MeshID(armPart12),numMaterial)
CreateEntity(numEntity+7,MeshID(armPart13),numMaterial)
Else
CopyEntity(1,numEntity)
CopyEntity(2,numEntity+1)
CopyEntity(3,numEntity+2)
CopyEntity(4,numEntity+3)
CopyEntity(5,numEntity+4)
CopyEntity(6,numEntity+5)
CopyEntity(7,numEntity+6)
CopyEntity(8,numEntity+7)
EndIf
; Parent node (cylinder)
CreateNode(numEntity)
AttachNodeObject(numEntity,EntityID(numEntity),#PB_Node_Entity)
; Child nodes (arms)
CreateNode(numEntity+1)
AttachNodeObject(numEntity+1,EntityID(numEntity+1),#PB_Node_Entity)
NodeLocate(numEntity+1,0,2,0)
CreateNode(numEntity+2)
AttachNodeObject(numEntity+2,EntityID(numEntity+2),#PB_Node_Entity)
NodeLocate(numEntity+2,0,0.6,0)
CreateNode(numEntity+3)
AttachNodeObject(numEntity+3,EntityID(numEntity+3),#PB_Node_Entity)
NodeLocate(numEntity+3,0,0,-1.5)
CreateNode(numEntity+4)
AttachNodeObject(numEntity+4,EntityID(numEntity+4),#PB_Node_Entity)
NodeLocate(numEntity+4,0,0,-1.2)
CreateNode(numEntity+5)
AttachNodeObject(numEntity+5,EntityID(numEntity+5),#PB_Node_Entity)
NodeLocate(numEntity+5,0,0.6,0)
CreateNode(numEntity+6)
AttachNodeObject(numEntity+6,EntityID(numEntity+6),#PB_Node_Entity)
NodeLocate(numEntity+6,1.5,0,0)
CreateNode(numEntity+7)
AttachNodeObject(numEntity+7,EntityID(numEntity+7),#PB_Node_Entity)
NodeLocate(numEntity+7,1.2,0,0)
; Attach nodes together
AttachNodeObject(numEntity,NodeID(numEntity+1),#PB_Node_Node)
AttachNodeObject(numEntity+1,NodeID(numEntity+2),#PB_Node_Node)
AttachNodeObject(numEntity+2,NodeID(numEntity+3),#PB_Node_Node)
AttachNodeObject(numEntity+3,NodeID(numEntity+4),#PB_Node_Node)
AttachNodeObject(numEntity+1,NodeID(numEntity+5),#PB_Node_Node)
AttachNodeObject(numEntity+5,NodeID(numEntity+6),#PB_Node_Node)
AttachNodeObject(numEntity+6,NodeID(numEntity+7),#PB_Node_Node)
; Place cylinder on the "board"
NodeLocate(numEntity,i*8,0,j*8)
; Store cylinder infos
cylinder(numCylinder)\numBaseNode = numEntity
cylinder(numCylinder)\rot=0
cylinder(numCylinder)\status=0
cylinder(numCylinder)\rotToDo=0.0
cylinder(numCylinder)\isRotating=#False
cylinder(numCylinder)\north=#True
cylinder(numCylinder)\east=#True
cylinder(numCylinder)\south=#False
cylinder(numCylinder)\west=#False
If i>1
cylinder(numCylinder)\cylinderToWest=numCylinder-1
EndIf
If i<boardSizeX
cylinder(numCylinder)\cylinderToEast=numCylinder+1
EndIf
If j>1
cylinder(numCylinder)\cylinderToNorth=numCylinder-boardSizeX
EndIf
If j<thisBoard\boardSizeY
cylinder(numCylinder)\cylinderToSouth=numCylinder+boardSizeX
EndIf
numEntity+8
numCylinder+1
Next i
Next j
EndProcedure
;- -- Game logic --
; (NB: all rotations in the game are clockwise)
;************************************************************************************
; Name: cylinderRotateContacts
; Purpose: Rotates the contacts of a cylinder (in the linked list, not on screen)
; Parameters:
; - number of the cylinder to rotate
; Return-Value: none
;************************************************************************************
Procedure cylinderRotateContacts(num.l)
Protected temp.b
temp=cylinder(num)\west
cylinder(num)\west=cylinder(num)\south
cylinder(num)\south=cylinder(num)\east
cylinder(num)\east=cylinder(num)\north
cylinder(num)\north=temp
If cylinder(num)\status=3
cylinder(num)\status=0
Else
cylinder(num)\status=cylinder(num)\status+1
EndIf
EndProcedure
;************************************************************************************
; Name: cylinderRandomize
; Purpose: Rotates the contacts of a cylinder at random, trying to avoid contact with
; the 4 neighbours (North, South, East, West)
; Parameters:
; - number of the cylinder to rotate
; Return-Value: none
;************************************************************************************
Procedure cylinderRandomize(num.l)
Protected newpos.l,nbrot.l,i.l
newpos = Random( 3 )
nbrot=Abs(newpos - cylinder(num)\status)
For i=1 To nbrot
cylinderRotateContacts(num)
Next i
cylinder(num)\rot=cylinder(num)\status*90
RotateNode(cylinder(num)\numBaseNode,0,360-cylinder(num)\rot,0)
EndProcedure
;************************************************************************************
; Name: cylinderIsContactMade
; Purpose: Tests if at least one contact is made with the neighbours
; Parameters:
; - number of the cylinder to test
; Return-Value: #True if at least one contact is found
;************************************************************************************
Procedure.b cylinderIsContactMade(num.l)
If cylinder(num)\north=#True And cylinder(cylinder(num)\cylinderToNorth)\south=#True And cylinder(cylinder(num)\cylinderToNorth)\isRotating=#False
ProcedureReturn #True
EndIf
If cylinder(num)\east=#True And cylinder(cylinder(num)\cylinderToEast)\west=#True And cylinder(cylinder(num)\cylinderToEast)\isRotating=#False
ProcedureReturn #True
EndIf
If cylinder(num)\south=#True And cylinder(cylinder(num)\cylinderToSouth)\north=#True And cylinder(cylinder(num)\cylinderToSouth)\isRotating=#False
ProcedureReturn #True
EndIf
If cylinder(num)\west=#True And cylinder(cylinder(num)\cylinderToWest)\east=#True And cylinder(cylinder(num)\cylinderToWest)\isRotating=#False
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;************************************************************************************
; Name: plateauRandomizeAll
; Purpose: Randomizes all the cylinders
; Parameters: none
; Return-Value: none
;************************************************************************************
Procedure plateauRandomizeAll()
Protected i.l,numrot.l
For i=1 To thisBoard\nbcylinders
cylinderRandomize(i)
Next i
For i=1 To thisBoard\nbcylinders
If cylinderIsContactMade(i)=#True
numrot=0
Repeat
cylinderRotateContacts(i)
numrot+1
Until cylinderIsContactMade(i)=#False Or numrot=3
cylinder(i)\rot=cylinder(i)\status*90
RotateNode(cylinder(i)\numBaseNode,0,360-cylinder(i)\rot,0)
EndIf
Next i
EndProcedure
;************************************************************************************
; Name: cylinderInitiateRotation
; Purpose: Prepares a cylinder for a 90° clockwise rotation
; Parameters:
; - number of the cylinder to rotate
; Return-Value: none
;************************************************************************************
Procedure cylinderInitiateRotation(num.l)
cylinderRotateContacts(num)
cylinder(num)\rot=cylinder(num)\status*90
cylinder(num)\rotToDo=90
cylinder(num)\isRotating=#True
AddElement(moving())
moving()=num
EndProcedure
;************************************************************************************
; Name: cylinderMakeContact
; Purpose: Tests if at least one contact is made with the neighbours, and initiates
; rotation for the contacted cylinders
; Parameters:
; - number of the cylinder to test
; Return-Value: #True if at least one contact is found
;************************************************************************************
Procedure cylinderMakeContact(num)
Protected result.b
If cylinder(num)\north=#True And cylinder(cylinder(num)\cylinderToNorth)\south=#True And cylinder(cylinder(num)\cylinderToNorth)\isRotating=#False
cylinderInitiateRotation(cylinder(num)\cylinderToNorth)
result = #True
EndIf
If cylinder(num)\east=#True And cylinder(cylinder(num)\cylinderToEast)\west=#True And cylinder(cylinder(num)\cylinderToEast)\isRotating=#False
cylinderInitiateRotation(cylinder(num)\cylinderToEast)
result = #True
EndIf
If cylinder(num)\south=#True And cylinder(cylinder(num)\cylinderToSouth)\north=#True And cylinder(cylinder(num)\cylinderToSouth)\isRotating=#False
cylinderInitiateRotation(cylinder(num)\cylinderToSouth)
result = #True
EndIf
If cylinder(num)\west=#True And cylinder(cylinder(num)\cylinderToWest)\east=#True And cylinder(cylinder(num)\cylinderToWest)\isRotating=#False
cylinderInitiateRotation(cylinder(num)\cylinderToWest)
result = #True
EndIf
ProcedureReturn result
EndProcedure
; **************************************************************************************
;- ------ Main code ------
;- Entities
createCylinderEntities(thisBoard\boardSizeX,thisBoard\boardSizeY)
For i=0 To 90
armsAngle(i) = 45*Sin( (i*2)*(#PI/180.0) )
Next i
; Randomize position of all cylinders
plateauRandomizeAll()
;- Camera
cylinderAtCenter = (thisBoard\boardSizeY/2)*thisBoard\boardSizeX - (thisBoard\boardSizeX/2)
camcenter\X=NodeX(cylinder(cylinderAtCenter)\numBaseNode)+4
camcenter\Y=NodeY(cylinder(cylinderAtCenter)\numBaseNode)
camcenter\Z=NodeZ(cylinder(cylinderAtCenter)\numBaseNode)+4
camdist=150:bearing=180:azimuth=45
camchanged=#True
CreateCamera(1, 0 , 0, 100 , 100)
;- Light
Global lightPos.coord3D
lightPos\X=-40:lightPos\Y=camcenter\Y+100:lightPos\Z=-220
AmbientColor(RGB(105,105,105))
CreateLight(0,RGB(255,255,255),lightPos\X,lightPos\Y,lightPos\Z)
;-Window3D
OpenWindow3D(#Window3D, 0, 0, 600, 50, "Infos",#PB_Window_BorderLess)
TextGadget3D(#Score, 1, 30, 600, 25, "Score: 0")
ShowGUI(220,#True)
;- Main loop
oldTimer = ElapsedMilliseconds()
Repeat
If FullScreen = #False
While WindowEvent() : Wend
EndIf
;- Get mouse movements
If ExamineMouse()
movez=MouseWheel()
movex=MouseDeltaX():movey=MouseDeltaY()
mousePosX+movex:mousePosY+moveY
EndIf
;- MousePicking
; If no cylinder is moving, show mouse and allow user to select a cylinder
If ListSize(moving())=0 And score=oldScore
; If mouse was hidden, show it and update text
InputEvent3D(mousePosX, mousePosY, 0, "")
If mouseHidden=#True
mouseHidden=#False
ShowGUI(220,#True)
; New record?
If score>bestScore
bestScore=score
EndIf
SetGadgetText3D(#Score,"Score: "+Str(score) + " (Record: "+Str(bestScore)+")")
EndIf
; Highlight selected cylinder
selectedEntity=MousePick(1,mousePosX,mousePosY)
If selectedEntity >=0
selectedCylinder = Int((selectedEntity-1)/8)+1
Else
selectedCylinder=0
EndIf
If selectedCylinder<>oldSelected And oldSelected > 0
EntityMaterial(cylinder(oldSelected)\numBaseNode, MaterialID(0))
oldSelected=0
EndIf
If selectedCylinder > 0
If selectedCylinder<>oldSelected
EntityMaterial(cylinder(selectedCylinder)\numBaseNode, MaterialID(999))
oldSelected=selectedCylinder
EndIf
; Left-click on a cylinder => initiate rotation, reset score and hide mouse
If MouseButton(#PB_MouseButton_Left)
cylinderInitiateRotation(selectedCylinder)
mouseHidden=#True
ShowGUI(220,#False)
EntityMaterial(cylinder(oldSelected)\numBaseNode, MaterialID(0))
oldSelected=0
score=0:oldscore=0
EndIf: ; If mouseclick()=1...
EndIf; If selectedCylinder>0...
Else
;- Animation
; At least one cylinder is rotating => Animate it
ForEach moving()
num=moving()
cylinder(num)\rotToDo - (2*speedFactor)
If cylinder(num)\rotToDo>0
angle=cylinder(num)\rot-cylinder(num)\rotToDo
If angle<0
angle+360
Else
If angle>=360
angle-360
EndIf
EndIf
RotateNode(cylinder(num)\numBaseNode,0,360-angle,0)
angle2 = armsAngle(Int(cylinder(num)\rotToDo))
RotateNode(cylinder(num)\numBaseNode+2,angle2,0,0)
RotateNode(cylinder(num)\numBaseNode+3,angle2,0,0)
RotateNode(cylinder(num)\numBaseNode+4,angle2,0,0)
RotateNode(cylinder(num)\numBaseNode+5,0,0,angle2)
RotateNode(cylinder(num)\numBaseNode+6,0,0,angle2)
RotateNode(cylinder(num)\numBaseNode+7,0,0,angle2)
EntityMaterial(cylinder(num)\numBaseNode,MaterialID(cylinder(num)\rotToDo))
Else
cylinder(num)\rotToDo=0
cylinder(num)\isRotating=#False
RotateNode(cylinder(num)\numBaseNode,0,360-cylinder(num)\rot,0)
RotateNode(cylinder(num)\numBaseNode+2,0,0,0)
RotateNode(cylinder(num)\numBaseNode+3,0,0,0)
RotateNode(cylinder(num)\numBaseNode+4,0,0,0)
RotateNode(cylinder(num)\numBaseNode+5,0,0,0)
RotateNode(cylinder(num)\numBaseNode+6,0,0,0)
RotateNode(cylinder(num)\numBaseNode+7,0,0,0)
EntityMaterial(cylinder(num)\numBaseNode,MaterialID(0))
AddElement(doneMoving())
doneMoving()\numCylinder=num
doneMoving()\ptrMovingtoDelete = @moving()
EndIf: ; If cylinder(num)\rotToDo>0... Else...
Next moving()
; if a cylinder has finished its rotation => Test if a new contact occured and remove it from the "moving" list
If ListSize(doneMoving())>0
; Initiate new rotations
ForEach doneMoving()
num=doneMoving()\numCylinder
contactMade=cylinderMakeContact(num)
If contactMade=#True And cylinder(num)\isRotating=#False
cylinderInitiateRotation(num)
score+1
EndIf
ChangeCurrentElement(moving(),doneMoving()\ptrMovingtoDelete)
DeleteElement(moving())
Next doneMoving()
ClearList(doneMoving())
EndIf ; If nbdoneMoving>0...
EndIf ; If listsize(moving)=0... Else...
;- Keyboard
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_Space) And ListSize(moving())=0
PlateauRandomizeAll()
EndIf
If KeyboardPushed(#PB_Key_Add) And camdist>100
camdist-2
camchanged=#True
EndIf
If KeyboardPushed(#PB_Key_Subtract) And camdist<300
camdist+2
camchanged=#True
EndIf
EndIf
;- Right-click => mouse look
If MouseButton(#PB_MouseButton_Right) And (movex<>0 Or movey<>0)
bearing + movex
azimuth + movey
If azimuth<0
azimuth=0
EndIf
If azimuth>89
azimuth=89
EndIf
camchanged = #True
EndIf
If movez <> 0
camdist-movez*5
If camdist<100
camdist=100
EndIf
If camdist>300
camdist=300
EndIf
camchanged=#True
EndIf ; if movez <> 0...
; If the camera has moved, calculates its new position
If camchanged=#True
CameraLocate(1,camcenter\X,camcenter\Y,camcenter\Z)
CameraLookAt(1,camcenter\X,camcenter\Y,camcenter\Z+100)
RotateCamera(1,azimuth,bearing,0)
MoveCamera(1,0,0,-camdist)
CameraLookAt(1,camcenter\X,camcenter\Y,camcenter\Z)
camchanged = #False
EndIf ; if camchanged=#true...
If score > oldscore
oldscore+1
SetGadgetText3D(#Score,"Score: "+Str(oldScore))
EndIf
; A little info
SetWindowTitle3D(#Window3D, "Contact! Press [Space] to randomize ("+Str(CountRenderedTriangles()) + " polys, " + Str(Engine3DFrameRate(#PB_Engine3D_Average)) + " FPS)")
; Show it all
RenderWorld()
; Flip buffers to avoid tearing
FlipBuffers()
;- Forced-timing
currentTimer = ElapsedMilliseconds()
timer(numTimer)=currentTimer-oldTimer
oldTimer=currentTimer
numtimer+1:If numtimer=10:numtimer=0:EndIf
speedFactor=(timer(0)+timer(1)+timer(2)+timer(3)+timer(4)+timer(5)+timer(6)+timer(7)+timer(8)+timer(9))/200.0
Until KeyboardPushed(#PB_Key_Escape)
End