Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Everything related to 3D programming
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by Psychophanta »

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)
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Re: Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by Psychophanta »

https://mega.nz/file/YoJCDQDb#d7CSZFdZZ ... 00kULFo8gs

I already finished it as a flat surface of triangles, as a spherical surface of triangles, this is the classic one with a flat surface of squares, I am missing the flat surface of hexagons and finally where I want to get to, ... [ secret ] ..., which is the easiest to implement but the most fun, by far.
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
User avatar
SPH
Enthusiast
Enthusiast
Posts: 561
Joined: Tue Jan 04, 2011 6:21 pm

Re: Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by SPH »

Play, I want. But what should we do?

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 6.12LTS - 64 bits
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Re: Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by Psychophanta »

Sorry, it is a 0 player game :lol:

Still there is possible to play: this one is good
https://www.silvergames.com/es/game-of-life
or
https://arrobaricardoge.github.io/GameOfLife/en.html
:D

Ok, now seriously, 8) , after I finish the last cell squeme in a flat plane i will upload here the source. This week, i guess.
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by Lunasole »

Funny :mrgreen: But actually 0-player game will look much different.
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Re: Versioned, Inspired, Enhanced & Extended Conway's 0 player game

Post by Psychophanta »

Here it is current status about this one. At the moment the best "Conway's 0 player game" version in this forum, i guess 8)

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

; En el juego de Conway, para cada ciclo del bucle son 2 premisas nada más:
; (1) Cualquier celda apagada se enciende SI y SOLO SI tiene n=3 vecinas encendidas.
; (2) Cualquier celda encendida se apaga SI y SOLO SI tiene m>3 Ó m<2 vecinas encendidas.
; En los demás casos, el estado previo de la celda no cambia.

; Disponiendo de un número de polígonos regulares iguales, una superficie planar euclídea puede construirse EXCLUSIVAMENTE CON 3 tipos de ellos, a saber:
; polígonos regulares de 3 lados (triangulos equiláteros), de 4 lados (cuadrados), o de 6 lados (hexágonos regulares).
; Conociendo la longitud de uno de sus lados, las distancias entre 2 centroides de cada polígono nos indican también si tienen una arista en común, o 1 solo vértice, etc.
; Notar que También se puede construir una superficie esférica a base tanto de triángulos como de hexágonos.
;
; En el algoritmo solo se enciende cualquier polígono con 'n=0 o n=1 o n=2 ... o n=6' polígonos adyacentes encendidos, Y Solo se apaga cualquiera si 'm=0 o m=1 o m=2 ... o m=6' adyacentes encendidas.

; Relacionado con ello, hacer un espacio 3D constituido por mini esferas o puntos con distancias aleatorias entre sí. Y entonces:
; En el algoritmo solo se enciende cualquier esfera con 'n=0 o n=1 o n=2 ... o n=100' esferas cercanas(*) encendidas, Y Solo se apaga cualquier esfera si 'm=0 o m=1 o m=2 ... o m=100' esferas cercanas(*) encendidas.
; (*) Significa que hay que poner otro parámetro de distancia, que llamaremos 'nd.d' para contemplar las cercanas cuando hay que encender una esfera, o 'md.d' para contemplar las cercanas cuando hay que apagar una esfera.

; NOTA: para ambos casos también hay que elegir el tiempo de transición: 'ti.a'

; El programa contempla 4 modalidades en superficie con polígonos regulares más 1 modalidad con esferas dispersas en el espacio 3D:
; Las modalidades en superficie hecha de polígonos regulares son las siguientes:
; (1) En plano Euclídeo hecho de triángulos regulares (equiláteros),
; (2) en plano Euclídeo hecho de cuadrados,
; (3) en plano Euclídeo hecho de hexágonos regulares,
; (4) en superficie esférica hecha de triángulos regulares (equiláteros).
; La modalidad con esferas dispersas en el espacio 3D:
; (5) La modalidad espacial, hecha de esferas distanciadas aleatoriamente entre sí.

;/ inits
If ExamineDesktops()=0:End:EndIf
Global Titulo$="Versioned, Inspired, Enhanced & Extended Conway's 0 player game",bitplanes.a=DesktopDepth(0),FRX.u=DesktopWidth(0),FRY.u=DesktopHeight(0),RX.u=FRX,RY.u=FRY
If FRX<1280 Or FRY<720:RX=FRX*2/3:RY=FRY*2/3:Else:RX=1280:RY=720:EndIf
If InitEngine3D()=0:MessageRequester("Error","The 3D Engine can't be initialized",0):End:EndIf
AntialiasingMode(#PB_AntialiasingMode_x4)
InitSprite():InitKeyboard():InitMouse()
OpenWindowedScreen(OpenWindow(0,0,0,RX,RY,Titulo$,#PB_Window_BorderLess|#PB_Window_ScreenCentered),0,0,RX,RY,1,0,0,#PB_Screen_WaitSynchronization)
Add3DArchive(#PB_Compiler_Home+"examples/3D/Data/GUI",#PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home+"examples/3D/Data/Packs/skybox.zip",#PB_3DArchive_Zip)
Enumeration; Camaras
  #Camara
EndEnumeration
Enumeration; Luces
  #Luz
EndEnumeration
Enumeration; Texturas
  #Textura
EndEnumeration
Enumeration; Materiales
  #materialmuerto
  #materialvivo
  #materialverdeazul
  #materialrojo
  #material0; <- debe ser el último en esta enumeración
EndEnumeration
Enumeration; Mallas
  #malla
  #esfera
EndEnumeration
Enumeration; Entidades
  #entidad
  #punto0; <- debe ser el último en esta enumeración
EndEnumeration
Enumeration; Nodos
  #Pivotcamara
EndEnumeration
Enumeration; Window3D
  #ventana3Dprincipal
  #ventana3Dsecundaria
  #ventanaInfoObjeto
EndEnumeration
Enumeration; Gadget3D
  #Spiner1
  #Spiner2
  #Spiner3
  #ScrollBar1
  #ScrollBar2
  #ScrollBar3
  #Esquema
  #BotonPaso
  #Auto
  #Encender0
  #Encender1
  #Encender2
  #Encender3
  #Encender4
  #Encender5
  #Encender6
  #Encender7
  #Encender8
  #Encender9
  #Encender10
  #Encender11
  #Encender12
  #Apagar0
  #Apagar1
  #Apagar2
  #Apagar3
  #Apagar4
  #Apagar5
  #Apagar6
  #Apagar7
  #Apagar8
  #Apagar9
  #Apagar10
  #Apagar11
  #Apagar12
  #Encenderporvertice0
  #Encenderporvertice1
  #Encenderporvertice2
  #Encenderporvertice3
  #Encenderporvertice4
  #Encenderporvertice5
  #Encenderporvertice6
  #Encenderporvertice7
  #Encenderporvertice8
  #Encenderporvertice9
  #Encenderporvertice10
  #Encenderporvertice11
  #Encenderporvertice12
  #Apagarporvertice0
  #Apagarporvertice1
  #Apagarporvertice2
  #Apagarporvertice3
  #Apagarporvertice4
  #Apagarporvertice5
  #Apagarporvertice6
  #Apagarporvertice7
  #Apagarporvertice8
  #Apagarporvertice9
  #Apagarporvertice10
  #Apagarporvertice11
  #Apagarporvertice12
  #Encenderporverticeenfrentado0
  #Encenderporverticeenfrentado1
  #Encenderporverticeenfrentado2
  #Encenderporverticeenfrentado3
  #Encenderporverticeenfrentado4
  #Encenderporverticeenfrentado5
  #Encenderporverticeenfrentado6
  #Encenderporverticeenfrentado7
  #Encenderporverticeenfrentado8
  #Encenderporverticeenfrentado9
  #Encenderporverticeenfrentado10
  #Encenderporverticeenfrentado11
  #Encenderporverticeenfrentado12
  #Apagarporverticeenfrentado0
  #Apagarporverticeenfrentado1
  #Apagarporverticeenfrentado2
  #Apagarporverticeenfrentado3
  #Apagarporverticeenfrentado4
  #Apagarporverticeenfrentado5
  #Apagarporverticeenfrentado6
  #Apagarporverticeenfrentado7
  #Apagarporverticeenfrentado8
  #Apagarporverticeenfrentado9
  #Apagarporverticeenfrentado10
  #Apagarporverticeenfrentado11
  #Apagarporverticeenfrentado12
  #Texto1
  #TextoAyuda
  #CuadroEsquema
  #Framearistacomun1
  #Frameverticecomun1
  #Frameverticecomun2
EndEnumeration
;SetGUITheme3D("","DejaVuSans-10")
;\

Structure Vector3D Extends Vector3
  m.f;<-length(modulo)
EndStructure
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
Macro centroide4(o,a,b,c,d)
  o#\x=(a#\x+b#\x+c#\x+d#\x)/4:o#\y=(a#\y+b#\y+c#\y+d#\y)/4:o#\z=(a#\z+b#\z+c#\z+d#\z)/4
EndMacro
Macro ProductoVectorial(in1,in2,out,in1x=x,in1y=y,in1z=z,in2x=x,in2y=y,in2z=z,outx=x,outy=y,outz=z); <- Calculates the vectorial product of two 3D vectors. Just modify this procedure to get the vectorial product for 4D, 5D, 6D or any dimension you need.
  out#\outx#=in1#\in1y#*in2#\in2z#-in1#\in1z#*in2#\in2y#
  out#\outy#=in1#\in1z#*in2#\in2x#-in1#\in1x#*in2#\in2z#
  out#\outz#=in1#\in1x#*in2#\in2y#-in1#\in1y#*in2#\in2x#
EndMacro

Procedure.b KeyEdgeDetection(key.a)
  Static pka.a
  If KeyboardPushed(key);<-if current key status is PUSHED
    If pka=0:pka=key:ProcedureReturn 1:EndIf;<-if previous key status was NOT PUSHED, then assign previous state to current one, and EXIT.
  ElseIf pka=key;<-else (if previous key status was PUSHED and current key status is NOT PUSHED):
    pka=0;:ProcedureReturn -1;<-set previous key status to NOT PUSHED.
  EndIf
  ProcedureReturn 0
EndProcedure
Macro TeclaControldecamara(tecla=LeftControl)
  If KeyEdgeDetection(#PB_Key_#tecla#); <- inicia control camara
    pasocam.f=0.01:pasocamincr.f=0.001
  ElseIf KeyboardReleased(#PB_Key_#tecla#)
  ElseIf KeyboardPushed(#PB_Key_#tecla#); <- mover el punto de vista
    ;para desplazar la camara hacia delante, atras, arriba, abajo, izq o der
    If mdx Or mdy Or mdz
      If mmb.b
        MoveNode(#Pivotcamara,mdx,-mdy,0,#PB_Local); o MoveCamera(#Camara,mdx,-mdy,0,#PB_Local) o MoveCamera(#Camara,mdx,-mdy,0,#PB_Relative)
      Else
        RotateNode(#Pivotcamara,-mdy*60,-mdx*60,0,#PB_Relative)
        If mdz
          MoveCamera(#Camara,0,0,-mdz,#PB_Relative)
        EndIf
      EndIf
    ElseIf KeyboardPushed(#PB_Key_Add)
      MoveCamera(#Camara,0,0,-pasocam,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Subtract)
      MoveCamera(#Camara,0,0,pasocam,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad8)
      MoveCamera(#Camara,0,pasocam,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad2)
      MoveCamera(#Camara,0,-pasocam,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad6)
      MoveCamera(#Camara,pasocam,0,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad4)
      MoveCamera(#Camara,-pasocam,0,0,#PB_Relative)
      pasocam+pasocamincr
    ElseIf KeyboardPushed(#PB_Key_Pad1)
      RotateNode(#Pivotcamara,0,-0.5,0,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad7)
      RotateNode(#Pivotcamara,0,0.5,0,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad3) Or lmb.b
      RotateNode(#Pivotcamara,0,0,-0.5,#PB_Relative)
    ElseIf KeyboardPushed(#PB_Key_Pad9) Or rmb.b
      RotateNode(#Pivotcamara,0,0,0.5,#PB_Relative)
    EndIf
EndMacro

Procedure.i Convertircarasenentidades(mallafuente.i,mallasdestino.i,submallafuente.i=0,carainicial.i=0,ncaras.i=-1)
  ;Función de https://www.purebasic.fr/english/viewtopic.php?t=81067
; Esta función acepta una malla y copia cada una de sus caras a nuevas entidades de una cara cada una.
;
;  - mallafuente      : malla desde la que las caras serán copiadas.
;  - submallafuente   : submalla desde la que las caras serán copiadas.
;  - mallasdestino    : Base de números de malla, que será llenado con la construcción de cada cara
;  - 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 entidades creadas.
  Protected nvertices.i=MeshVertexCount(mallafuente,submallafuente),nindices.i=MeshIndexCount(mallafuente,submallafuente),ncarasTrasindice.i
  Protected x.i=0,y.i=0,idx.i=0
  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 ncarasTrasindice<ncaras: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:
  Dim vertices.MeshVertex(nvertices-1)
  If 0=GetMeshData(mallafuente,submallafuente,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:
  Dim indices.MeshFace(ncaras*3-1)
  If 0=GetMeshData(mallafuente,submallafuente,indices.MeshFace(),#PB_Mesh_Face,carainicial*3,(carainicial+ncaras)*3-1)
    ProcedureReturn 0; <- ¡fallo leyendo datos de las caras de la malla!
  EndIf
  For x=0 To ncaras-1
    CreateMesh(mallasdestino,#PB_Mesh_TriangleList)
    For y=0 To 2
      MeshVertex(vertices(indices(idx)\Index)\x,vertices(indices(idx)\Index)\y,vertices(indices(idx)\Index)\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
    Next
    MeshFace(0,1,2)
    FinishMesh(1)
;     BuildMeshTangents(mallasdestino)
;     NormalizeMesh(mallasdestino) 
;     UpdateMeshBoundingBox(mallasdestino)
    mallasdestino+1; <- ojo no sea que el numero de caras sea mayor que el que se esperaba
  Next
  ProcedureReturn ncaras
EndProcedure

Structure cara
  celula.i; <- indice de la cara triangular
  cambio.b:estado.a; <- viva o muerta
  centro.Vector3
  vertice.Vector3[6]; <- indices de los vertices de dicha cara
  List *celulaconaristacomun.cara(); <- las referencias a las caras adyacentes por una arista en común
  List *celulaconverticeenfrentado.cara(); <- referencias a las caras adyacentes por un solo vértice en común enfrentado
  List *celulaconverticecomun.cara(); <- referencias a las caras adyacentes por un solo vértice en común no enfrentado
EndStructure
Global Newlist celula.cara(),Dim n.a(12),Dim m.a(12),Dim nv.a(12),Dim mv.a(12),Dim nve.a(12),Dim mve.a(12),esquema.a,auto.a
Procedure.i Convertircarasensubmallas(malla.i,List lista.cara(),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.cara,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
  FreeMesh(malla)
  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.i; <- devuelve la cantidad de caras, o lo que es lo mismo la candidad de submallas: SubMeshCount(malla)
EndProcedure
Procedure.i PlanodeTriangulosregulares(malla.i,List lista.cara(),ancho.f=6,alto.f=4,arista.f=0.3)
  ; Esta función crea una malla que es un plano constituido de submallas y cada una consta de 3 vértices y una cara de triángulo regular.
  ; Devuelve el número total de submallas (caras) creadas.
  Protected ncaras.i=0,izq.f=-ancho/2,arr.f=-alto/2,x.f=izq.f,y.f=arr.f,despl.b=0,desply.b=0,contador.i=0,vert0.Vector3,vert1.Vector3,vert2.Vector3
  CreateMesh(malla.i,#PB_Mesh_TriangleList,#PB_Mesh_Static)
  While y<arr.f+alto.f
    While x<izq.f+ancho.f
      vert2=vert1
      vert1=vert0
      vert0\x=x:vert0\y=y+despl*arista*Sqr(3)/2:vert0\z=0
      If contador<2:contador+1
      Else
        AddElement(lista()):lista()\celula=ncaras:ncaras.i+1
        lista()\vertice[0]=vert2
        lista()\vertice[1]=vert1
        lista()\vertice[2]=vert0
        Centroide(lista()\centro,lista()\vertice[0],lista()\vertice[1],lista()\vertice[2])
        AddSubMesh(#PB_Mesh_TriangleList)
        MeshVertex(lista()\vertice[0]\x,lista()\vertice[0]\y,lista()\vertice[0]\z,0.5,0,$EEEEEE,0,1,0)
        MeshVertex(lista()\vertice[1]\x,lista()\vertice[1]\y,lista()\vertice[1]\z,0,1,$EEEEEE,0,0,1)
        MeshVertex(lista()\vertice[2]\x,lista()\vertice[2]\y,lista()\vertice[2]\z,1,1,$EEEEEE,0,0,1)
        MeshFace(0,1,2)
        MeshFace(2,1,0)
      EndIf
      If despl:despl=0; avanza verticalmente hacia arriba o hacia abajo según la linea sea par o impar
      ElseIf desply:despl=-1
      Else:despl=1
      EndIf
      x+arista/2; avanza horizontalmente media arista
    Wend
    contador=0
    despl.b=0
    x=izq.f
    desply!1:y+desply*arista*Sqr(3)
  Wend
  FinishMesh(1)
  ;BuildMeshTangents(malla):NormalizeMesh(malla):UpdateMeshBoundingBox(malla); <- estas 3 cosas son opcionales
  ProcedureReturn ncaras.i
EndProcedure
Procedure.i PlanodeCuadrados(malla.i,List lista.cara(),ancho.f=6,alto.f=4,arista.f=0.3)
  ; Esta función crea una malla que es un plano constituido de submallas y cada una consta de 4 vértices y una cara de cuadrado.
  ; Devuelve el número total de submallas (caras) creadas.
  Protected ncaras.i,izq.f=-ancho/2,arr.f=-alto/2,x.f=izq.f,y.f=arr.f
  Protected Dim vertice.Vector3(Int((ancho/arista+1)*(alto/arista+1))),i.i,j.i,nverticesx.i,nverticesy.i,nvertices.i,v0.i,v1.i,v2.i,v3.i
  CreateMesh(malla,#PB_Mesh_TriangleList,#PB_Mesh_Static)
  ; Primero ubicamos todos los vértices
  While y<arr.f+alto.f
    nverticesx=0
    While x<izq.f+ancho.f
      vertice(nvertices)\x=x:vertice(nvertices)\y=y:vertice(nvertices)\z=0
      x+arista
      nverticesx+1
      nvertices+1
    Wend
    x=izq
    y+arista
    nverticesy+1
  Wend
  ; numero total de vertices = nverticesx*nverticesy
  ; ahora construimos las submallas:
  For j=0 To nverticesy-2
    For i=0 To nverticesx-2
      v0=i+(j+1)*nverticesx; <- vértice abajo-izquierda del cuadrado
      v1=(i+1)+j*nverticesx; <- vértice arriba-derecha del cuadrado
      v2=i+j*nverticesx; <- vértice arriba-izquierda del cuadrado
      v3=(i+1)+(j+1)*nverticesx; <- vértice abajo-derecha del cuadrado
      AddElement(lista()):lista()\celula=ncaras:ncaras.i+1
      lista()\vertice[0]=vertice(v2)
      lista()\vertice[1]=vertice(v1)
      lista()\vertice[2]=vertice(v3)
      lista()\vertice[3]=vertice(v0)
      Centroide4(lista()\centro,lista()\vertice[0],lista()\vertice[1],lista()\vertice[2],lista()\vertice[3])
      AddSubMesh(#PB_Mesh_TriangleList)
      MeshVertex(vertice(v0)\x,vertice(v0)\y,vertice(v0)\z,0,0,$EEEEEE,0,0,1)
      MeshVertex(vertice(v1)\x,vertice(v1)\y,vertice(v1)\z,1,1,$EEEEEE,0,0,1)
      MeshVertex(vertice(v2)\x,vertice(v2)\y,vertice(v2)\z,0,1,$EEEEEE,0,1,0)
      MeshVertex(vertice(v3)\x,vertice(v3)\y,vertice(v3)\z,1,0,$EEEEEE,0,0,1)
      MeshFace(2,1,0):MeshFace(0,1,2)
      MeshFace(1,3,0):MeshFace(0,3,1)
    Next
  Next
  FreeArray(vertice())
  FinishMesh(1)
  ;BuildMeshTangents(malla):NormalizeMesh(malla):UpdateMeshBoundingBox(malla); <- estas 3 cosas son opcionales
  ProcedureReturn ncaras.i
EndProcedure
Procedure.i PlanodeHexagonosregulares(malla.i,List lista.cara(),ancho.f=6,alto.f=4,arista.f=0.3)
  ; Esta función crea una malla que es un plano constituido de submallas y cada una consta de 6 vértices y una cara de hexágono regular.
  ; Devuelve el número total de submallas (caras) creadas.
  ; NOTA: Este es quizá el mejor método para construir cualquier plano hecho de celdas de cualquier forma definida, sean poligonos regulares o no,
  ;       porque lo que se definen primeramente son LAS POSICIONES DE LOS CENTROIDES DE CADA POLÍGONO REGULAR, y a partir de ahí se definen
  ;       las posiciones de cada uno de los vértices de dicho polígono.
  Protected ncaras.i,izq.f=-ancho/2,arr.f=-alto/2,x.f=izq.f,y.f=arr.f,centroidez.f=arista/4
  Protected i.i,j.i,nverticesx.i,nverticesy.i
  Protected aristasx.i=ancho/arista
  Protected aristasy.i=Round(alto/arista,#PB_Round_Up)
  Protected celdasx.i=(2*aristasx-1)/3; => aristasx = (3*celdasx+1)/2
  Protected celdasy.i=aristasy/2+1
  Protected celdas.i=celdasx*celdasy
  ; Primero emplazamos las posiciones de todos los vértices
  While y<arr.f+alto.f
    nverticesx=0
    While x<izq.f+ancho.f
      If nverticesx=0 And nverticesy&1:x+3*arista/2:EndIf; <- si es columna 0 y fila impar, se incrementa la x en 1.5 arista
      AddElement(lista())
      lista()\centro\x=x:lista()\centro\y=y:lista()\centro\z=centroidez; <- se guarda la posición del nuevo vértice.
      nverticesx+1
      x+3*arista
    Wend
    x=izq; <- reinicial columna
    y+Sqr(3)*arista/2; <- una fila más
    nverticesy+1
  Wend
  ; numero total de vertices = nverticesx*nverticesy
  ; ahora construimos las submallas:
  CreateMesh(malla.i,#PB_Mesh_TriangleFan,#PB_Mesh_Static)
  ncaras=0
  ForEach lista()
    lista()\celula=ncaras
    AddSubMesh()
    MeshVertex(lista()\centro\x,lista()\centro\y,lista()\centro\z,0.5,0.5,$EEEEEE,0,1,0); <- centroide
    MeshVertex(lista()\centro\x-arista,lista()\centro\y,0,0,0.5,$EEEEEE,0,0,1); <- izq
    MeshVertex(lista()\centro\x-arista/2,lista()\centro\y-Sqr(3)*arista/2,0,0.25,1,$EEEEEE,0,0,1); <- arr-izq
    MeshVertex(lista()\centro\x+arista/2,lista()\centro\y-Sqr(3)*arista/2,0,0.75,1,$EEEEEE,0,0,1); <- arr-der
    MeshVertex(lista()\centro\x+arista,lista()\centro\y,0,1,0.5,$EEEEEE,0,0,1); <- der
    MeshVertex(lista()\centro\x+arista/2,lista()\centro\y+Sqr(3)*arista/2,0,0.75,0,$EEEEEE,0,0,1); <- aba-der
    MeshVertex(lista()\centro\x-arista/2,lista()\centro\y+Sqr(3)*arista/2,0,0.25,0,$EEEEEE,0,0,1); <- aba-izq
    MeshFace(1,2,0):MeshFace(0,2,1)
    MeshFace(2,3,0):MeshFace(0,3,2)
    MeshFace(3,4,0):MeshFace(0,4,3)
    MeshFace(4,5,0):MeshFace(0,5,4)
    MeshFace(5,6,0):MeshFace(0,6,5)
    MeshFace(6,1,0):MeshFace(0,1,6)
    ncaras+1
  Next
  FinishMesh(1)
  ;BuildMeshTangents(malla):NormalizeMesh(malla):UpdateMeshBoundingBox(malla); <- estas 3 cosas son opcionales
  ProcedureReturn ncaras.i
EndProcedure

CreateLight(#luz,$EEEEEE,-20,20,1,#PB_Light_Point):SetLightColor(#Luz,#PB_Light_SpecularColor,$999999):AmbientColor($AAAAAA)
CreateCamera(#Camara,0,0,100,100):CreateNode(#Pivotcamara,0,0,0):AttachNodeObject(#Pivotcamara,CameraID(#Camara)):CameraRange(#Camara,0.1,10000):CameraBackColor(#Camara,$181911)
MoveCamera(#Camara,0,0,6,#PB_Absolute)
;CameraRenderMode(#Camara,#PB_Camera_Wireframe)
CreateMaterial(#materialmuerto,0,$998899);:DisableMaterialLighting(#materialmuerto,1)
CreateMaterial(#materialvivo,0,$33E79F);:DisableMaterialLighting(#materialvivo,1)
CreateMaterial(#materialrojo,0,$2222DD);:DisableMaterialLighting(#materialnegro,1)
CreateMaterial(#materialverdeazul,0,$EEEE44);:DisableMaterialLighting(#materialnegro,1)
CreateSphere(#esfera,0.02)
Procedure reglas(gadget.i,letra$,Array r.a(1),x.f,y.f,w.f,h.f,tip$,c.a=12)
  Protected t.a
  For t=0 to c
    CheckBoxGadget3D(gadget+t,x,y+15*t,w,h,letra$+Str(t)):SetGadgetState3D(gadget+t,r(t)):GadgetToolTip3D(gadget+t,StringField(tip$,1,"0")+Str(t)+StringField(tip$,2,"0"))
  Next
EndProcedure
Macro abrecierraventana3D
  If IsWindow3D(#ventana3Dprincipal)
    ShowGUI(222,0,#Camara,0)
    If IsWindow3D(#ventana3Dsecundaria):FreeGadget3D(#TextoAyuda):CloseWindow3D(#ventana3Dsecundaria):EndIf
    FreeGadget3D(#PB_All):CloseWindow3D(#ventana3Dprincipal)
  Else
    OpenWindow3D(#ventana3Dprincipal,0,0,160,RY,"Controles",#PB_Window3D_SizeGadget|#PB_Window3D_BorderLess)
  ; El programa contempla 4 modalidades en superficie con polígonos regulares y la modalidad con esferas dispersas en el espacio 3D:
  ; Las modalidades en superficie hecha de polígonos regulares son las siguientes:
  ; (1) En plano Euclídeo hecho de triángulos regulares (equiláteros),
  ; (2) en plano Euclídeo hecho de cuadrados,
  ; (3) en plano Euclídeo hecho de hexágonos regulares,
  ; (4) en superficie esférica hecha de triángulos regulares (equiláteros).
  ; (5) La modalidad espacial, hecha de esferas distanciadas aleatoriamente entre sí.
;     FrameGadget3D(#CuadroEsquema,0,RY-60,150,160,"Tipo de mundo:")
;     ComboBoxGadget3D(#Esquema,5,600,140,30):GadgetToolTip3D(#Esquema,"Elegir tipo de mundo")
;     AddGadgetItem3D(#Esquema,0,"Plano de triángulos regulares")
;     AddGadgetItem3D(#Esquema,1,"Plano de cuadrados")
;     AddGadgetItem3D(#Esquema,2,"Plano de hexágonos regulares")
;     AddGadgetItem3D(#Esquema,3,"Esfera de triángulos regulares")
;     AddGadgetItem3D(#Esquema,4,"Espacio de miniesferas")
;     SetGadgetState3D(#Esquema,esquema.a)
    FrameGadget3D(#Framearistacomun1,0,0,158,220,"Arista común")
    FrameGadget3D(#Frameverticecomun1,0,220,158,220,"Vértice común")
    FrameGadget3D(#Frameverticecomun2,0,440,158,220,"Vértice común enfrentado")
    ScrollBarGadget3D(#ScrollBar1,0,RY-50,120,16,0,100,0):SetGadgetState3D(#ScrollBar1,ti.a):GadgetToolTip3D(#ScrollBar1,"Tiempo de transición")
    TextGadget3D(#Texto1,120,RY-50,30,20,Str(ti.a)):GadgetToolTip3D(#Texto1,"Tiempo de transición")
    reglas(#Encender0,"n=",n(),10,14,66,24,"Se enciende toda celda que tiene 0 celdas adyacentes encendidas con arista en común")
    reglas(#Apagar0,"m=",m(),80,14,66,24,"Se apaga toda celda que tiene 0 celdas adyacentes encendidas con arista en común")
    reglas(#Encenderporvertice0,"n=",nv(),10,233,66,24,"Se enciende toda celda que tiene 0 celdas adyacentes encendidas con vértice en común")
    reglas(#Apagarporvertice0,"m=",mv(),80,233,66,24,"Se apaga toda celda que tiene 0 celdas adyacentes encendidas con vértice en común")
    reglas(#Encenderporverticeenfrentado0,"n=",nve(),10,454,66,24,"Se enciende toda celda que tiene 0 celdas adyacentes encendidas con vértice enfrentado en común")
    reglas(#Apagarporverticeenfrentado0,"m=",mve(),80,454,66,24,"Se apaga toda celda que tiene 0 celdas adyacentes encendidas con vértice enfrentado en común")
    CheckBoxGadget3D(#Auto,10,RY-30,60,30,"Auto"):SetGadgetState3D(#Auto,Auto):GadgetToolTip3D(#Auto,"Transición automática")
    ButtonGadget3D(#BotonPaso,80,RY-30,60,30,"Paso"):GadgetToolTip3D(#BotonPaso,"Transición manual")
    ShowGUI(222,1,#Camara,1)
  EndIf
  ;Limpiar eventos:
  While WindowEvent3D():delay(10):Wend
EndMacro
Procedure ToggleAyuda()
  If IsWindow3D(#ventana3Dsecundaria)
    FreeGadget3D(#TextoAyuda)
    CloseWindow3D(#ventana3Dsecundaria)
  ElseIf IsWindow3D(#ventana3Dprincipal)
    OpenWindow3D(#ventana3Dsecundaria,RX/2-200,RY/2-200,400,300,"Ayuda",#PB_Window3D_SizeGadget|#PB_Window3D_BorderLess)
    Protected ayuda$
;     ayuda$="(F1) superficie plana de triángulos equiláteros"+#CRLF$+
;     "(F2) superficie plana de cuadrados"+#CRLF$+
;     "(F3) superficie plana de hexágonos regulares"+#CRLF$+
;     "(F4) superficie esférica de triángulos equiláteros"+#CRLF$+
;     "(F5) espacio con esferas"+#CRLF$+
;     "(0) limpiar"+#CRLF$+
;     "(1) numerar celdas"+#CRLF$+
;     "(2) generación aleatoria con semilla"+#CRLF$+
;     "(3) generación aleatoria"+#CRLF$+
;     "(6) generador Bellota (solo cuadrados)"+#CRLF$+
;     "(7) generador RPentomino (solo cuadrados)"+#CRLF$+
;     "(8) generador Gosper (solo cuadrados)"+#CRLF$+
;     "(CTRL-izq + ratón) orbitar cámara"+#CRLF$+
;     "(RMB + ratón) rota entidad"+#CRLF$+
;     "(F11) oculta o muestra controles"+#CRLF$+
;     "(F12) oculta o muestra esta ayuda"
    ayuda$="(F1) regular triangles flat surface"+#CRLF$+
    "(F2) squares flat surface"+#CRLF$+
    "(F3) regular hexagons flat surface"+#CRLF$+
    "(F4) regular triangles spherical surface"+#CRLF$+
    "(F5) spheres space"+#CRLF$+
    "(0) clean all"+#CRLF$+
    "(1) cells numeration"+#CRLF$+
    "(2) seeded random generation"+#CRLF$+
    "(3) random generation"+#CRLF$+
    "(6) Acorn generator (squares only)"+#CRLF$+
    "(7) RPentomino generator (squares only)"+#CRLF$+
    "(8) Gosper generator (squares only)"+#CRLF$+
    "(left-CTRL + mouse) camera orbitation"+#CRLF$+
    "(RMB + mouse) rotate entity"+#CRLF$+
    "(F11) toggle controls display"+#CRLF$+
    "(F12) toggle THIS help"
    TextGadget3D(#TextoAyuda,10,0,400,300,ayuda$)
  EndIf
EndProcedure

Macro Creartexturasconnumero
  FetchOrientation(EntityID(#entidad))
  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(#malla,MaterialID(#material0+t),t)
    t.i+1
  Next
  FreeEntity(#entidad):CreateEntity(#entidad,MeshID(#malla),#PB_Material_None,0,0,0)
  SetOrientation(EntityID(#entidad),GetX(),GetY(),GetZ(),GetW())
EndMacro

Macro AsignarTriangulosAdyacentes(longarista=0.1)
  larista.d=longarista#*1.001; <- la incrementamos un poco
  ForEach celula()
    l.d=(Distancia3D(celula()\vertice[1],celula()\vertice[2])+Distancia3D(celula()\vertice[0],celula()\vertice[2])+Distancia3D(celula()\vertice[1],celula()\vertice[0]))/3
    If l>larista.d:larista.d=l:EndIf
  Next
  lAdyacenteArista.d=larista/Sqr(3)
  lAdyacenteVertice.d=larista
  lAdyacenteVerticeEnfrentado.d=2*lAdyacenteArista.d
  ForEach celula()
    *actual.cara=@celula(); <- push
    While NextElement(celula())
      difv.d=Distancia3D(*actual\centro,celula()\centro)
      If difv<lAdyacenteArista; <- 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<lAdyacenteVertice; <- 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<lAdyacenteVerticeEnfrentado; <- 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
Macro AsignarCuadradosAdyacentes(longarista=0.1)
  lAdyacenteArista.d=longarista#*1.001; <- la incrementamos un poco
  lAdyacenteVertice.d=lAdyacenteArista*Sqr(2)
  lAdyacenteVerticeEnfrentado.d=0
  ForEach celula()
    *actual.cara=@celula(); <- push
    While NextElement(celula())
      difv.d=Distancia3D(*actual\centro,celula()\centro)
      If difv<lAdyacenteArista; <- 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<lAdyacenteVertice; <- 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<lAdyacenteVerticeEnfrentado; <- 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
Macro AsignarHexagonosAdyacentes(longarista=0.1)
  lAdyacenteArista.d=Sqr(3)*longarista#*1.001; <- la incrementamos un poco
  ForEach celula()
    *actual.cara=@celula(); <- push
    While NextElement(celula())
      difv.d=Distancia3D(*actual\centro,celula()\centro)
      If difv<lAdyacenteArista; <- 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
      EndIf
    Wend
    ChangeCurrentElement(celula(),*actual); <- pop
  Next
EndMacro

Procedure situacioninicial(Patron.b=1,linea.u=9/0.1)
  FetchOrientation(EntityID(#entidad))
  Select Patron
  Case 0; limpiar todo
    ForEach celula()
      SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
    Next
  Case 1,2
    If Patron=1:RandomSeed(7):EndIf
    ForEach celula()
      If Random(10)>9:SetMeshMaterial(#malla,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
      Else:SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
      EndIf
    Next
  Case 3; <- Patrón generador de planeadores de Gosper
    For j.a=0 To 10
      For i.a=0 To 37
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
      Next
    Next
    Restore Gosper
    For j=0 To 8
      Read.a n.a
      While n
        Read.a i
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
        n-1
      Wend
    Next
  Case 4; <- Patrón generador RPentamino
    For j.a=18 To 27
      For i.a=38 To 47
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
      Next
    Next
    Restore RPentomino
    For j=20 To 22
      Read.a n.a
      While n
        Read.a i
        i+40
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
        n-1
      Wend
    Next
  Case 5; <- Patrón generador Bellota
    For j.a=18 To 27
      For i.a=38 To 51
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
      Next
    Next
    Restore Bellota
    For j=20 To 22
      Read.a n.a
      While n
        Read.a i
        i+40
        SelectElement(celula(),i+j*linea):SetMeshMaterial(#malla,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
        n-1
      Wend
    Next
  EndSelect
  DataSection
    Gosper:
    Data.a 1,24,2,22,24,6,12,13,20,21,34,35,6,11,15,20,21,34,35,6,0,1,10,16,20,21,8,0,1,10,14,16,17,22,24,3,10,16,24,2,11,15,2,12,13
    RPentomino:
    Data.a 1,1,2,0,1,2,1,2
    Bellota:
    Data.a 1,1,1,3,5,0,1,4,5,6
  EndDataSection
  FreeEntity(#entidad):CreateEntity(#entidad,MeshID(#malla),#PB_Material_None,0,0,0)
  SetOrientation(EntityID(#entidad),GetX(),GetY(),GetZ(),GetW())
  If IsWindow3D(#ventana3Dprincipal)
    SetGadgetState3D(#Auto,auto)
    ;SetGadgetState3D(#Esquema,esquema)
  EndIf
EndProcedure

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(#entidad))
  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
            encendidasaristacomun+encendidasverticecomun;+encendidasverticeenfrentado; <- Esta linea es para equiparar el peso de las adyacentes por arista o por vértice
    If celula()\estado; si previamente está encendido
      If m(encendidasaristacomun) Or mv(encendidasverticecomun) Or mve(encendidasverticeenfrentado):celula()\cambio=-1:EndIf
    Else; si previamente está apagado
      If n(encendidasaristacomun) Or nv(encendidasverticecomun) Or nve(encendidasverticeenfrentado):celula()\cambio=1:EndIf
    EndIf
  Next
  ForEach celula()
    If celula()\cambio:celula()\cambio=0
      If celula()\estado:SetMeshMaterial(#malla,MaterialID(#materialmuerto),celula()\celula):celula()\estado=0
      Else:SetMeshMaterial(#malla,MaterialID(#materialvivo),celula()\celula):celula()\estado=1
      EndIf
    EndIf
  Next
  CreateEntity(#entidad,MeshID(#malla),#PB_Material_None,0,0,0)
  SetOrientation(EntityID(#entidad),GetX(),GetY(),GetZ(),GetW())
EndMacro

Macro resetear(mundo=1)
  esquema.a=mundo#
  auto.a=1
  MoveNode(#Pivotcamara,0,0,0,#PB_Absolute)
  RotateNode(#Pivotcamara,0,0,0,#PB_Absolute)
  MoveCamera(#Camara,0,0,6,#PB_Absolute)
  If IsEntity(#entidad):FreeEntity(#entidad):EndIf
  If IsMesh(#malla):FreeMesh(#malla):EndIf
  ForEach celula()
    ClearList(celula()\celulaconaristacomun())
    ClearList(celula()\celulaconverticecomun())
    ClearList(celula()\celulaconverticeenfrentado())
  Next
  ClearList(celula())
  Select esquema.a
  Case 0; triangulos equilateros
    ncaras.i=PlanodeTriangulosregulares(#malla,celula(),9,5,0.16)
    AsignarTriangulosAdyacentes(0.16)
  Case 1; cuadrados
    ncaras.i=PlanodeCuadrados(#malla,celula(),9,5,0.1)
    AsignarCuadradosAdyacentes(0.1)
  Case 2; hexagonos
    ncaras.i=PlanodeHexagonosregulares(#malla,celula(),9,5,0.066666)
    AsignarHexagonosAdyacentes(0.1)
  Case 3
    CreateIcoSphere(#malla,2,4)
    ncaras.i=Convertircarasensubmallas(#malla,celula())
    AsignarTriangulosAdyacentes()
  Case 4
    ;ncaras.i=EspacioconEsferas(#malla,celula())
    ;AsignarDistancias()
  EndSelect
  CreateEntity(#entidad,MeshID(#malla),MaterialID(#materialmuerto),0,0,0)
;   t.i=0:While IsEntity(#punto0+t):FreeEntity(#punto0+t):t+1:Wend
;   ForEach celula()
;     CreateEntity(#punto0+celula()\celula,MeshID(#esfera),MaterialID(#materialrojo),celula()\centro\x,celula()\centro\y,celula()\centro\z)
;   Next
  situacioninicial()
EndMacro
m(0)=1:m(1)=1:m(4)=1:m(5)=1:m(6)=1:m(7)=1:m(8)=1:m(9)=1:m(10)=1:m(11)=1:m(12)=1; <- condicion de mortalidad
n(3)=1; <- condicion de natalidad
;mv(1)=1:mv(4)=1; <- condicion de mortalidad
;nv(2)=1:nv(5)=1; <- condicion de natalidad
;mve(0)=1:mve(1)=1:mve(4)=1:mve(5)=1:mve(6)=1:mve(7)=1:mve(8)=1; <- condicion de mortalidad
;nve(3)=1; <- condicion de natalidad
ti.a=0; <- tiempo de transición
abrecierraventana3D
resetear()
ToggleAyuda()
Repeat:While WindowEvent()<>#PB_Event_None:Wend
  ExamineMouse():ExamineKeyboard()
  CursorX.f=MouseX():CursorY.f=MouseY():lmb.b=MouseButton(#PB_MouseButton_Left):rmb.b=MouseButton(#PB_MouseButton_Right):mmb.b=MouseButton(#PB_MouseButton_Middle)
  mdx.f=MouseDeltaX()/200:mdy.f=MouseDeltaY()/200:mdz.f=MouseWheel()/20
  TeclaControldecamara(LeftControl)
  ElseIf KeyboardReleased(#PB_Key_F1):esquema.a=0:resetear(0)
  ElseIf KeyboardReleased(#PB_Key_F2):esquema.a=1:resetear(1)
  ElseIf KeyboardReleased(#PB_Key_F3):esquema.a=2:resetear(2)
  ElseIf KeyboardReleased(#PB_Key_F4):esquema.a=3:resetear(3)
  ;ElseIf KeyboardReleased(#PB_Key_F5):esquema.a=4:resetear(4)
  ElseIf KeyboardReleased(#PB_Key_0):situacioninicial(0); <- limpiar
  ElseIf KeyboardReleased(#PB_Key_2):situacioninicial(1); <- aleatorio con semilla
  ElseIf KeyboardReleased(#PB_Key_3):situacioninicial(2); <- aleatorio
  ElseIf KeyboardReleased(#PB_Key_8):situacioninicial(3,9/0.1); Gosper
  ElseIf KeyboardReleased(#PB_Key_7):situacioninicial(4,9/0.1); RPentamino
  ElseIf KeyboardReleased(#PB_Key_6):situacioninicial(5,9/0.1); Bellota
  ElseIf KeyboardReleased(#PB_Key_1):Creartexturasconnumero
  ElseIf rmb:RotateEntity(#entidad,mdy*20,mdx*20,mdz*20,#PB_Relative); o TransformMesh(#malla,0,0,0,1,1,1,mdy*20,-mdx*20,mdz*20)
  ElseIf KeyboardReleased(#PB_Key_F11)
    abrecierraventana3D
  ElseIf KeyboardReleased(#PB_Key_F12)
    ToggleAyuda()
  ElseIf IsWindow3D(#ventana3Dprincipal)
    InputEvent3D(CursorX.f,CursorY.f,lmb.b); <- para el cursor del ratón nada más.
    eventoventana3D.i=WindowEvent3D()
    Select eventoventana3D
    Case #PB_Event3D_Gadget;:Beep_(266,5)
      eventogadget3D.i=EventGadget3D()
    Select eventogadget3D
    Case #Encender0 To #Encender12:n(eventogadget3D-#Encender0)=GetGadgetState3D(eventogadget3D)
    Case #Apagar0 To #Apagar12:m(eventogadget3D-#Apagar0)=GetGadgetState3D(eventogadget3D)
    Case #Encenderporvertice0 To #Encenderporvertice12:nv(eventogadget3D-#Encenderporvertice0)=GetGadgetState3D(eventogadget3D)
    Case #Apagarporvertice0 To #Apagarporvertice12:mv(eventogadget3D-#Apagarporvertice0)=GetGadgetState3D(eventogadget3D)
    Case #Encenderporverticeenfrentado0 To #Encenderporverticeenfrentado12:nve(eventogadget3D-#Encenderporverticeenfrentado0)=GetGadgetState3D(eventogadget3D)
    Case #Apagarporverticeenfrentado0 To #Apagarporverticeenfrentado12:mve(eventogadget3D-#Apagarporverticeenfrentado0)=GetGadgetState3D(eventogadget3D)
    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)
    ;Case #Esquema:esquema.a=GetGadgetState3D(#Esquema):resetear(esquema)
      ;esquema=0 => Plano de triángulos regulares
      ;esquema=1 => Plano de cuadrados
      ;esquema=2 => Plano de hexágonos regulares
      ;esquema=3 => Esfera de triángulos regulares
      ;esquema=4 => Espacio de miniesferas
    EndSelect
    EndSelect
  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)
By the way, with PB6.01, because can't use here PB6.02beta1 as stated in other thread :o
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Post Reply