Looks good. I really like the tube and the half cylinder example has potential too.
Thank you both for the examples.
Adding the meshes from StarBootics and we got a nice collection of meshes to work with.
Here's a little something from me. Messy but functioning.
Code: Select all
;NAME: MIDEVAL
;BY DK_PETER
;-----------------------------------------
;Test for CreateCone() and CreateTube()
;-----------------------------------------
Structure Vector3
x.f
y.f
z.f
EndStructure
Procedure Normalize(*V.Vector3)
Define.f magSq, oneOverMag
magSq = *V\x * *V\x + *V\y * *V\y + *V\z * *V\z
If magsq > 0
oneOverMag = 1.0 / Sqr(magSq)
*V\x * oneOverMag
*V\y * oneOverMag
*V\z * oneOverMag
EndIf
EndProcedure
Procedure CreateTube(meshID, outerRadius.f, innerRadius.f, height.f, numSegBase=16, numSegHeight=1)
Protected Normal.Vector3, returnMesh.i
If meshID = -1
returnMesh = CreateMesh(#PB_Any)
Else
returnMesh = meshID
CreateMesh(returnMesh)
EndIf
If numSegBase < 1
numSegBase = 1
EndIf
If numSegHeight < 1
numSegHeight = 1
EndIf
deltaAngle.f = #PI*2 / numSegBase
deltaHeight.f = height / numSegHeight
height2.f = height / 2.0
offset = 0
For i = 0 To numSegHeight
For j = 0 To numSegBase
x0.f = outerRadius * Cos(j*deltaAngle)
z0.f = outerRadius * Sin(j*deltaAngle)
Normal\x = x0
Normal\y = 0
Normal\z = z0
Normalize(@Normal)
MeshVertexPosition(x0, i*deltaHeight-height2, z0)
MeshVertexNormal(Normal\x, Normal\y, Normal\z)
MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
If i <> numSegHeight
MeshIndex(offset + numSegBase + 1)
MeshIndex(offset)
MeshIndex(offset + numSegBase)
MeshIndex(offset + numSegBase + 1)
MeshIndex(offset + 1)
MeshIndex(offset)
EndIf
offset + 1
Next
Next
For i = 0 To numSegHeight
For j = 0 To numSegBase
x0.f = innerRadius * Cos(j*deltaAngle)
z0.f = innerRadius * Sin(j*deltaAngle)
Normal\x = x0
Normal\y = 0
Normal\z = z0
Normalize(@Normal)
MeshVertexPosition(x0, i*deltaHeight-height2, z0)
MeshVertexNormal(Normal\x, Normal\y, Normal\z)
MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
If i <> numSegHeight
MeshIndex(offset + numSegBase + 1)
MeshIndex(offset + numSegBase)
MeshIndex(offset)
MeshIndex(offset + numSegBase + 1)
MeshIndex(offset)
MeshIndex(offset + 1)
EndIf
offset + 1
Next
Next
;low cap
For j = 0 To numSegBase
x0.f = innerRadius * Cos(j*deltaAngle)
z0.f = innerRadius * Sin(j*deltaAngle)
MeshVertexPosition(x0, -height2, z0)
MeshVertexNormal(0, -1, 0)
MeshVertexTextureCoordinate(j / numSegBase, 1)
x0 = outerRadius * Cos(j*deltaAngle)
z0 = outerRadius * Sin(j*deltaAngle)
MeshVertexPosition(x0, -height2, z0)
MeshVertexNormal(0, -1, 0)
MeshVertexTextureCoordinate(j / numSegBase, 0)
If j <> numSegBase
MeshIndex(offset)
MeshIndex(offset + 1)
MeshIndex(offset + 3)
MeshIndex(offset + 2)
MeshIndex(offset)
MeshIndex(offset + 3)
EndIf
offset + 2
Next
;high cap
For j = 0 To numSegBase
x0.f = innerRadius * Cos(j*deltaAngle)
z0.f = innerRadius * Sin(j*deltaAngle)
MeshVertexPosition(x0, height2, z0)
MeshVertexNormal(0, 1, 0)
MeshVertexTextureCoordinate(j / numSegBase, 0)
x0 = outerRadius * Cos(j*deltaAngle)
z0 = outerRadius * Sin(j*deltaAngle)
MeshVertexPosition(x0, height2, z0)
MeshVertexNormal(0, 1, 0)
MeshVertexTextureCoordinate(j / numSegBase, 1)
If j <> numSegBase
MeshIndex(offset + 1)
MeshIndex(offset)
MeshIndex(offset + 3)
MeshIndex(offset)
MeshIndex(offset + 2)
MeshIndex(offset + 3)
EndIf
offset + 2
Next
FinishMesh(#True)
ProcedureReturn returnMesh
EndProcedure
;-----------------------------------------------------------------------------------------
InitEngine3D()
InitSprite()
InitMouse()
InitKeyboard()
UseJPEGImageEncoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()
Structure _mesh
id.i
mat.i
mes.i
tex.i
EndStructure
Structure _Castle
tow._mesh[4]
roof._mesh
walls._mesh[6]
Bridge._mesh
pillars._mesh[3]
base._mesh
fire._mesh
smoke._mesh
EndStructure
Declare.i CreateCastle()
Declare.i CreateClouds()
Declare.i CreateLand()
Declare.i CreateSky()
Declare.f FastDist(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)
Global cas._Castle, grnd._mesh, cl._mesh, Quit.i = 0, TmpPath.s, fd.f
Define.f KeyX, KeyY
TmpPath = #PB_Compiler_Home + "Examples\3D\Data\Textures\"
OpenWindow(0, 0, 0, 1024, 768, "Mideval - use arrow keys and enter...", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0, 0, 1024, 768)
Add3DArchive("..",#PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures", #PB_3DArchive_FileSystem)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 1, 40)
CreateLight(0, $FFFFFF, 0, 50, -250, #PB_Light_Directional)
LightLookAt(0, 0, 0, 0)
CreateLand()
CreateSky()
CreateClouds()
CreateCastle()
Repeat
Repeat
ev = WindowEvent()
If ev = #PB_Event_CloseWindow : quit = 1 : EndIf
Until ev = 0
ExamineMouse()
RotateCamera(0,-MouseDeltaY()* 0.04, -MouseDeltaX()* 0.04, 0, #PB_Relative)
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Left)
KeyX = -0.05
ElseIf KeyboardPushed(#PB_Key_Right)
KeyX = 0.05
Else
KeyX = 0
EndIf
If KeyboardPushed(#PB_Key_Up)
KeyY = -0.05
ElseIf KeyboardPushed(#PB_Key_Down)
KeyY = 0.05
Else
KeyY = 0
EndIf
fd = FastDist(CameraX(0), CameraY(0), CameraZ(0), 0, 0, 0)
If fd < 90
RotateEntity(cas\Bridge\id, -fd, 0, 0, #PB_Absolute)
ElseIf fd > 90
RotateEntity(cas\Bridge\id, 90, 0, 0, #PB_Absolute)
EndIf
MoveCamera(0, KeyX, 0, KeyY)
MoveCamera(0, CameraX(0), 1, CameraZ(0), #PB_Absolute)
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
Procedure.i CreateLand()
Protected iim.i
With grnd
iim = LoadImage(#PB_Any,TmpPath + "grass.jpg")
\mes = CreatePlane(#PB_Any, 100, 100, 1, 1, 1, 1)
\tex = CreateTexture(#PB_Any, 2048, 2048)
StartDrawing(TextureOutput(\tex))
For x = 0 To 3
For y = 0 To 3
DrawImage(ImageID(IIm), x*ImageWidth(iim), y * ImageHeight(iim))
Next y
Next x
FreeImage(iim)
For y = 0 To 2048 Step 2
Select Random(100, 0)
Case 0 To 25
Ellipse(990+2, y, 60, 5,$06516F)
Case 26 To 50
Ellipse(990-2, y, 60, 5,$06516F)
Case 51 To 75
Ellipse(990+6, y, 60, 5,$06516F)
Default
Ellipse(990-6, y, 60, 5,$06516F)
EndSelect
Select Random(100, 0)
Case 0 To 25
Ellipse(1000+1, y, 3, 8,$004702)
Case 26 To 50
Ellipse(1000-1, y, 3, 8,$004702)
Case 51 To 75
Ellipse(1000+1, y, 3, 8,$004702)
Default
Ellipse(1000-1, y, 3, 8,$004702)
EndSelect
Select Random(100, 0)
Case 0 To 25
Ellipse(970+1, y, 9, 16,$082840)
Case 26 To 50
Ellipse(970-1, y, 9, 16,$082840)
Case 51 To 75
Ellipse(970+1, y, 9, 12,$082840)
Default
Ellipse(970-1, y, 9, 16,$082840)
EndSelect
Select Random(100, 0)
Case 0 To 25
Ellipse(1025+1, y, 9, 16,$082840)
Case 26 To 50
Ellipse(1025-1, y, 9, 16,$082840)
Case 51 To 75
Ellipse(1025+1, y, 9, 12,$082840)
Default
Ellipse(1025-1, y, 9, 16,$082840)
EndSelect
Next y
StopDrawing()
\mat = CreateMaterial(#PB_Any, TextureID(\tex))
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat))
EndWith
EndProcedure
Procedure.i CreateCastle()
Protected tx.i, piltex.i, Shift.i = 0
tx = LoadTexture(#PB_Any, "terrain_detail.jpg")
piltex = LoadTexture(#PB_Any, "Wood.jpg")
With cas\walls[0]
\mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-5,0,0)
RotateEntity(\id, 90, 0, 0)
EndWith
With cas\walls[1]
\mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-7.5,0,-7.5)
RotateEntity(\id, 90, 90, 0)
EndWith
With cas\tow[0]
\mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-9,0,-0.5)
EndWith
With cas\walls[2]
\mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),5,0,0)
RotateEntity(\id, 90, 0, 0)
EndWith
With cas\walls[3]
\mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),7.5,0,-7.5)
RotateEntity(\id, 90, 90, 0)
EndWith
With cas\tow[1]
\mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),9,0,-0.5)
EndWith
With cas\tow[2]
\mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-9,0,-15.5)
EndWith
With cas\tow[3]
\mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),9,0,-15.5)
EndWith
With cas\walls[4]
\mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),0,0,-15)
RotateEntity(\id, 90, 0, 0)
EndWith
With cas\walls[5]
\mes = CreatePlane(#PB_Any, 15, 3, 10, 10, 2, 1)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat , #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),0,4.5,0)
RotateEntity(\id, 90, 0, 0)
EndWith
With cas\base
\mes = CreateTube(#PB_Any, 1.3, 1.8, 2.0)
\mat = CreateMaterial(#PB_Any, TextureID(tx))
MaterialCullingMode(\mat, #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 0, -10.5)
EndWith
With cas\roof
;Added CreateCone's NbBaseSegment and NbHeightSegments to make it work with PB x86 and windows. If omitted - an error occur for (Unknown reason?)
\mes = CreateCone(#PB_Any, 2.3, 1.5, 32, 16)
\tex = LoadTexture(#PB_Any, "RustySteel.jpg")
\mat = CreateMaterial(#PB_Any, TextureID(\tex))
MaterialCullingMode(\mat, #PB_Material_NoCulling)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 2.6, -10.5)
EndWith
With cas\pillars[0]
\mat = CreateMaterial(#PB_Any, TextureID(piltex))
\mes = CreateCylinder(#PB_Any, 0.1, 1)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 1.5, -9)
EndWith
With cas\pillars[1]
\mat = CreateMaterial(#PB_Any, TextureID(piltex))
\mes = CreateCylinder(#PB_Any, 0.1, 1)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), -1.2, 1.5, -11)
EndWith
With cas\pillars[2]
\mat = CreateMaterial(#PB_Any, TextureID(piltex))
\mes = CreateCylinder(#PB_Any, 0.1, 1)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 1.2, 1.5, -11)
EndWith
With cas\Fire
\tex = CreateTexture(#PB_Any, 10, 10)
StartDrawing(TextureOutput(\tex))
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
FrontColor($FF00FFFF) : BackColor($FF0020FF)
CircularGradient(5, 7, 5)
Circle(5, 5, 5)
StopDrawing()
\id = CreateParticleEmitter(#PB_Any, 0.6, 0.6, 0.6,#PB_Particle_Point, 0, 0.3, -11)
\mat = CreateMaterial(#PB_Any, TextureID(\tex))
MaterialBlendingMode(\mat, #PB_Material_Add)
MaterialCullingMode(\mat, #PB_Material_NoCulling)
ParticleEmitterDirection(\id, 0, 1, 0)
ParticleEmissionRate(\id, 200)
ParticleSize(\id, 0.1, 0.7)
ParticleMaterial(\id, MaterialID(\mat))
ParticleVelocity(\id, 0.1, 1)
ParticleTimeToLive(\id,0.01, 0.1)
ParticleSpeedFactor(\id, 0.4)
EndWith
With cas\smoke
\tex = LoadTexture(#PB_Any, "smoke.png")
\id = CreateParticleEmitter(#PB_Any, 0.3, 0.5, 0.5,#PB_Particle_Point, 0, 0.6, -11)
\mat = CreateMaterial(#PB_Any, TextureID(\tex))
MaterialBlendingMode(\mat, #PB_Material_AlphaBlend)
ParticleEmitterDirection(\id, 0, 1, 0)
ParticleEmissionRate(\id, 30)
ParticleSize(\id, 1.3, 1.3)
ParticleMaterial(\id, MaterialID(\mat))
ParticleVelocity(\id, 0.1, 0.2)
ParticleTimeToLive(\id,0.6, 1.0)
ParticleSpeedFactor(\id, 0.1)
EndWith
With cas\Bridge
\mat = CreateMaterial(#PB_Any, TextureID(piltex))
MaterialCullingMode(\mat, #PB_Material_NoCulling)
\mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
\id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 0, 0)
RotateEntity(\id, 90, 0, 0)
EndWith
EndProcedure
Procedure.i CreateClouds()
cl\tex = LoadTexture(#PB_Any, "terrain.png")
cl\mes = CreatePlane(#PB_Any, 300, 300, 10, 10, 1, 1)
cl\mat = CreateMaterial(#PB_Any, TextureID(cl\tex))
MaterialBlendingMode(cl\mat, #PB_Material_Color)
AddMaterialLayer(cl\mat, TextureID(cl\tex), #PB_Material_Add)
ScaleMaterial(cl\mat, 2, 2, 0) : ScaleMaterial(cl\mat, 2, 2, 1)
ScrollMaterial(cl\mat, 0.01, 0.01, #PB_Material_Animated,0)
ScrollMaterial(cl\mat, -0.01, 0.01, #PB_Material_Animated,1)
MaterialCullingMode(cl\mat, #PB_Material_AntiClockWiseCull)
cl\id = CreateEntity(#PB_Any, MeshID(cl\mes), MaterialID(cl\mat), 0, 100, 0)
ScaleEntity(cl\id, 20, 10, 20)
EndProcedure
Procedure.i CreateSky()
Protected im.i
im = CreateImage(#PB_Any, 10, 10)
StartDrawing(ImageOutput(im))
Box(0, 0, 10, 10, $D6755A)
StopDrawing()
SaveImage(im, "sky_FR.jpg", #PB_ImagePlugin_JPEG, 10)
SaveImage(im, "sky_BK.jpg", #PB_ImagePlugin_JPEG, 10)
SaveImage(im, "sky_LF.jpg", #PB_ImagePlugin_JPEG, 10)
SaveImage(im, "sky_RT.jpg", #PB_ImagePlugin_JPEG, 10)
SaveImage(im, "sky_UP.jpg", #PB_ImagePlugin_JPEG, 10)
SaveImage(im, "sky_DN.jpg", #PB_ImagePlugin_JPEG, 10)
SkyBox("sky.jpg")
EndProcedure
Procedure.f FastDist(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)
x3.f = x1-x2 : x3 = x3*x3
y3.f = y1-y2 : y3 = y3*y3
z3.f = z1-z2 : z3 = z3*z3
dist.f = x3 + y3 + z3
ProcedureReturn dist
EndProcedure