It is currently Tue Mar 31, 2020 8:11 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 7 posts ] 
Author Message
 Post subject: Rough dna representation
PostPosted: Tue Sep 19, 2017 8:07 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 843
Location: Denmark
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:
;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:
;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

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 10, Intel 6800K, GeForce Gtx 1060, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Tue Sep 19, 2017 11:44 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 2:46 pm
Posts: 1799
Location: Pas-de-Calais, France
Itchy ! :mrgreen:


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Tue Sep 19, 2017 12:52 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Oct 09, 2007 2:15 am
Posts: 1108
I take my hat off to these artists who can create such impressive works with so tiny codes. Image

_________________
PureBasic 5.71 LTS (Windows x86/x64) | Windows10 Pro x64 | Z370 Extreme4 | i7 8770k | 32GB RAM | iChill GeForce RTX 2080 Super | HAF XF Evo​​
English is not my native language... (I often use DeepL to translate my texts.)


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Tue Sep 19, 2017 3:08 pm 
Offline
Addict
Addict

Joined: Sun Jun 25, 2006 7:28 pm
Posts: 1397
Thanks DK_PETER, i can say this an ART doing using programming
i imagine the spiky DNA is for the Aliens (UFO riders) :D


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Tue Sep 19, 2017 3:57 pm 
Online
Administrator
Administrator

Joined: Fri May 17, 2002 4:39 pm
Posts: 14011
Location: France
Very nice piece of work !


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Tue Sep 19, 2017 7:13 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 19, 2010 3:42 am
Posts: 541
Not the best comment, but...

...coooooooool!!!


Top
 Profile  
Reply with quote  
 Post subject: Re: Rough dna representation
PostPosted: Wed Sep 20, 2017 7:22 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4658
Location: Lyon - France
Niiiiiice !!! 8)

I have the blood all returned :lol:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 7 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye