Something beautiful...
Posted: Thu Aug 14, 2014 4:32 pm
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()
WOW, just WOW