3D scene with First person view by Zerodog (ZD for the buddies ) ^^

[pistol350]

If you don't know this one alreday, just give it a try
ZD is the Best!!!

Code Select Expand

DEF win:WINDOW
DEF run,x,y,z,n,blankcs,joyON:INT
DEF wrap[13],Pos[3],backupPos[3],BackupOrient[6]:FLOAT
DEF scene,camera,light,light2,StairsParent,FloorsParent,Room1Parent,Room2Parent:INT
DEF Floors[100],Room1Walls[100],Room2Walls[100],Stairs1[100],Stairs2[100]:INT
DEF facearray[100]:INT

type joyinfo
   def Xpos:int
   def Ypos:int
   def Zpos:int
   def Buttons:int
endtype
declare "winmm",joyGetPos(id:int,n:joyinfo),int
def joy:joyinfo

IF (MessageBox(0,"Do you want to use a joystick?","Enable joystick?",36)=6)
joyON=1
ELSE
joyON=0
ENDIF


GOSUB SetupWindow
GOSUB LoadScene

run=1
waituntil run=0
GOSUB DeleteScene
closewindow win
end

'===================================================================

SUB winproc
SELECT @CLASS
CASE @IDCHAR
if (@CODE = ASC("Q")) | (@CODE = ASC("q")) THEN run = 0
CASE @IDDXUPDATE
D3DCOMMAND camera,@GETOrientation,scene,BackupOrient
D3DCOMMAND camera,@GETPOSITION,scene,BackupPos
if(GETKEYSTATE(0x1b)) then run=0
if(GETKEYSTATE(0x57)) then D3DSETQUALITY win,@LIGHTON | @FILLWireFrame | @SHADEFLAT : ' WireFrame fill
if(GETKEYSTATE(0x53)) then D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEGOURAUD : ' SolidFill
IF(GETKEYSTATE(0x26)) then D3DCOMMAND camera,@ADDTRANSLATION,0,0,.45
IF(GETKEYSTATE(0x28)) then D3DCOMMAND camera,@ADDTRANSLATION,0,0,-.45
IF(GETKEYSTATE(0x25)) then D3DCOMMAND camera,@ADDROTATION,0,1,0,(-3 * (3.1415/180))
IF(GETKEYSTATE(0x27)) then D3DCOMMAND camera,@ADDROTATION,0,1,0,(3 * (3.1415/180))
IF joyON=1
n=joyGetPos(0,joy) 
if (joy.Xpos<20000) then D3DCOMMAND camera,@ADDROTATION,0,1,0,(-2 * (3.1415/180))
if (joy.Xpos>40000) then D3DCOMMAND camera,@ADDROTATION,0,1,0,(2 * (3.1415/180))
if (joy.Ypos<20000) then D3DCOMMAND camera,@ADDTRANSLATION,0,0,.45
if (joy.Ypos>40000) then D3DCOMMAND camera,@ADDTRANSLATION,0,0,-.45
ENDIF
GOSUB Physics
D3DMOVE win,1
D3DRENDER scene, camera
DXFLIP win
CASE @IDCLOSEWINDOW
run=0
ENDSELECT
RETURN

'===================================================================

SUB SetupWindow
Window win,0,0,640,480,@CAPTION,0,"ThreeD",winproc
setwindowcolor win,0
IF CREATE3DSCREEN(win,640, 480,32) <> 0
MESSAGEBOX win, "Could not create Direct3D screen","Error"
closewindow win
end
ENDIF
blankcs = LOADIMAGE ("",@IMGCURSOR )
SETCURSOR win, @CSCUSTOM,blankcs
D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEFLAT
scene = D3DSCENE(win)
camera = D3DCAMERA(scene)
D3DCOMMAND camera,@SETPOSITION, scene, 32.5, 2, -5


RETURN

'===================================================================

SUB LoadScene
light = D3DLIGHT(scene,@LIGHTAMBIENT, .125,.25,.125)
light2 = D3DLight(camera,@LIGHTSPOT,.6,.6,.6)
D3DCOMMAND light2,@SETORIENTATION,scene, 0,0,1, 0,0,1
d3dcommand light2,@SETPOSITION,camera,0,1,-16
D3DCOMMAND light2, @SETLIGHTPENUMBRA, 2
D3DCOMMAND light2, @SETRANGE, 64
D3DCOMMAND light2, @SETLIGHTUMBRA, 1

SceneParent = D3DSHAPE(scene,@SHAPECUSTOM)
FloorsParent = D3DSHAPE(scene,@SHAPECUSTOM)
StairsParent = D3DSHAPE(scene,@SHAPECUSTOM)
Room1Parent = D3DSHAPE(scene,@SHAPECUSTOM)
Room2Parent = D3DSHAPE(scene,@SHAPECUSTOM)

' -----

Floors[0] = D3DSHAPE(scene,@SHAPECUBE, 15, 0.01, 10)
D3DCOMMAND Floors[0],@SETPOSITION,scene, 32.5, 0, 5

Floors[1] = D3DSHAPE(scene,@SHAPECUBE, 90, 0.01, 5)
D3DCOMMAND Floors[1],@SETPOSITION,scene, 35, 10, 62.5

Floors[2] = D3DSHAPE(scene,@SHAPECUBE, 6, 0.5, 21)
D3DCOMMAND Floors[2],@SETPOSITION,scene, 8, 9.75, 20.5

Floors[3] = D3DSHAPE(scene,@SHAPECUBE, 5, 0.5, 50)
D3DCOMMAND Floors[3],@SETPOSITION,scene, 2.5, 9.75, 35

Floors[4] = D3DSHAPE(scene,@SHAPECUBE, 6, 0.5, 21)
D3DCOMMAND Floors[4],@SETPOSITION,scene, 57, 9.75, 20.5

Floors[5] = D3DSHAPE(scene,@SHAPECUBE, 5, 0.5, 50)
D3DCOMMAND Floors[5],@SETPOSITION,scene, 62.5, 9.75, 35

Floors[10] = D3DSHAPE(scene,@SHAPECUBE, 65, 0.01, 55)
D3DCOMMAND Floors[10],@SETPOSITION,scene, 32.5, 0, 37.5

' ----- Walls Room 1

Room1Walls[0] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 10, 10)
D3DCOMMAND Room1Walls[0],@SETPOSITION,scene, 25, 5, 5

Room1Walls[1] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 10, 10)
D3DCOMMAND Room1Walls[1],@SETPOSITION, Scene, 40, 5, 5

Room1Walls[2] = D3DSHAPE(scene,@SHAPECUBE, 5, 10, 0.01)
D3DCOMMAND Room1Walls[2],@SETPOSITION, scene, 27.5, 5, 0

Room1Walls[3] = D3DSHAPE(scene,@SHAPECUBE, 5, 10, 0.01)
D3DCOMMAND Room1Walls[3],@SETPOSITION, scene, 37.5, 5, 0


' ----- Walls Room 2

Room2Walls[0] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 20, 50)
D3DCOMMAND Room2Walls[0],@SETPOSITION, scene, 0, 10, 35

Room2Walls[1] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 20, 50)
D3DCOMMAND Room2Walls[1],@SETPOSITION, scene, 65, 10, 35

Room2Walls[2] = D3DSHAPE(scene,@SHAPECUBE, 27.5, 20, 0.01)
D3DCOMMAND Room2Walls[2],@SETPOSITION, scene, 13.75, 10, 10
D3DCOMMAND Room2Walls[1],@SETPOSITION, scene, 65, 10, 35

Room2Walls[3] = D3DSHAPE(scene,@SHAPECUBE, 27.5, 20, 0.01)
D3DCOMMAND Room2Walls[3],@SETPOSITION, scene, 51.25, 10, 10
D3DCOMMAND Room2Walls[1],@SETPOSITION, scene, 65, 10, 35

Room2Walls[4] = D3DSHAPE(scene,@SHAPECUBE, 28, 10, 0.01)
D3DCOMMAND Room2Walls[4],@SETPOSITION, scene, 14, 5, 60

Room2WALLS[5] = D3DSHAPE(scene,@SHAPECUBE, 28, 10, 0.01)
D3DCOMMAND Room2Walls[5],@SETPOSITION, scene, 51, 5, 60

Room2Walls[6] = D3DSHAPE(scene,@SHAPECUBE, 90, 10, 0.01)
D3DCOMMAND Room2Walls[6],@SETPOSITION,scene, 35, 15, 65

Room2Walls[7] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 10, 30)
D3DCOMMAND Room2Walls[7],@SETPOSITION,scene, 5, 5, 45

Room2Walls[8] = D3DSHAPE(scene,@SHAPECUBE, 0.01, 10, 30)
D3DCOMMAND Room2Walls[8],@SETPOSITION,scene, 60, 5, 45

CLEAR facearray : DEF facearray[100]:INT
Room2Walls[9] = D3DSHAPE(scene,@SHAPECUSTOM)
D3DCOMMAND Room2Walls[9],@ADDVERTEX, 10.75, 9.75, 10
D3DCOMMAND Room2Walls[9],@ADDVERTEX, 10.75, 9.75, 31
D3DCOMMAND Room2Walls[9],@ADDVERTEX, 10.75, 3.75, 54.5
D3DCOMMAND Room2Walls[9],@ADDVERTEX, 10.75, 0, 54.5
D3DCOMMAND Room2Walls[9],@ADDVERTEX, 10.75, 0, 10
D3DCOMMAND Room2Walls[9],@ADDNORMAL, 1,0,0
facearray = 5,0,0,1,0,2,0,3,0,4,0,0
D3DCOMMAND Room2Walls[9],@ADDFACES,facearray
D3DCOMMAND Room2Walls[9],@CUSTOMINIT

CLEAR facearray : DEF facearray[100]:INT
Room2Walls[10] = D3DSHAPE(scene,@SHAPECUSTOM)
D3DCOMMAND Room2Walls[10],@ADDVERTEX, 54.25, 0, 10
D3DCOMMAND Room2Walls[10],@ADDVERTEX, 54.25, 0, 54.5
D3DCOMMAND Room2Walls[10],@ADDVERTEX, 54.25, 3.75, 54.5
D3DCOMMAND Room2Walls[10],@ADDVERTEX, 54.25, 9.75, 31
D3DCOMMAND Room2Walls[10],@ADDVERTEX, 54.25, 9.75, 10
D3DCOMMAND Room2Walls[10],@ADDNORMAL, -1,0,0
facearray = 5,0,0,1,0,2,0,3,0,4,0,0
D3DCOMMAND Room2Walls[10],@ADDFACES,facearray
D3DCOMMAND Room2Walls[10],@CUSTOMINIT

CLEAR facearray : DEF facearray[100]:INT
Room2Walls[11] = D3DSHAPE(scene,@SHAPECUSTOM)
D3DCOMMAND Room2Walls[11],@ADDVERTEX, 10.5, 3.75, 54.5
D3DCOMMAND Room2Walls[11],@ADDVERTEX, 25, 0, 54.5
D3DCOMMAND Room2Walls[11],@ADDVERTEX, 10.5, 0, 54.5
D3DCOMMAND Room2Walls[11],@ADDNORMAL, 0,0,-1
facearray = 3,0,0,1,0,2,0,0
D3DCOMMAND Room2Walls[11],@ADDFACES,facearray
D3DCOMMAND Room2Walls[11],@CUSTOMINIT

CLEAR facearray : DEF facearray[100]:INT
Room2Walls[12] = D3DSHAPE(scene,@SHAPECUSTOM)
D3DCOMMAND Room2Walls[12],@ADDVERTEX, 40, 0, 54.5
D3DCOMMAND Room2Walls[12],@ADDVERTEX, 55, 3.75, 54.5
D3DCOMMAND Room2Walls[12],@ADDVERTEX, 55, 0, 54.5
D3DCOMMAND Room2Walls[12],@ADDNORMAL, 0,0,-1
facearray = 3,0,0,1,0,2,0,0
D3DCOMMAND Room2Walls[12],@ADDFACES,facearray
D3DCOMMAND Room2Walls[12],@CUSTOMINIT


' ----- STAIRS

for x = 0 to 13
Stairs1[x] = D3DSHAPE(scene,@SHAPECUBE, 1,.5,6)
D3DCOMMAND Stairs1[x],@SETPOSITION, scene, 24.5-x, .25+(x/4), 57
next x
Stairs1[14] = D3DSHAPE(scene,@SHAPECUBE, 6, .5, 6)
D3DCOMMAND Stairs1[14],@SETPOSITION, scene, 8, .25+(14/4), 57
for x = 15 to 37
Stairs1[x] = D3DSHAPE(scene,@SHAPECUBE, 6, .5, 1)
D3DCOMMAND Stairs1[x],@SETPOSITION, scene, 8, .25+(x/4), 53.5-(x-15)
next x

' -----

for x = 0 to 13
Stairs2[x] = D3DSHAPE(scene,@SHAPECUBE, 1,.5,6)
D3DCOMMAND Stairs2[x],@SETPOSITION, scene, 40.5+x, .25+(x/4), 57
next x
Stairs2[14] = D3DSHAPE(scene,@SHAPECUBE, 6, .5, 6)
D3DCOMMAND Stairs2[14],@SETPOSITION, scene, 57, .25+(14/4), 57
for x = 15 to 37
Stairs2[x] = D3DSHAPE(scene,@SHAPECUBE, 6, .5, 1)
D3DCOMMAND Stairs2[x],@SETPOSITION, scene, 57, .25+(x/4), 53.5-(x-15)
next x

' -----

D3DCOMMAND Room1Parent,@ADDCHILD,Floors[0]
for x = 1 to 10
if (floors[x]) then D3DCOMMAND Room2Parent,@ADDCHILD,Floors[x]
next x

for x = 0 to 99
if (Stairs1[x])
D3DCOMMAND StairsParent,@ADDCHILD,Stairs1[x]
endif
if (Stairs2[x])
D3DCOMMAND StairsParent,@ADDCHILD,Stairs2[x]
ENDIF
if (Room1Walls[x])
D3DCOMMAND Room1Parent,@ADDCHILD,Room1Walls[x]
endif
if (Room2Walls[x])
D3DCOMMAND Room2Parent,@ADDCHILD,Room2Walls[x]
endif
next x
D3DCOMMAND Room2Parent,@ADDCHILD, StairsParent
RETURN

'===================================================================

SUB DeleteScene
for x = 0 to 99
if (Floors[x]) then D3DDELETE Floors[x]
if (Room1Walls[x]) then D3DDELETE Room1Walls[x]
if (Room2Walls[x]) then D3DDELETE Room2Walls[x]
if (Stairs1[x]) then D3DDELETE Stairs1[x]
if (Stairs2[x]) then D3DDELETE Stairs2[x]
next x
d3ddelete floorsparent
d3ddelete stairsparent
d3ddelete light
d3ddelete light2
d3ddelete camera
d3ddelete scene
RETURN

'===================================================================

SUB Physics
DEF ShapeID,ShapeID2:INT
DEF Box[6],pos2[3],orient[6]:FLOAT
D3DCOMMAND camera,@GETPOSITION,scene,pos
D3DCOMMAND camera,@GETORIENTATION, scene, orient

    '**** horizontal collision detection
'====room1
ShapeID= D3DCOMMAND(Room1Parent, @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
if (ShapeID)
for x = 0 to 5
if (Room1Walls[x])
D3DCOMMAND Room1Walls[x], @GETBOX, Box
D3DCOMMAND Room1Walls[x], @GETPOSITION,scene, pos2
if (pos[0] > Box[0]+pos2[0]-1.25) & (pos[0] < Box[3]+pos2[0]+1.25) & (pos[2] > Box[2]+pos2[2]-1.25) & (pos[2] < Box[5]+pos2[2]+1.25)
D3DCOMMAND camera,@SetPosition, scene, BackupPos[0],BackupPos[1],BackupPos[2]
endif
endif
next x
ShapeID= D3DCOMMAND(Floors[0], @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
IF (ShapeID) then GOTO ExitLoop
endif

'====room2
ShapeID= D3DCOMMAND(Room2Parent, @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
if (ShapeID)
for x = 0 to 20
if (Room2Walls[x])
D3DCOMMAND Room2Walls[x], @GETBOX, Box
D3DCOMMAND Room2Walls[x], @GETPOSITION,scene, pos2
if (pos[0] > Box[0]+pos2[0]-1.25) &  (pos[0] < Box[3]+pos2[0]+1.25)   &   (pos[2] > Box[2]+pos2[2]-1.25) & (pos[2] < Box[5]+pos2[2]+1.25)   &   (pos[1] > Box[1]+pos2[1]-1.25) & (pos[1] < Box[4]+pos2[1]+1.25)
D3DCOMMAND camera,@SetPosition, scene, BackupPos[0],BackupPos[1],BackupPos[2]
endif
endif
next x

ShapeID= D3DCOMMAND(StairsParent, @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
if (ShapeID)
for x = 0 to 38
ShapeID= D3DCOMMAND(Stairs1[x], @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
IF (ShapeID) then GOTO ExitLoop
ShapeID= D3DCOMMAND(Stairs2[x], @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
IF (ShapeID) then GOTO ExitLoop
next x
endif
for x = 1 to 20
if (Floors[x]) then ShapeID= D3DCOMMAND(Floors[x], @RAYPICK, 0, 0, -1, 0, pos[0], pos[1], pos[2])
IF (ShapeID) then GOTO ExitLoop
next x
endif
LABEL ExitLoop

    '**** vertical collision detection (gravity)
if (ShapeID)
D3DCOMMAND shapeID, @GETBOX, Box
D3DCOMMAND shapeID, @GETPOSITION,scene, pos2
if pos[1] > Box[4]+Pos2[1]+3 then D3DCOMMAND camera,@ADDTRANSLATION, 0,-.25,0
if pos[1] <= Box[4]+Pos2[1]+2.8 then D3DCOMMAND camera,@ADDTRANSLATION, 0,.15,0
endif
RETURN

'===================================================================