Something beautiful...

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

Something beautiful...

Post by DK_PETER »

Code: Select all

;It has absolutely no real value, 
;but I think, that it looks good and I certainly enjoy these things...
;(Title: A world inside an entity)
;By Peter Bach - DK_PETER
;Keys 1-9 and Q-Y changes shapes
;Arrow keys to move 
;(Continue pressing an arrow key either increases Or decreases speed) - release arrow key means full stop
; + and - to change rotational speed of entity
;Enjoy...
InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()

DeclareModule _Patterns
  Declare.i DoScreen(Width.i = 1024, Height.i = 768)
  Declare.i BeginJoy()
EndDeclareModule

Module _Patterns
  Structure _mesh
    id.i
    ms.i
    tx.i
    mt.i
  EndStructure
  
  Structure vector3D
    x.f
    y.f
    z.f
  EndStructure
  
  Declare.i Calc(*ReturnVec.Vector3D, CenterX.f, CenterY.f, CenterZ.f, AngleX.f, AngleY.f, RadiusX.i, RadiusY.i, RadiusZ.i )
  Global ms._mesh, cam.i, v.vector3D, rotaspeed.f = 0.01, keyx.f = 0.0, keyy.f = 0.0
  
  Procedure.i DoScreen(Width.i = 1024, Height.i = 768)
    OpenWindow(0, 0, 0, Width, Height, "I truly enjoy Ogre3D", #PB_Window_ScreenCentered)
    OpenWindowedScreen(WindowID(0), 0, 0, Width, Height,0, 0, 0, #PB_Screen_SmartSynchronization)
    cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
    MoveCamera(cam, 0, 0, 800)
  EndProcedure
  
  Procedure.i Createsomething(Index.i = 0)
    MoveCamera(cam, 0, 0, 800, #PB_Absolute)  ;<---#PB_Absolute (forgot the constant)
    CameraLookAt(cam, 0, 0, 0)
    If IsEntity(ms\id) > 0
      FreeEntity(ms\id)
      FreeMaterial(ms\mt)
      FreeTexture(ms\tx)
      FreeMesh(ms\ms)
    EndIf
    
    ms\ms = CreateMesh(#PB_Any, #PB_Mesh_PointList,#PB_Mesh_Dynamic)
    v\x = 0: v\y = 0: v\z = 0
    For x = 0 To 1000
      For y = 0 To 1000
        Select Index
          Case 0
            Calc(v, 0, 0, 0, x, y, x, x, y)
            MeshVertexPosition(v\x , v\y, v\z)
          Case 1
            Calc(v, 0, 0, 0, x, y , x*Tan(Cos(y)),  Random(100), x-1 )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 2
            Calc(v, 0, 0, 0, Random(360), Random(360), x,  Random(400), x )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 3
            Calc(v, 0, 0, 0, x*0.3, y*0.4 , x*0.2,  Random(100), x )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 4
            Calc(v, 0, x, 0, x*Sqr(y), y*Sin(y) , x*Cos(x),  Random(700), x )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 5
            Calc(v, 0, 0, 0, Random(180), Random(180) , x + Random(20),  x + Random(20), y + Random(20))
            MeshVertexPosition(v\x , v\y, v\z)
          Case 6
            Calc(v, 0, 0, 0, (x+1) / 0.6, (y+2)/0.4 , x ,  y , x)
            MeshVertexPosition(v\x , v\y, v\z)
          Case 7
            Calc(v, 0, 0, 0, x, y , x,  Random(100), x )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 8
            Calc(v, 0, 0, 0, Random(60), y , x+Random(100),  Random(100), x + Random(100) )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 9
            Calc(v, (Random(15,1)/0.3), (Random(15,1)/0.3), (Random(15,1)/0.3), Random(90), Random(90) , x+Random(100),  x + Random(100), x + Random(100) )
            MeshVertexPosition(v\x, v\y, v\z)
          Case 10
            Calc(v, 0, 0, 0, x * 0.3, y * 0.2, x, x, y)
            MeshVertexPosition(v\x , v\y, v\z)
          Case 11
            Calc(v, 0, 0, 0, x , y , x, x, x )
            MeshVertexPosition(v\x , v\y , v\z)
          Case 12
            Calc(v, 0, 0, 0, x, y , x*Tan(Cos(y)),  y*Tan(Sin(x)), x-1 )
            MeshVertexPosition(v\x , v\y, v\z)
          Case 13
            Calc(v, 0, 0, 0, x, y , x*Tan(Cos(y)),  y*Tan(Sin(x)), x*Tan(Cos(y)))
            MeshVertexPosition(v\x , v\y, v\z)
          Case 14
            Calc(v, 0, 0, 0, Radian(x), Radian(y) , x*Tan(Sin(y)),  y*Tan(Cos(x)), x*Tan(Sin(y)))
            MeshVertexPosition(v\x , v\y, v\z)
        EndSelect
      Next y
    Next x
    NormalizeMesh(ms\ms)
    FinishMesh(#True)
    
    ms\tx = CreateTexture(#PB_Any, 256, 256)
    StartDrawing(TextureOutput(ms\tx))
    DrawingMode(#PB_2DDrawing_Gradient)
    FrontColor(RGB(Random(255,50),Random(255,50),Random(255,50)))
    BackColor(RGB(Random(255,50),Random(255,50),Random(255,50)))
    BoxedGradient(0,0,256,256)
    Box(0,0,256,256)
    StopDrawing()
    ms\mt = CreateMaterial(#PB_Any, TextureID(ms\tx))
    MaterialBlendingMode(ms\mt,#PB_Material_Add)
    ms\id = CreateEntity(#PB_Any, MeshID(ms\ms),MaterialID(ms\mt))
  EndProcedure
  
  Procedure.i BeginJoy()
    Createsomething(0)
    
    Repeat
      Repeat: ev=WindowEvent():Until ev=0
      RotateEntity(ms\id, rotaspeed, rotaspeed, rotaspeed, #PB_Relative)
      ExamineMouse()
      RotateCamera(cam, -MouseDeltaY()*0.05, -MouseDeltaX()*0.05, 0, #PB_Relative)
      RenderWorld()
      ExamineKeyboard()
      If KeyboardReleased(#PB_Key_1)
        Createsomething(0)
      ElseIf KeyboardReleased(#PB_Key_2)
        Createsomething(1)
      ElseIf KeyboardReleased(#PB_Key_3)
        Createsomething(2)
      ElseIf KeyboardReleased(#PB_Key_4)
        Createsomething(3)
      ElseIf KeyboardReleased(#PB_Key_5)
        Createsomething(4)
      ElseIf KeyboardReleased(#PB_Key_6)
        Createsomething(5)
      ElseIf KeyboardReleased(#PB_Key_7)
        Createsomething(6)
      ElseIf KeyboardReleased(#PB_Key_8)
        Createsomething(7)
      ElseIf KeyboardReleased(#PB_Key_9)
        Createsomething(8)
      ElseIf KeyboardReleased(#PB_Key_Q)
        Createsomething(9)
      ElseIf KeyboardReleased(#PB_Key_W)
        Createsomething(10)
      ElseIf KeyboardReleased(#PB_Key_E)
        Createsomething(11)
      ElseIf KeyboardReleased(#PB_Key_R)
        Createsomething(12)
      ElseIf KeyboardReleased(#PB_Key_T)
        Createsomething(13)
      ElseIf KeyboardReleased(#PB_Key_Y)
        Createsomething(14)
      EndIf
      If KeyboardPushed(#PB_Key_Add)
        rotaspeed + 0.01
      EndIf
      If KeyboardPushed(#PB_Key_Subtract)
        rotaspeed - 0.01
      EndIf
      
      If KeyboardPushed(#PB_Key_Left)
        keyx - 0.1
      ElseIf KeyboardPushed(#PB_Key_Right)
        keyx + 0.1
      Else
        keyx = 0
      EndIf
      If KeyboardPushed(#PB_Key_Up)
        keyy - 0.1
      ElseIf KeyboardPushed(#PB_Key_Down)
        keyy + 0.1
      Else
        keyy = 0
      EndIf
      MoveCamera(cam, keyx, 0, keyy)
      
      FlipBuffers()
      
    Until KeyboardPushed(#PB_Key_Escape)
    End
  EndProcedure
  
  Procedure.i Calc(*ReturnVec.Vector3D, CenterX.f, CenterY.f, CenterZ.f, AngleX.f, AngleY.f, RadiusX.i, RadiusY.i, RadiusZ.i )
    *ReturnVec\X = CenterX + RadiusX*Cos(AngleY)*Cos(AngleX)
    *ReturnVec\Y = CenterY + RadiusY*Sin(AngleX)
    *ReturnVec\Z = CenterZ + RadiusZ*Sin(AngleY)*Cos(AngleX)
  EndProcedure
  
EndModule

_Patterns::DoScreen()
_Patterns::BeginJoy()
Last edited by DK_PETER on Tue Aug 19, 2014 3:24 am, edited 5 times in total.
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.
Top
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Something beautiful...

Post by applePi »

thanks, thats truly something beautiful, art and mathematics. and have several strategies useful for me and the others. thousands of points and still the graphics are easy to manipulate.
i was thinking today about points and big and textured points. and in the morning Samuel was thinking about submeshes !!!! a coincidence .
Top
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:
Contact DK_PETER

Re: Something beautiful...

Post by DK_PETER »

@applePi.
Anytime. Glad, that you find it usefull. ;-)
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.
Top
User avatar
Bananenfreak
Enthusiast
Enthusiast
Posts: 519
Joined: Mon Apr 15, 2013 12:22 pm

Re: Something beautiful...

Post by Bananenfreak »

Looks beautiful :)
Image
Top
User avatar
AndyLy
Enthusiast
Enthusiast
Posts: 228
Joined: Tue Jan 04, 2011 11:50 am
Location: GRI

Re: Something beautiful...

Post by AndyLy »

Oh yes, it's beautiful. Good work!
'Happiness for everybody, free, and no one will go away unsatisfied!'
SMsF town: http://www.youtube.com/watch?v=g6RRKYf_Pd0
SMf locations module (Ogre). Game video: http://www.youtube.com/watch?v=ZlhBgPJhAxI
Top
Fred
Administrator
Administrator
Posts: 18153
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Re: Something beautiful...

Post by Fred »

This is great work :)
Top
User avatar
Samuel
Enthusiast
Enthusiast
Posts: 755
Joined: Sun Jul 29, 2012 10:33 pm
Location: United States

Re: Something beautiful...

Post by Samuel »

Very nice example! Good work, DK_PETER. :D
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Something beautiful...

Post by davido »

@DK_PETER,
Very nice, thank you for sharing. :D
DE AA EB
Top
box_80
Enthusiast
Enthusiast
Posts: 115
Joined: Mon Sep 03, 2012 8:52 pm

Re: Something beautiful...

Post by box_80 »

Really cool, all of them is so interesting. :D
Top
User avatar
falsam
Enthusiast
Enthusiast
Posts: 632
Joined: Wed Sep 21, 2011 9:11 am
Location: France
Contact:
Contact falsam

Re: Something beautiful...

Post by falsam »

Nice and Zen. thank you for sharing DK_Peter :)

Edit : Minor: Why declare variables width and height and do not use them ? :mrgreen:

Code: Select all

Procedure.i DoScreen(Width.i = 1024, Height.i = 768)
    OpenWindow(0, 0, 0, 1024, 768, "I truly enjoy Ogre3D", #PB_Window_ScreenCentered)
    OpenWindowedScreen(WindowID(0), 0, 0, 1024, 768,0, 0, 0, #PB_Screen_SmartSynchronization)
    KeyboardMode(#PB_Keyboard_International)
    cam = CreateCamera(#PB_Any, 0, 0, 100, 100)
    MoveCamera(cam, 0, 0, 800)
  EndProcedure

➽ Windows 11 64-bit - PB 6.21 x64 - AMD Ryzen 7 - NVIDIA GeForce GTX 1650 Ti

Sorry for my bad english and the Dunning–Kruger effect 🤪
Top
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:
Contact DK_PETER

Re: Something beautiful...

Post by DK_PETER »

I'm glad, that you guys liked it.

@falsam
Oooops... :)
Fixed now. It's a copy/paste blunder.
Some of the Code was copied from a much larger project
I'm creating with beautiful objects.
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.
Top
User avatar
flaith
Enthusiast
Enthusiast
Posts: 704
Joined: Mon Apr 25, 2005 9:28 pm
Location: $300:20 58 FC 60 - Rennes
Contact:
Contact flaith

Re: Something beautiful...

Post by flaith »

:shock: WOW, just WOW :D
“Fear is a reaction. Courage is a decision.” - WC
Top
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:
Contact DK_PETER

Re: Something beautiful...

Post by DK_PETER »

Hey.

If there are anyone, who wishes to try my "something beautiful" work
then here are the links. The program is work in progress and has freeware status as usual.

Links will stay online until sunday.. and removed that day

Help file is onscreen and it will create a screen of desktop size for now.

Windows 64 bit version:
pooof..vanished

Windows 32 bit version:
pling....gone

Just unpack and run.
enjoy
Last edited by DK_PETER on Sat Aug 16, 2014 11:38 pm, edited 1 time in total.
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.
Top
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Something beautiful...

Post by applePi »

thats really very good graphics, i prefer a slightly more rotational default speed before pressing '+' . as an application i can see it is possible to present the figures continuously and then casting it to a big screen in festivals, conferences, etc. but i have no experience how to do this exactly, i remember someone in the forum was doing this.
from festivals to plotting the particles trajectories in CERN Labs to simulating galaxies, this is very good to use purebasic for.
Top
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Re: Something beautiful...

Post by PB »

I put "DisableDebugger" as the first line to make it run as fast as possible,
but then it generates this runtime error:

Code: Select all

Line: 133 - InitKeyboard() must be called successfully before using any Keyboard commands.
Which is strange because InitKeyboard() is called prior to any keyboard commands. A bug?
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
Top
Post Reply

Return to “3D Programming”