My computer doesn't work so I couldn't check if this works but here it goes:
Rem Project: XOF Sliding Collision
Rem Author: Andrew Neale
RemStart
I wrote this code without DarkBASIC so I don't know if it will work.
If it does or you fix it so that it does then fell free to use it but please
mention me in the credits.
It was made for DBPro but it might work in DBC
RemEnd
Rem Setup Display
Set Display Mode 800,600,32
Set Window Off
Hide Mouse
Rem Setup Variables
Type Objects
LevelObject As Integer
PlayerObject As Integer
CollisionObject As Integer
EndType
Global Objects As Objects
Objects.LevelObject=1
Objects.PlayerObject=2
Objects.CollisionObject=3
Type 3DPositions
X As Float
Y As Float
Z As Float
OldX As Float
OldY As Float
OldZ As Float
Ang As Float
Height As Float
EndType
Global Player As 3DPositions
Player.X=0.0
Player.Y=25.0
Player.Z=200.0
Player.OldX=0.0
Player.OldY=25.0
Player.OldZ=0.0
Player.Ang=0.0
Player.Height=50.0
Rem The Smaller This Number The More Accurate But The Slower It Will Run
Global Accuracy As Float
Accuracy=2.0
Rem Load In A .X Level
Load Object "castle/castle.x",Objects.LevelObject
Set Object Collision On Objects.LevelObject
Set Object Collision To Polygons Objects.LevelObject
Rem Make A Player Object
Make Object Box Objects.PlayerObject,50,50,50
Set Object Collision Off Objects.PlayerObject
Rem Make An Object To Use For Collision
Make Object Box Objects.CollisionObject,50,50,50
Set Object Collision On Objects.CollisionObject
Set Object Collision To Polygons Objects.CollisionObject
Hide Object Objects.CollisionObject
Rem Setup Lighting
Set Ambient Light 50
Rem Setup Manual Synchronisation
Sync On
Sync Rate 0
Rem Start Main Loop
Do
Set Cursor 0,0
print screen fps()
Rem Call On Collision Sub Routine
GoSub ControlPlayer
Rem Update Screen
Sync
Rem End The Main Loop
Loop
Rem Sub Routine That Controls The Player Object
ControlPlayer:
Rem Store Old Positions
Player.OldX=Player.X
Player.OldY=Player.Y
Player.OldZ=Player.Z
Rem Control Input
If UpKey()=1
Player.X=NewXvalue(Player.X,Player.Ang,2)
Player.Z=NewZvalue(Player.Z,Player.Ang,2)
Endif
If DownKey()=1
Player.X=NewXvalue(Player.X,Player.Ang,-2)
Player.Z=NewZvalue(Player.Z,Player.Ang,-2)
Endif
If RightKey()=1
Player.Ang=WrapValue(Player.Ang+2)
Endif
If LeftKey()=1
Player.Ang=WrapValue(Player.Ang-2)
Endif
Rem Check For Height
Position Object Objects.CollisionObject,Player.X,Player.Y+Player.Height+1.0,Player.Z
If Object Collision(Objects.LevelObject,Objects.CollisionObject)>0
Player.X=Player.OldX
Player.Z=Player.OldZ
Goto SkipHeightCheck
Endif
Do
If Object Collision(Objects.LevelObject,Objects.CollisionObject)>0 Or Object Position Y(Objects.CollisionObject)<Player.Y Then Exit
Position Object Objects.CollisionObject,Player.X,Object Position Y(Objects.CollisionObject)-Accuracy,Player.Z
Loop
If Object Position Y(Objects.CollisionObject)>Player.Y
Player.Y=Object Position Y(Objects.CollisionObject)
Else
TempY=Player.Y
Player.Y=TempY-1.0
Endif
SkipHeightCheck:
Rem Update Player
Position Object Objects.PlayerObject,Player.X,Player.Y+PlayerHeight,Player.Z
YRotate Object Objects.PlayerObject,Player.Ang
Rem Control Camera
Set Camera To Follow Player.X,Player.Y,Player.Z,Player.Ang,50,Player.Y+50,3.5,0
Point Camera Player.X,Player.Y,Player.Z
Rem Go Back To The Main Loop
Return
I made it for pro but it might work in classic.
[Edit]O.K it works now but it is pretty slow. Any ideas how to speed it up?[/Edit]
