Versioned, Inspired, Enhanced & Extended Conway's 0 player game
Posted: Sun Apr 09, 2023 10:39 am
If you know about this 0 player game, then no much to comment, just play.
Code: Select all
; Versioned, Inspired, Enhanced & Extended Conway's 0 player game. By Psychophanta; 20230405 with PB6.01:
; Many thanks to 'yuki' PB forum user, who helped me here: https://www.purebasic.fr/english/viewtopic.php?t=81067
;/ inits
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindowedScreen(OpenWindow(0,0,0,1280,720,"Titulo$",#PB_Window_BorderLess|#PB_Window_ScreenCentered),0,0,1280,720,1,0,0,#PB_Screen_WaitSynchronization)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/GUI", #PB_3DArchive_FileSystem)
Enumeration; Camaras
#Camara
EndEnumeration
Enumeration; Luces
#Luz
EndEnumeration
Enumeration; Texturas
#Textura
EndEnumeration
Enumeration; Materiales
#materialmuerto
#materialvivo
#material0
EndEnumeration
Enumeration; Mallas
#malla0
EndEnumeration
Enumeration; Entidades
#entidad0
EndEnumeration
Enumeration; Window3D
#ventana3Dprincipal
EndEnumeration
Enumeration; Gadget3D
#ScrollBar1
#BotonPaso
#Auto
#Encender0
#Encender1
#Encender2
#Encender3
#Apagar0
#Apagar1
#Apagar2
#Apagar3
#Texto1
EndEnumeration
;\
Macro ProductoEscalar(a,b,ax=x,ay=y,az=z,bx=x,by=y,bz=z)
(a#\ax#*b#\bx#+a#\ay#*b#\by#+a#\az#*b#\bz#)
EndMacro
Macro getmodulo(v,vx=x,vy=y,vz=z)
(Sqr#ProductoEscalar(v#,v#,vx#,vy#,vz#,vx#,vy#,vz#))
EndMacro
Macro Distancia3D(a,b); <- devuelve la distancia entre 2 vectores posición dados
(Sqr(Pow(a#\x-b#\x,2)+Pow(a#\y-b#\y,2)+Pow(a#\z-b#\z,2)))
EndMacro
Macro centroide(o,a,b,c)
o#\x=(a#\x+b#\x+c#\x)/3:o#\y=(a#\y+b#\y+c#\y)/3:o#\z=(a#\z+b#\z+c#\z)/3
EndMacro
Structure triangulo
celula.i; <- indice de la cara triangular
estadoprovisional.b:estado.b; <- viva o muerta
centro.Vector3
vertice.Vector3[3]; <- indices de los vertices de dicha cara
List *celulaconaristacomun.triangulo(); <- las 3 referencias a las 3 caras triangulares adyacentes por una arista en común
List *celulaconverticeenfrentado.triangulo(); <- las 2 o 3 referencias a las 2 o 3 caras triangulares adyacentes por un solo vértice en común enfrentado
List *celulaconverticecomun.triangulo(); <- las 6 referencias a las 6 caras triangulares adyacentes por un solo vértice en común no enfrentado
EndStructure
Newlist celula.triangulo()
Procedure.i Convertirmallaensubmallas(malla.i,List lista.triangulo(),submalla.i=0,carainicial.i=0,ncaras.i=-1)
; Esta función acepta una malla y la modifica de manera que cada cara la deja como submalla.
;
; - malla : malla desde la que las caras serán copiadas.
; - submalla : submalla desde la que las caras serán copiadas.
; - carainicial : indice inicial (0) de la cara de la malla a copiar.
; - ncaras : número de caras a copiar, empezando por 'carainicial'.
;
; Devuelve el número total de submallas (caras) creadas.
Protected nvertices.i=MeshVertexCount(malla,submalla),nindices.i=MeshIndexCount(malla,submalla),ncarasTrasindice.i
;354 nvertices
;960 nindices
Protected t.i,idx.i=0,*actual.triangulo,distanciacritica.f=0.1
If carainicial<0:carainicial=0:EndIf
If ncaras<0 Or ncaras>nindices/3:ncaras=nindices/3:EndIf
ncarasTrasindice=ncaras-carainicial
If ncarasTrasindice<=0:ProcedureReturn 0; <- fallo
ElseIf ncaras>ncarasTrasindice:ncaras=ncarasTrasindice ; <- numero de caras más allá del indice reportado
; Podemos salir inmediatamente si no hay tales caras. Además, debemos asegurarnos de restringir el número de caras de salida en base a esto (para no leer más allá del final de los datos de nuestra malla).
EndIf
; Extraer todos los vértices:
Protected Dim vertices.MeshVertex(nvertices-1)
If 0=GetMeshData(malla,submalla,vertices.MeshVertex(),#PB_Mesh_Vertex|#PB_Mesh_Normal|#PB_Mesh_UVCoordinate|#PB_Mesh_Color|#PB_Mesh_Tangent,0,nvertices-1)
ProcedureReturn 0; <- ¡fallo leyendo datos de los vértices de la malla!
EndIf
; Extraer solo los indices relevantes:
Protected Dim indices.MeshFace(ncaras*3-1)
If 0=GetMeshData(malla,submalla,indices.MeshFace(),#PB_Mesh_Face,carainicial*3,(carainicial+ncaras)*3-1)
ProcedureReturn 0; <- ¡fallo leyendo datos de las caras de la malla!
EndIf
CreateMesh(malla,#PB_Mesh_TriangleList)
For t=0 To ncaras-1
AddElement(lista()):lista()\celula=t
CopyMemory(vertices(indices(idx)\Index),lista()\vertice[0],Sizeof(Vector3)):idx+1
CopyMemory(vertices(indices(idx)\Index),lista()\vertice[1],Sizeof(Vector3)):idx+1
CopyMemory(vertices(indices(idx)\Index),lista()\vertice[2],Sizeof(Vector3)):idx+1
Next
idx=0
ForEach lista()
*actual=@lista(); <- push
;Ajustar posiciones de los vértices:
While NextElement(lista())
If Distancia3D(*actual\vertice[0],lista()\vertice[0])<distanciacritica:*actual\vertice[0]=lista()\vertice[0]:EndIf
If Distancia3D(*actual\vertice[1],lista()\vertice[1])<distanciacritica:*actual\vertice[1]=lista()\vertice[1]:EndIf
If Distancia3D(*actual\vertice[2],lista()\vertice[2])<distanciacritica:*actual\vertice[2]=lista()\vertice[2]:EndIf
Wend
;Hallar el centroide de esta cara:
Centroide(*actual\centro,*actual\vertice[0],*actual\vertice[1],*actual\vertice[2])
AddSubMesh(#PB_Mesh_TriangleList)
vertices(indices(idx)\Index)\u=0.5:vertices(indices(idx)\Index)\v=0
MeshVertex(*actual\vertice[0]\x,*actual\vertice[0]\y,*actual\vertice[0]\z,vertices(indices(idx)\Index)\u,vertices(indices(idx)\Index)\v,vertices(indices(idx)\Index)\Color,vertices(indices(idx)\Index)\NormalX,vertices(indices(idx)\Index)\NormalY,vertices(indices(idx)\Index)\NormalZ)
MeshVertexTangent(vertices(indices(idx)\Index)\TangentX,vertices(indices(idx)\Index)\TangentY,vertices(indices(idx)\Index)\TangentZ)
idx+1
vertices(indices(idx)\Index)\u=0:vertices(indices(idx)\Index)\v=1
MeshVertex(*actual\vertice[1]\x,*actual\vertice[1]\y,*actual\vertice[1]\z,vertices(indices(idx)\Index)\u,vertices(indices(idx)\Index)\v,vertices(indices(idx)\Index)\Color,vertices(indices(idx)\Index)\NormalX,vertices(indices(idx)\Index)\NormalY,vertices(indices(idx)\Index)\NormalZ)
MeshVertexTangent(vertices(indices(idx)\Index)\TangentX,vertices(indices(idx)\Index)\TangentY,vertices(indices(idx)\Index)\TangentZ)
idx+1
vertices(indices(idx)\Index)\u=1:vertices(indices(idx)\Index)\v=1
MeshVertex(*actual\vertice[2]\x,*actual\vertice[2]\y,*actual\vertice[2]\z,vertices(indices(idx)\Index)\u,vertices(indices(idx)\Index)\v,vertices(indices(idx)\Index)\Color,vertices(indices(idx)\Index)\NormalX,vertices(indices(idx)\Index)\NormalY,vertices(indices(idx)\Index)\NormalZ)
MeshVertexTangent(vertices(indices(idx)\Index)\TangentX,vertices(indices(idx)\Index)\TangentY,vertices(indices(idx)\Index)\TangentZ)
idx+1
MeshFace(0,1,2)
ChangeCurrentElement(lista(),*actual); <- pop
Next
FinishMesh(1)
BuildMeshTangents(malla):NormalizeMesh(malla):UpdateMeshBoundingBox(malla); <- estas 3 cosas son opcionales
ProcedureReturn ncaras; <- devuelve la cantidad de caras, o lo que es lo mismo la candidad de submallas: SubMeshCount(malla)
EndProcedure
CreateLight(#luz,$EEEEEE,-20,20,1,#PB_Light_Point);:SetLightColor(#Luz,#PB_Light_SpecularColor,$999999):AmbientColor($AAAAAA)
CreateCamera(#Camara,0,0,100,100):MoveCamera(#Camara,0,0,6,#PB_Absolute)
CreateIcoSphere(#malla0,2,2)
CreateMaterial(#materialmuerto,0,$998899)
CreateMaterial(#materialvivo,0,$AAEE99)
ncaras.i=Convertirmallaensubmallas(#malla0,celula())
CreateEntity(#entidad0,MeshID(#malla0),MaterialID(#materialmuerto),0,0,0)
Macro AsignarCelulasAdyacentes()
*actual.triangulo
ForEach celula()
*actual=@celula(); <- push
While NextElement(celula())
difv.d=Distancia3D(*actual\centro,celula()\centro)
If difv<0.365; <- asigna las celdas adyacentes por arista común. Este valor es la distancia entre los centroides de 2 triangulos equiláteros en una red regular de estos, cuando ambos comparten una misma arista, y es 'l/Sqr(3)' donde 'l' es la longitud del lado del triángulo.
AddElement(*actual\celulaconaristacomun())
*actual\celulaconaristacomun()=@celula()
AddElement(celula()\celulaconaristacomun())
celula()\celulaconaristacomun()=*actual
ElseIf difv<0.632; <- asigna las celdas adyacentes por vértice común no enfrentado. Este valor es la distancia entre los centroides de 2 triangulos equiláteros en una red regular de estos, cuando ambos comparten un solo vértice y no está enfrentado, y es 'l', que es la longitud del lado del triángulo.
AddElement(*actual\celulaconverticecomun())
*actual\celulaconverticecomun()=@celula()
AddElement(celula()\celulaconverticecomun())
celula()\celulaconverticecomun()=*actual
ElseIf difv<0.73; <- asigna las celdas adyacentes por vértice común enfrentado. Este valor es la distancia entre los centroides de 2 triangulos equiláteros en una red regular de estos, cuando ambos comparten un solo vértice y no está enfrentado, y es '2*l/Sqr(3)', donde 'l' es la longitud del lado del triángulo.
AddElement(*actual\celulaconverticeenfrentado())
*actual\celulaconverticeenfrentado()=@celula()
AddElement(celula()\celulaconverticeenfrentado())
celula()\celulaconverticeenfrentado()=*actual
EndIf
Wend
ChangeCurrentElement(celula(),*actual); <- pop
Next
EndMacro
AsignarCelulasAdyacentes()
Macro abreventana3D
If IsWindow3D(#ventana3Dprincipal)
SetWindowTitle3D(#ventana3Dprincipal,"Controles")
Else
OpenWindow3D(#ventana3Dprincipal,0,0,240,180,"Controles",#PB_Window3D_SizeGadget|#PB_Window3D_BorderLess)
EndIf
ScrollBarGadget3D(#ScrollBar1,0,0,20,120,0,100,0,#PB_ScrollBar3D_Vertical):SetGadgetState3D(#ScrollBar1,ti.a):GadgetToolTip3D(#ScrollBar1,"Tiempo de transición")
TextGadget3D(#Texto1,0,120,30,20,Str(ti.a)):GadgetToolTip3D(#Texto1,"Tiempo de transición")
CheckBoxGadget3D(#Encender0,50,0,80,25,"n=0"):SetGadgetState3D(#Encender0,n0.a):GadgetToolTip3D(#Encender0,"Se enciende toda celda que tiene 0 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Encender1,50,16,80,25,"n=1"):SetGadgetState3D(#Encender1,n1.a):GadgetToolTip3D(#Encender1,"Se enciende toda celda que tiene 1 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Encender2,50,32,80,25,"n=2"):SetGadgetState3D(#Encender2,n2.a):GadgetToolTip3D(#Encender2,"Se enciende toda celda que tiene 2 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Encender3,50,48,80,25,"n=3"):SetGadgetState3D(#Encender3,n3.a):GadgetToolTip3D(#Encender3,"Se enciende toda celda que tiene 3 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Apagar0,140,0,80,25,"m=0"):SetGadgetState3D(#Apagar0,m0.a):GadgetToolTip3D(#Apagar0,"Se apaga toda celda que tiene 0 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Apagar1,140,16,80,25,"m=1"):SetGadgetState3D(#Apagar1,m1.a):GadgetToolTip3D(#Apagar1,"Se apaga toda celda que tiene 1 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Apagar2,140,32,80,25,"m=2"):SetGadgetState3D(#Apagar2,m2.a):GadgetToolTip3D(#Apagar2,"Se apaga toda celda que tiene 2 celdas adyacentes encendidas con arista en común")
CheckBoxGadget3D(#Apagar3,140,48,80,25,"m=3"):SetGadgetState3D(#Apagar3,m3.a):GadgetToolTip3D(#Apagar3,"Se apaga toda celda que tiene 3 celdas adyacentes encendidas con arista en común")
ButtonGadget3D(#BotonPaso,36,130,60,30,"Paso"):GadgetToolTip3D(#BotonPaso,"Transición manual")
CheckBoxGadget3D(#Auto,100,130,80,30,"Auto"):GadgetToolTip3D(#Auto,"Transición automática")
ShowGUI(222,1,#Camara,1)
While WindowEvent3D():delay(10):Wend
EndMacro
Macro abreocierraventana3D
FreeGadget3D(#PB_All)
If IsWindow3D(#ventana3Dprincipal)
ShowGUI(222,0,#Camara,0)
CloseWindow3D(#ventana3Dprincipal)
Else:abreventana3D
EndIf
EndMacro
Macro situacioninicial
RandomSeed(8)
FetchOrientation(EntityID(#entidad0))
ForEach celula()
If Random(10)>9:SetMeshMaterial(#malla0,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
Else:SetMeshMaterial(#malla0,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
EndIf
Next
CreateEntity(#entidad0,MeshID(#malla0),#PB_Material_None,0,0,0)
SetOrientation(EntityID(#entidad0),GetX(),GetY(),GetZ(),GetW())
m0.a=1:m3.a=1; <- condicion de mortalidad
n1.a=1:n3.a=1; <- condicion de natalidad
ti.a=30; <- tiempo de transición
EndMacro
Macro algoritmodejuego
; En el algoritmo:
; Una celda se enciende SI y SOLO SI hay 'n' celdas encendidas adyacentes por arista común (n=1 o n=3)
; Una celda se apaga SI y SOLO SI hay 'm' celdas encendidas adyacentes por arista común (m=0 o m=3)
FetchOrientation(EntityID(#entidad0))
ForEach celula()
encendidasaristacomun.a=0
ForEach celula()\celulaconaristacomun()
encendidasaristacomun.a+celula()\celulaconaristacomun()\estado
Next
encendidasverticecomun.a=0
ForEach celula()\celulaconverticecomun()
encendidasverticecomun.a+celula()\celulaconverticecomun()\estado
Next
encendidasverticeenfrentado.a=0
ForEach celula()\celulaconverticeenfrentado()
encendidasverticeenfrentado.a+celula()\celulaconverticeenfrentado()\estado
Next
If celula()\estado; si previamente está encentido
Select encendidasaristacomun
Case 0:If m0:SetMeshMaterial(#malla0,MaterialID(#materialmuerto),celula()\celula):celula()\estadoprovisional=0:EndIf
Case 1:If m1:SetMeshMaterial(#malla0,MaterialID(#materialmuerto),celula()\celula):celula()\estadoprovisional=0:EndIf
Case 2:If m2:SetMeshMaterial(#malla0,MaterialID(#materialmuerto),celula()\celula):celula()\estadoprovisional=0:EndIf
Case 3:If m3:SetMeshMaterial(#malla0,MaterialID(#materialmuerto),celula()\celula):celula()\estadoprovisional=0:EndIf
EndSelect
Else; si previamente está apagado
Select encendidasaristacomun
Case 0:If n0:SetMeshMaterial(#malla0,MaterialID(#materialvivo),celula()\celula):celula()\estadoprovisional=1:EndIf
Case 1:If n1:SetMeshMaterial(#malla0,MaterialID(#materialvivo),celula()\celula):celula()\estadoprovisional=1:EndIf
Case 2:If n2:SetMeshMaterial(#malla0,MaterialID(#materialvivo),celula()\celula):celula()\estadoprovisional=1:EndIf
Case 3:If n3:SetMeshMaterial(#malla0,MaterialID(#materialvivo),celula()\celula):celula()\estadoprovisional=1:EndIf
EndSelect
EndIf
Next
ForEach celula()
celula()\estado=celula()\estadoprovisional
Next
CreateEntity(#entidad0,MeshID(#malla0),#PB_Material_None,0,0,0)
SetOrientation(EntityID(#entidad0),GetX(),GetY(),GetZ(),GetW())
EndMacro
Macro Creartexturasconnumero
FetchOrientation(EntityID(#entidad0))
t.i=0
ForEach celula()
CreateTexture(#Textura+t,40,40)
StartDrawing(TextureOutput(#Textura+t))
Box(0,0,40,40,$EEEE44)
t$=Str(t)
DrawText(20-TextWidth(t$)/2,20,t$,$77BBBB,$FFFFFF)
StopDrawing()
CreateMaterial(#material0+t,TextureID(#Textura+t),$AAAAAA)
SetMeshMaterial(#malla0,MaterialID(#material0+t),t)
t.i+1
Next
CreateEntity(#entidad0,MeshID(#malla0),#PB_Material_None,0,0,0)
SetOrientation(EntityID(#entidad0),GetX(),GetY(),GetZ(),GetW())
EndMacro
Macro resetear
MoveCamera(#Camara,0,0,6,#PB_Absolute)
TransformMesh(#malla0,0,0,0,1,1,1,0,0,0)
RotateEntity(#entidad0,0,0,0,#PB_Absolute)
situacioninicial
abreventana3D
EndMacro
resetear
Repeat:While WindowEvent()<>#PB_Event_None:Wend
ExamineMouse():ExamineKeyboard()
If KeyboardPushed(#PB_Key_F5):resetear
ElseIf KeyboardReleased(#PB_Key_1):Creartexturasconnumero
ElseIf MouseButton(#PB_MouseButton_Right):RotateEntity(#entidad0,MouseDeltaY()/10,MouseDeltaX()/10,MouseWheel(),#PB_Relative)
ElseIf IsWindow3D(#ventana3Dprincipal)
InputEvent3D(MouseX(),MouseY(),MouseButton(#PB_MouseButton_Left)); <- para el cursor del ratón nada más.
If WindowEvent3D()=#PB_Event3D_Gadget
Select EventGadget3D()
Case #Encender0:n0.a=GetGadgetState3D(#Encender0)
Case #Encender1:n1.a=GetGadgetState3D(#Encender1)
Case #Encender2:n2.a=GetGadgetState3D(#Encender2)
Case #Encender3:n3.a=GetGadgetState3D(#Encender3)
Case #Apagar0:m0.a=GetGadgetState3D(#Apagar0)
Case #Apagar1:m1.a=GetGadgetState3D(#Apagar1)
Case #Apagar2:m2.a=GetGadgetState3D(#Apagar2)
Case #Apagar3:m3.a=GetGadgetState3D(#Apagar3)
Case #ScrollBar1:ti.a=GetGadgetState3D(#ScrollBar1):SetGadgetText3D(#Texto1,Str(ti.a))
Case #BotonPaso:auto.a=0:SetGadgetState3D(#Auto,0):algoritmodejuego
Case #Auto:auto.a=GetGadgetState3D(#Auto)
EndSelect
EndIf
EndIf
If auto
If tim.a=0:tim.a=ti.a
algoritmodejuego
Else:tim.a-1
EndIf
EndIf
TimeSinceLastFrame.i=RenderWorld(50)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)