Rough dna representation

Everything related to 3D programming
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Rough dna representation

Post by DK_PETER »

Here are the links to the materials and mesh used in the code below:

For pb5.4x
https://www.dropbox.com/s/mmhsuv1ci46jk ... x.zip?dl=0

For pb5.6x
https://www.dropbox.com/s/vrk9p2ah2q8sp ... x.zip?dl=0

Unpack the related archive to the same location as the code you use:

Pb 5.4x:

Code: Select all

;By DK_PETER (Requires 5.4X)
UseJPEGImageDecoder()

If InitEngine3D(#PB_Engine3D_DebugLog|#PB_Engine3D_AverageFPS) = 0
  MessageRequester("Engine problem", "Unable to initialize Ogre3D")
  End
EndIf
If InitSprite() = 0
  MessageRequester("Sprite Init error", "Can't initialize screen")
  End
EndIf
If InitKeyboard() = 0
  MessageRequester("Keyboard", "No keyboard...")
  End
EndIf

Structure _Object
  bs.i
  id.i
  ms.i
  ma.i
  tx.i[3]
EndStructure
Global bg._Object

Structure _dna
  id.i
  ms.i
EndStructure
Global NewList set._dna(), base._dna

Structure _mat
  ma.i
  tx.i
EndStructure
Global Dim mat._mat(19)

Declare.i BuildDNA()
Declare.i BuildScene()
Declare.i RunDNA()
Declare.i BuildBase()
Declare.i ShowStatus()
Declare.i ThreadAnim(value.i = 1)

Global node.i, Dim bc.i(5), thrMat.i, lg.i, sp.i, Quit.i = #False

Procedure.i BuildScene()
  Protected scr.i, x.i, y.i, r.i, c.i
  AntialiasingMode(#PB_AntialiasingMode_x6)
  ExamineDesktops()
  OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Dna", #PB_Window_BorderLess)
  scr = OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0))
  Add3DArchive("jpg", #PB_3DArchive_FileSystem)
  Add3DArchive("mesh", #PB_3DArchive_FileSystem)
  Add3DArchive("material", #PB_3DArchive_FileSystem)
  Add3DArchive("texture", #PB_3DArchive_FileSystem)
  Parse3DScripts()
  If scr > 0
    WorldShadows(#PB_Shadow_Additive)
    CreateCamera(0, 0, 0, 100, 100)
    MoveCamera(0, 0, 0, 0)
    lg = CreateLight(#PB_Any, $FFFFFF, 0, 17, -17)
    With bg
      \ms = CreateCube(#PB_Any, 30)
      \tx[0] = CreateTexture(#PB_Any, 1024, 1024)
      StartDrawing(TextureOutput(\tx[0]))
      Box(0, 0, 1024, 1024, $0003B8)
      StopDrawing()
      \tx[1] = LoadTexture(#PB_Any, "veins.jpg")
      \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
      AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
      AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
      ScaleMaterial(\ma, 0.4, 0.4, 1)
      ScaleMaterial(\ma, 0.6, 0.6, 2)
      ScrollMaterial(\ma, -0.01, 0.008, #PB_Material_Animated, 1)
      MaterialCullingMode(bg\ma, #PB_Material_AntiClockWiseCull)
      \id = CreateEntity(#PB_Any, MeshID(bg\ms), MaterialID(bg\ma), 0, 0, 0)
      ScaleEntity(\id, 20, 20, 20)
    EndWith
    For x = 0 To 18
      mat(x)\tx = LoadTexture(#PB_Any, "cell_" + Str(x) + ".jpg")
      mat(x)\ma = CreateMaterial(#PB_Any, TextureID(mat(x)\tx))
      MaterialBlendingMode(mat(x)\ma, #PB_Material_Add)
      SetMaterialAttribute(mat(x)\ma, #PB_Material_DepthCheck, #True)
    Next x
      For x = 0 To 4
        bc(x) = CreateParticleEmitter(#PB_Any, 100, 100, 100, #PB_Particle_Point, 0, 0, -50)
        ParticleMaterial(bc(x), MaterialID(mat(0)\ma))
        ParticleSize(bc(x), 0.4, 0.4)
        ParticleVelocity(bc(x), 0.000001, 0.00002)
        ParticleSpeedFactor(bc(x), 0.04)
        ParticleTimeToLive(bc(x), 25, 55)
        ParticleEmissionRate(bc(x), Random(10000, 7000))
        ParticleEmitterDirection(bc(x), 0, 0, 1)
      Next x
    node = CreateNode(#PB_Any, 0, 0, 0)
  EndIf
  ProcedureReturn scr
EndProcedure

Procedure.i BuildDNA()
  Protected start.f = 20, rotate.f = 0, Change.f = 0
  node = CreateNode(#PB_Any, 0, 0, -8)
  AddElement(set())
  base\ms = LoadMesh(#PB_Any, "base.mesh")
  base\id = CreateEntity(#PB_Any, MeshID(base\ms), #PB_Material_None, 20, 0, 0)
  AttachNodeObject(node, EntityID(base\id))
  While start > - 20
    AddElement(set())
    set()\id = CopyEntity(base\id, #PB_Any)
    MoveEntity(set()\id, start, 0, 0)
    RotateEntity(set()\id, rotate, Change, 0, #PB_Absolute)
    AttachNodeObject(node, EntityID(set()\id))
    start - 0.135
    rotate + 4
    Change + 10
  Wend
  ProcedureReturn #True
EndProcedure

Procedure.i ThreadAnim(value.i = 1)
  Protected x.i, count.i = 0, elap = ElapsedMilliseconds()
  Repeat
    If ElapsedMilliseconds() - elap > 50
      For x = 0 To 4
        If IsParticleEmitter(bc(x)) > 0
          ParticleMaterial(bc(x), MaterialID(mat(count)\ma))
        EndIf
      Next x
      If count + 1 > 18 : count = 0 : Else : count + 1 : EndIf
      elap = ElapsedMilliseconds()
      Delay(1)
    EndIf
  Until quit = #True
EndProcedure

Procedure.i ShowStatus()
  If IsSprite(sp) = 0 : sp = CreateSprite(#PB_Any, 200, 40) : TransparentSpriteColor(sp, $0) : EndIf
  StartDrawing(SpriteOutput(sp))
  DrawingMode(#PB_2DDrawing_Transparent)
  Box(0, 0, 200, 40, $0)
  DrawText(0, 0, " Fps: " + StrF(Engine3DStatus(#PB_Engine3D_AverageFPS), 3), $FFFF00)
  StopDrawing()
  DisplayTransparentSprite(sp, 0, 0)
EndProcedure

Procedure.i RunDNA()
  Repeat
    Repeat
      ev = WindowEvent()
    Until ev = 0
    RotateNode(node, 1, 0, 0, #PB_Relative)
    RenderWorld()
    ShowStatus()
    FlipBuffers()
    ExamineKeyboard()
    If KeyboardPushed(#PB_Key_Escape) : Quit = #True : Delay(10) : EndIf
  Until Quit = #True
EndProcedure

If BuildScene() > 0
  ret = BuildDNA()
  thrMat = CreateThread(@ThreadAnim(), 1)
  ret = RunDNA()
EndIf
For pb5.6x

Code: Select all

;By DK_PETER (Requires 5.60 and above)
UseJPEGImageDecoder()
UseGIFImageDecoder()

If InitEngine3D(#PB_Engine3D_DebugLog|#PB_Engine3D_AverageFPS) = 0
  MessageRequester("Engine problem", "Unable to initialize Ogre3D")
  End
EndIf
If InitSprite() = 0
  MessageRequester("Sprite Init error", "Can't initialize screen")
  End
EndIf
If InitKeyboard() = 0
  MessageRequester("Keyboard", "No keyboard...")
  End
EndIf

Structure _Object
  bs.i
  id.i
  ms.i
  ma.i
  tx.i[3]
EndStructure
Global bg._Object

Structure _dna
  id.i
  ms.i
EndStructure
Global NewList set._dna(), base._dna

Declare.i BuildDNA()
Declare.i BuildScene()
Declare.i RunDNA()
Declare.i BuildBase()
Declare.i ShowStatus()

Global node.i, Dim bc.i(5), lg.i, sp.i

Procedure.i BuildScene()
  Protected scr.i, x.i, y.i, r.i, c.i
  AntialiasingMode(#PB_AntialiasingMode_x6)
  ExamineDesktops()
  OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Dna", #PB_Window_BorderLess)
  scr = OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0))
  Add3DArchive(".", #PB_3DArchive_FileSystem)
  Add3DArchive("gif", #PB_3DArchive_FileSystem)
  Add3DArchive("mesh", #PB_3DArchive_FileSystem)
  Add3DArchive("material", #PB_3DArchive_FileSystem)
  Add3DArchive("texture", #PB_3DArchive_FileSystem)
  Parse3DScripts()
  If scr > 0
    WorldShadows(#PB_Shadow_Additive)
    CreateCamera(0, 0, 0, 100, 100)
    MoveCamera(0, 0, 0, 0)
    lg = CreateLight(#PB_Any, $FFFFFF, 0, 17, -17)
    With bg
      \ms = CreateCube(#PB_Any, 30)
      \tx[0] = CreateTexture(#PB_Any, 1024, 1024, "Blood")
      StartDrawing(TextureOutput(\tx[0]))
      Box(0, 0, 1024, 1024, $0003B8)
      StopDrawing()
      \tx[1] = LoadTexture(#PB_Any, "veins.jpg")
      \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
      AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
      AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
      ScaleMaterial(\ma, 0.4, 0.4, 1)
      ScaleMaterial(\ma, 0.6, 0.6, 2)
      ScrollMaterial(\ma, -0.01, 0.008, #PB_Material_Animated, 1)
      SetMaterialAttribute(\ma, #PB_Material_EnvironmentMap, #PB_Material_ReflectionMap, 1)
      SetMaterialAttribute(\ma, #PB_Material_EnvironmentMap, #PB_Material_ReflectionMap, 2)
      MaterialCullingMode(bg\ma, #PB_Material_AntiClockWiseCull)
      \id = CreateEntity(#PB_Any, MeshID(bg\ms), MaterialID(bg\ma), 0, 0, 0)
      ScaleEntity(\id, 20, 20, 20)
    EndWith
      tx = CreateTexture(#PB_Any, 800, 600, "Cell")
      StartDrawing(TextureOutput(tx))
      Box(0, 0, 800, 600, $FFFFFF)
      StopDrawing()
      CreateMaterial(0, TextureID(tx))
      MaterialBlendingMode(0, #PB_Material_AlphaBlend)
      SetMaterialColor(0, #PB_Material_SelfIlluminationColor, $0000C5)
      MaterialAnimation(0, "cell.gif", 18, 1)
      For x = 0 To 4
        bc(x) = CreateParticleEmitter(#PB_Any, 100, 100, 100, #PB_Particle_Point, 0, 0, -50)
        ParticleMaterial(bc(x), MaterialID(0))
        ParticleSize(bc(x), 0.4, 0.4)
        ParticleVelocity(bc(x), #PB_Particle_MinimumVelocity, 0.01)
        ParticleVelocity(bc(x), #PB_Particle_Velocity, 1)
        ParticleVelocity(bc(x), #PB_Particle_MaximumVelocity, 2)
        ParticleTimeToLive(bc(x), 25, 55)
        ParticleEmissionRate(bc(x), Random(6000, 4000))
        ParticleEmitterDirection(bc(x), 0, 0, 1)
      Next x
    node = CreateNode(#PB_Any, 0, 0, 0)
  EndIf
  ProcedureReturn scr
EndProcedure

Procedure.i BuildDNA()
  Protected start.f = 20, rotate.f = 0, Change.f = 0
  node = CreateNode(#PB_Any, 0, 0, -8)
  AddElement(set())
  base\ms = LoadMesh(#PB_Any, "base.mesh")
  base\id = CreateEntity(#PB_Any, MeshID(base\ms), #PB_Material_None, 20, 0, 0)
  AttachNodeObject(node, EntityID(base\id))
  While start > - 20
    AddElement(set())
    set()\id = CopyEntity(base\id, #PB_Any)
    MoveEntity(set()\id, start, 0, 0)
    RotateEntity(set()\id, rotate, Change, 0, #PB_Absolute)
    AttachNodeObject(node, EntityID(set()\id))
    start - 0.135
    rotate + 4
    Change + 10
  Wend
  ProcedureReturn #True
EndProcedure

Procedure.i ShowStatus()
  If IsSprite(sp) = 0 : sp = CreateSprite(#PB_Any, 400, 80) : TransparentSpriteColor(sp, $0) : EndIf
  StartDrawing(SpriteOutput(sp))
  DrawingMode(#PB_2DDrawing_Transparent)
  Box(0, 0, 400, 80, $0)
  DrawText(0, 0, " Fps: " + StrF(Engine3DStatus(#PB_Engine3D_AverageFPS), 3), $FFFF00)
  StopDrawing()
  DisplayTransparentSprite(sp, 0, 0)
EndProcedure

Procedure.i RunDNA()
  Repeat
    Repeat
      ev = WindowEvent()
    Until ev = 0
    RotateNode(node, 1, 0, 0, #PB_Relative)
    RenderWorld()
    ShowStatus()
    FlipBuffers()
    ExamineKeyboard()
  Until KeyboardPushed(#PB_Key_Escape)
EndProcedure

If BuildScene() > 0
  ret = BuildDNA()
  ret = RunDNA()
EndIf
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Re: Rough dna representation

Post by djes »

Itchy ! :mrgreen:
User avatar
Bisonte
Addict
Addict
Posts: 1226
Joined: Tue Oct 09, 2007 2:15 am

Re: Rough dna representation

Post by Bisonte »

I take my hat off to these artists who can create such impressive works with so tiny codes. Image
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
English is not my native language... (I often use DeepL to translate my texts.)
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Rough dna representation

Post by applePi »

Thanks DK_PETER, i can say this an ART doing using programming
i imagine the spiky DNA is for the Aliens (UFO riders) :D
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: Rough dna representation

Post by Fred »

Very nice piece of work !
HanPBF
Enthusiast
Enthusiast
Posts: 563
Joined: Fri Feb 19, 2010 3:42 am

Re: Rough dna representation

Post by HanPBF »

Not the best comment, but...

...coooooooool!!!
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Rough dna representation

Post by Kwai chang caine »

Niiiiiice !!! 8)

I have the blood all returned :lol:
ImageThe happiness is a road...
Not a destination
Post Reply