my 3d game

freeBASIC source code examples by FbCadcam staff and interns

Moderators: yajra1219, Jayem, kitty_webb, Ywsp, joanCruz03, shela

Post Reply
owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

my 3d game

Post by owen » Tue Jan 14, 2020 6:24 am

trying to learn how to do 3d
move the mouse
use the arrow keys
and other keys a,z,r,f,y,h,u,j,i,k,

Code: Select all


Type pt3d
	x As Integer
	y As Integer
	z As Integer
End Type

Type proj2d
	x As Integer
	y As Integer
End Type
Type camera
	x     As Double
	y     As Double
	z     As Double
	xyrot As Double
	xzrot As Double
	yzrot As Double
	zoom  As Single
	cp(8) As pt3d
End Type
Type screen_mouse
	x As Integer
	y As Integer
	b as integer
	w as integer
End Type
Type camera_mouse
	x As Integer
	y As Integer
	z As Integer
End Type
type cube3d
	center as pt3d
	as integer w,h,d
End Type


Declare Function dbtp(x1 As Double,y1 As Double,z1 As Double,x2 As Double,y2 As Double,z2 As Double) As Double
Declare Sub drawstring(x As Integer, y As Integer, s As String, c As Integer)
Declare Sub calc3dto2dprojection(camera_index As Integer,point3d As pt3d)
Declare Sub drawspinningcube()
Declare Sub drawcameras()
Declare Sub drawfloor()
Declare Sub drawcity()
Declare Sub rotatepoint(px As Double,py As Double,pz As Double,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
Declare Sub rotatepoints(point_index As Integer,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
Declare Sub getinput()
Declare Sub showvalues()
Declare Sub set_camera_points(i As Integer)
Declare Sub generate_rand_city()
Declare sub draw_rand_stars()
Declare sub generate_rand_stars()
Dim Shared As Boolean camposchange
Dim Shared cam(3) As camera
Dim Shared s_mouse As screen_mouse
Dim Shared c_mouse As camera_mouse

Dim Shared As Integer cam_number
Dim Shared As Integer number_of_points,number_of_buildings
Dim Shared p() As pt3d
Dim Shared tpr(8) As pt3d'temp point rotation
Dim Shared simple_camera(8) As pt3d
Dim Shared pp As proj2d
Dim Shared As Double tpx,tpy,tpz


Const pi As Double = 3.1415926535897932
dim shared in_camera_view as boolean
Dim Shared r As Double
Dim As Integer sleeptime
sleeptime=15
Dim Shared As Single zoom_step
Dim Shared As Single rotation_step
dim shared as integer cuberot
zoom_step=.01
rotation_step=.5
Dim As Integer last_rotation

Dim As Integer i,j,k


number_of_buildings=100
generate_rand_city
dim shared as integer number_of_stars,starsistart,starsiend
number_of_stars=1000
generate_rand_stars

For i = 1 To 8
	Read p(i).x,p(i).y,p(i).z
Next
For i = 1 To 8
	Read simple_camera(i).x,simple_camera(i).y,simple_camera(i).z
Next
ScreenRes 700,700,8,3

'initial camera position, orientation, and zoom
'front view
cam(1).x=0
cam(1).y=100
cam(1).z=1000
cam(1).xyrot=0
cam(1).xzrot=0
cam(1).yzrot=0
cam(1).zoom=1

'right side view
cam(2).x=256
cam(2).y=0
cam(2).z=0
cam(2).xyrot=0
cam(2).xzrot=90
cam(2).yzrot=0
cam(2).zoom=1
'top view
cam(3).x=0
cam(3).y=256
cam(3).z=0
cam(3).xyrot=0
cam(3).xzrot=0
cam(3).yzrot=90
cam(3).zoom=1

For i = 1 To 3
	set_camera_points(i)
Next
cam_number=1

View (0,0)-(699,699)'drawing area
Window (-350,-350)-(349,349)

ScreenSet 0,0
Do
	'View:Window
	screenlock
	ScreenCopy 0,1
	ScreenSet 1,1
	'View (0,0)-(699,699)'drawing area
	'Window (-350,-350)-(249,249)
	drawfloor
	drawcameras
	drawcity
	draw_rand_stars
	drawspinningcube
	screenunlock
	getinput
	sleep 10
Loop

Sub drawspinningcube()
	dim as pt3d tcube(8)
	dim as boolean pointinview(8)
	Dim As Integer i,j,k,clr
	Dim As Double x1,y1,x2,y2
	'temporarily stor the cube's 8 points and rotate the originals
	cuberot+=1
	if cuberot=360 then cuberot=0
	for i = 1 to 8
		tcube(i)=p(i)
		rotatepoints(i,1,cuberot,0,0,0)'i is the indes of the 3d points array p(i)
		rotatepoints(i,2,cuberot,0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
		rotatepoints(i,3,cuberot,0,0,0)'0,0,0 xyz rotation point
		calc3dto2dprojection(cam_number,p(i))
		p(i).x=pp.x
		p(i).y=pp.y
		pointinview(i)=in_camera_view
	next
	if pointinview(1) and pointinview(2) then line(p(1).x,p(1).y)-(p(2).x,p(2).y),15
	if pointinview(1) and pointinview(4) then line(p(1).x,p(1).y)-(p(4).x,p(4).y),14
	if pointinview(1) and pointinview(5) then line(p(1).x,p(1).y)-(p(5).x,p(5).y),13
	if pointinview(2) and pointinview(3) then line(p(2).x,p(2).y)-(p(3).x,p(3).y),12
	if pointinview(2) and pointinview(6) then line(p(2).x,p(2).y)-(p(6).x,p(6).y),11
	if pointinview(3) and pointinview(4) then line(p(3).x,p(3).y)-(p(4).x,p(4).y),10
	if pointinview(3) and pointinview(7) then line(p(3).x,p(3).y)-(p(7).x,p(7).y),9
	if pointinview(4) and pointinview(8) then line(p(4).x,p(4).y)-(p(8).x,p(8).y),8
	if pointinview(5) and pointinview(6) then line(p(5).x,p(5).y)-(p(6).x,p(6).y),7
	if pointinview(5) and pointinview(8) then line(p(5).x,p(5).y)-(p(8).x,p(8).y),6
	if pointinview(6) and pointinview(7) then line(p(6).x,p(6).y)-(p(7).x,p(7).y),5
	if pointinview(7) and pointinview(8) then line(p(7).x,p(7).y)-(p(8).x,p(8).y),4

	for i = 1 to 8
		p(i)=tcube(i)
	Next
	
End Sub
Sub drawcameras()
	Dim As Integer i,j,k,clr
	Dim As Double x1,y1,x2,y2
	'simple camera depictions
	For i=1 To 3
		If i <> cam_number Then
			For j = 1 To 4
				calc3dto2dprojection(cam_number,cam(i).cp(j))
				if in_camera_view=true then
					x1=pp.x
					y1=pp.y
					calc3dto2dprojection(cam_number,cam(i).cp(j+4))
					if in_camera_view=true then
						x2=pp.x
						y2=pp.y
						Line(x1,y1)-(x2,y2),13
						For k = 1 To 4
							If k<> j Then
								calc3dto2dprojection(cam_number,cam(i).cp(k))
								x2=pp.x
								y2=pp.y
								if in_camera_view=true then Line(x1,y1)-(x2,y2),14
							End If
						Next
					endif
				endif
			Next
			
			For j = 6 To 8 Step 2
				calc3dto2dprojection(cam_number,cam(i).cp(j))
				if in_camera_view=true then
					x1=pp.x
					y1=pp.y
					If j=8 Then
						calc3dto2dprojection(cam_number,cam(i).cp(5))
					Else
						calc3dto2dprojection(cam_number,cam(i).cp(j+1))
					EndIf
					x2=pp.x
					y2=pp.y
					if in_camera_view=true then Line(x1,y1)-(x2,y2),12
				endif
			Next
		End If
	Next
End Sub
sub drawfloor()
	'exit sub
	Dim As pt3d pt(3)
	dim as boolean pointinview(3)
	Dim As Integer x,y,z,i,j,k
	for x= -5000 to 5000 step 500
		for z = -5000 to 5000 step 500
			pt(1).x=x
			pt(1).y=0
			pt(1).z=z
			pt(2).x=x+500
			pt(2).y=0
			pt(2).z=z
			pt(3).x=x
			pt(3).y=0
			pt(3).z=z+500
			for i as integer = 1 to 3
				calc3dto2dprojection(cam_number,pt(i))
				pointinview(i)=in_camera_view
				pt(i).x=pp.x
				pt(i).y=pp.y
			Next
			if pointinview(1) and pointinview(2) then Line(pt(1).x,pt(1).y)-(pt(2).x,pt(2).y)',int(rnd*15)+1
			if pointinview(1) and pointinview(3) then Line(pt(1).x,pt(1).y)-(pt(3).x,pt(3).y)',int(rnd*15)+1
		Next
	Next
End Sub
Sub drawcity()
	'exit sub
	Dim As Double pt(8,2)
	Dim As Integer i,j,k,c,bldg_color
	Dim As Double x1,y1,x2,y2
	For i = 1 To number_of_buildings
		bldg_color+=1
		if bldg_color=16 then bldg_color = 1
		c=0
		For j = i*8+1 To i*8+8
			c=c+1
			calc3dto2dprojection(cam_number,p(j))
			if in_camera_view=false then exit for
			pt(c,1)=pp.x
			pt(c,2)=pp.y
		Next
		if in_camera_view=true then
			Line(pt(1,1),pt(1,2))-(pt(2,1),pt(2,2)),bldg_color
			Line(pt(2,1),pt(2,2))-(pt(3,1),pt(3,2)),bldg_color
			Line(pt(3,1),pt(3,2))-(pt(4,1),pt(4,2)),bldg_color
			Line(pt(4,1),pt(4,2))-(pt(1,1),pt(1,2)),bldg_color
			
			Line(pt(5,1),pt(5,2))-(pt(6,1),pt(6,2)),bldg_color
			Line(pt(6,1),pt(6,2))-(pt(7,1),pt(7,2)),bldg_color
			Line(pt(7,1),pt(7,2))-(pt(8,1),pt(8,2)),bldg_color
			Line(pt(8,1),pt(8,2))-(pt(5,1),pt(5,2)),bldg_color
			
			Line(pt(1,1),pt(1,2))-(pt(5,1),pt(5,2)),bldg_color
			Line(pt(2,1),pt(2,2))-(pt(6,1),pt(6,2)),bldg_color
			Line(pt(3,1),pt(3,2))-(pt(7,1),pt(7,2)),bldg_color
			Line(pt(4,1),pt(4,2))-(pt(8,1),pt(8,2)),bldg_color
		endif
	Next
	
End Sub
'distance between two 3d points
Function dbtp(x1 As Double,y1 As Double,z1 As Double,x2 As Double,y2 As Double,z2 As Double) As Double
	dbtp = Sqr((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2)
End Function

Sub drawstring(x As Integer, y As Integer, s As String, c As Integer)
	Color c
	Draw String (x,y),s
End Sub

Sub calc3dto2dprojection(camera_index As Integer,point3d As pt3d)
	Dim As Integer i,j,k,cami',pointi
	cami=camera_index
	'pointi=point_index
	Dim As Double dist'for brevity purposes
	Dim As Double ratio'
	Dim As Double temppx,temppy,temppz
	Dim As Double tempcx,tempcy,tempcz

	'temppx=p(pointi).x
	'temppy=p(pointi).y
	'temppz=p(pointi).z
	
	temppx=point3d.x
	temppy=point3d.y
	temppz=point3d.z
	
	tempcx=cam(cami).x
	tempcy=cam(cami).y
	tempcz=cam(cami).z
	'first step is to rotate the point around 0,0,0
	rotatepoint(temppx,temppy,temppz,1,-cam(cami).xyrot,0,0,0)
	temppx=tpx
	temppy=tpy
	rotatepoint(temppx,temppy,temppz,2,-cam(cami).xzrot,0,0,0)
	temppx=tpx
	temppz=tpz
	rotatepoint(temppx,temppy,temppz,3,-cam(cami).yzrot,0,0,0)
	temppy=tpy
	temppz=tpz
	'second step is to rotate the camera around 0,0,0
	rotatepoint(tempcx,tempcy,tempcz,1,-cam(cami).xyrot,0,0,0)
	tempcx=tpx
	tempcy=tpy
	rotatepoint(tempcx,tempcy,tempcz,2,-cam(cami).xzrot,0,0,0)
	tempcx=tpx
	tempcz=tpz
	rotatepoint(tempcx,tempcy,tempcz,3,-cam(cami).yzrot,0,0,0)
	tempcy=tpy
	tempcz=tpz
	'third step would be to move the point
	temppx=tempcx-temppx
	temppy=tempcy-temppy
	'temppz=tempcz-temppz
	'
	'forth step is to project it onto a 2d plane
	dist=temppz-tempcz
	'dist=tempcz-temppz
	if dist<0 then
		in_camera_view=true
	else
		in_camera_view=false
	endif
	'in_camera_view=true
		'if dist<1 then dist=1
		if dist=0 then dist=.000001
		ratio=700*cam(cami).zoom/dist
		pp.x=temppx*ratio
		pp.y=temppy*ratio
		r=ratio
	'endif
End Sub

Sub rotatepoints(point_index As Integer,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
	Dim As Integer pointi
	Dim As Double dx,dy,dz
	pointi=point_index
	dx=p(pointi).x-rox
	dy=p(pointi).y-roy
	dz=p(pointi).z-roz
	
	'3 planes of rotation 1=xy, 2=xz, 3=yz
	Select Case plane
		Case 1'xy plane
			p(pointi).x=dx*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+rox
			p(pointi).y=dy*Cos(angle*pi/180) + dx*Sin(angle*pi/180)+roy
		Case 2'xz plane
			p(pointi).x=dx*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+rox
			p(pointi).z=dz*Cos(angle*pi/180) - dx*Sin(angle*pi/180)+roz
		Case 3'yz plane
			p(pointi).z=dz*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+roz
			p(pointi).y=dy*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+roy
	End Select
End Sub


Sub rotatepoint(px As Double,py As Double,pz As Double,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
	Dim As Double dx,dy,dz
	dx=px-rox
	dy=py-roy
	dz=pz-roz
	
	'3 planes of rotation 1=xy, 2=xz, 3=yz
	Select Case plane
		Case 1'xy plane
			tpx=dx*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+rox
			tpy=dy*Cos(angle*pi/180) + dx*Sin(angle*pi/180)+roy
		Case 2'xz plane
			tpx=dx*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+rox
			tpz=dz*Cos(angle*pi/180) - dx*Sin(angle*pi/180)+roz
		Case 3'yz plane
			tpz=dz*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+roz
			tpy=dy*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+roy
	End Select
End Sub

Sub getinput()
	Dim h As String
	camposchange=FALSE
	GetMouse s_mouse.x,s_mouse.y,s_mouse.w,s_mouse.b

	h=InKey
	Select Case s_mouse.y
		Case 0 to 340
			cam(cam_number).yzrot=cam(cam_number).yzrot-rotation_step*((341-s_mouse.y)/340)
			camposchange=TRUE
		case 360 to 700
			cam(cam_number).yzrot=cam(cam_number).yzrot+rotation_step*((s_mouse.y-359)/340)
			camposchange=TRUE
	End Select
	Select Case s_mouse.x
		Case 0 to 340
			cam(cam_number).xzrot=cam(cam_number).xzrot+rotation_step*((341-s_mouse.x)/340)
			camposchange=TRUE
		case 360 to 700
			cam(cam_number).xzrot=cam(cam_number).xzrot-rotation_step*((s_mouse.x-359)/340)
			camposchange=TRUE
	End Select

	Select Case h
		Case "1"
			cam_number=1
			camposchange=TRUE
		Case "2"
			cam_number=2
			camposchange=TRUE
		Case "3"
			cam_number=3
			camposchange=TRUE
		Case Chr(255)+"H"'up
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera up
			cam(cam_number).y=cam(cam_number).y+10
			camposchange=TRUE
		Case Chr(255)+"P"'dn
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera down
			cam(cam_number).y=cam(cam_number).y-10
			camposchange=TRUE
		Case Chr(255)+"K"'lt
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera left
			cam(cam_number).x=cam(cam_number).x-10
			camposchange=TRUE
		Case Chr(255)+"M"'rt
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera right
			cam(cam_number).x=cam(cam_number).x+10
			camposchange=TRUE
		Case "a"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera forward
			cam(cam_number).z=cam(cam_number).z+10
			camposchange=TRUE
		Case "z"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively moving the camera backwards
			cam(cam_number).z=cam(cam_number).z-10
			camposchange=TRUE
		Case "y"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively rolling the camera clock wise
			cam(cam_number).xyrot=cam(cam_number).xyrot+rotation_step
			camposchange=TRUE
		Case "h"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively rolling the camera counter clock wise
			cam(cam_number).xyrot=cam(cam_number).xyrot-rotation_step
			camposchange=TRUE
		Case "u"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively yawing the camera's nose to the left
			cam(cam_number).xzrot=cam(cam_number).xzrot+rotation_step
			camposchange=TRUE
		Case "j"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively yawing the camera's nose to the right
			cam(cam_number).xzrot=cam(cam_number).xzrot-rotation_step
			camposchange=TRUE
		Case "i"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively pitching the camera's nose up
			cam(cam_number).yzrot=cam(cam_number).yzrot+rotation_step
			camposchange=TRUE
		Case "k"
			'according to camera's current rotation on the 3 axes
			'adjust cam.x,y,z effectively pitching the camera's nose down
			cam(cam_number).yzrot=cam(cam_number).yzrot-rotation_step
			camposchange=TRUE
		Case "r"
			'camera zooms in
			cam(cam_number).zoom=cam(cam_number).zoom+zoom_step
			camposchange=TRUE
		Case "f"
			'camera zooms out
			cam(cam_number).zoom=cam(cam_number).zoom-zoom_step
			camposchange=TRUE
		Case Chr(27), Chr(255) + "k"
			End
	End Select
	If camposchange=TRUE Then
		set_camera_points(cam_number)
	EndIf
	sleep 1
End Sub

Sub showvalues()
	Locate 1+14,18
	Print cam_number;"                "
	Locate 2+14,18
	Print cam(cam_number).x;"                "
	Locate 3+14,18
	Print cam(cam_number).y;"                "
	Locate 4+14,18
	Print cam(cam_number).z;"                "
	Locate 5+14,18
	Print cam(cam_number).xyrot;"                "
	Locate 6+14,18
	Print cam(cam_number).xzrot;"                "
	Locate 7+14,18
	Print cam(cam_number).yzrot;"                "
	Locate 8+14,18
	Print s_mouse.x;"                "
	Locate 9+14,18
	Print s_mouse.y;"                "
	Locate 10+14,18
	Print c_mouse.x;"                "
	Locate 11+14,18
	Print c_mouse.y;"                "
	Locate 12+14,18
	Print c_mouse.z;"                "
	Locate 13+14,18
	Print cam(cam_number).zoom;"                "
End Sub


Sub set_camera_points(i As Integer)
	Dim j As Integer
	For j=1 To 8
		cam(i).cp(j)=simple_camera(j)
		cam(i).cp(j).x=cam(i).cp(j).x+cam(i).x
		cam(i).cp(j).y=cam(i).cp(j).y+cam(i).y
		cam(i).cp(j).z=cam(i).cp(j).z+cam(i).z
		rotatepoint(cam(i).cp(j).x,cam(i).cp(j).y,cam(i).cp(j).z,1,cam(i).xyrot,cam(i).x,cam(i).y,cam(i).z)
		cam(i).cp(j).x=tpx
		cam(i).cp(j).y=tpy
		rotatepoint(cam(i).cp(j).x,cam(i).cp(j).y,cam(i).cp(j).z,2,cam(i).xzrot,cam(i).x,cam(i).y,cam(i).z)
		cam(i).cp(j).x=tpx
		cam(i).cp(j).z=tpz
		rotatepoint(cam(i).cp(j).x,cam(i).cp(j).y,cam(i).cp(j).z,3,cam(i).yzrot,cam(i).x,cam(i).y,cam(i).z)
		cam(i).cp(j).y=tpy
		cam(i).cp(j).z=tpz
	Next
End Sub

sub generate_rand_stars()
	dim as integer x,y,z
	starsistart=number_of_points+1
	number_of_points+=number_of_stars
	starsiend=number_of_points
	ReDim Preserve p(number_of_points) As pt3d
	for i as integer=starsistart to starsiend
		x=int(rnd*1000000)
		y=int(rnd*1000000)
		z=int(rnd*1000000)
		if x mod 2 = 0 then x*=-1
		if z mod 2 = 0 then z*=-1
		p(i).x=x
		p(i).y=y
		p(i).z=z
	Next
End Sub
sub draw_rand_stars()
	for i as integer=starsistart to starsiend
		calc3dto2dprojection(cam_number,p(i))
		if in_camera_view then pset(pp.x,pp.y)
	Next
End Sub
Sub generate_rand_city()
	'each building has 8 points
	'in order to show a city perspective
	'let's put all the buildings on the ground (y=0)
	'and make them various in size
	Dim As Integer i,j,k,bldgx,bldgy,bldgz,bwidth,bheight,bdepth
	dim as boolean unique
	dim as cube3d bldg(number_of_buildings)
	for i = 1 to number_of_buildings
		bldgx=Int(Rnd * 2000) + 200
		If Int(Rnd*2)=1 Then bldgx=bldgx*-1
		bldgz=Int(Rnd * 2000) + 200
		If Int(Rnd*2)=1 Then bldgz=bldgz*-1
		bwidth=Int(Rnd*50)+20
		bheight=Int(Rnd*300)+100
		bdepth=Int(Rnd*50)+20
		unique=true
		for j = 1 to i-1
			select case bldgx-bwidth/2
				case bldg(j).center.x - bldg(j).w/2 to bldg(j).center.x + bldg(j).w/2
					select case bldgz+bdepth/2
						case bldg(j).center.z - bldg(j).d/2 to bldg(j).center.z + bldg(j).d/2
							unique=false
							exit for
					end select
					select case bldgz-bdepth/2
						case bldg(j).center.z - bldg(j).d/2 to bldg(j).center.z + bldg(j).d/2
							unique=false
							exit for
					end select
			End Select
			select case bldgx+bwidth/2
				case bldg(j).center.x - bldg(j).w/2 to bldg(j).center.x + bldg(j).w/2
					select case bldgz+bdepth/2
						case bldg(j).center.z - bldg(j).d/2 to bldg(j).center.z + bldg(j).d/2
							unique=false
							exit for
					end select
					select case bldgz-bdepth/2
						case bldg(j).center.z - bldg(j).d/2 to bldg(j).center.z + bldg(j).d/2
							unique=false
							exit for
					end select
			End Select
		Next
		if unique = true then
			bldg(i).center.x=bldgx
			bldg(i).center.y=int(bheight/2)
			bldg(i).center.z=bldgz
			bldg(i).w=bwidth
			bldg(i).h=bldg(i).center.y*2
			bldg(i).d=bdepth
		else
			i=-1
		EndIf
	Next
	number_of_points=(number_of_buildings+1)*8
	ReDim Preserve p(number_of_points) As pt3d
	For i = 1 To number_of_buildings
		'front face
		p(i*8+1).y=bldg(i).h
		p(i*8+1).x=bldg(i).center.x-bldg(i).w/2
		p(i*8+1).z=bldg(i).center.z+bldg(i).d/2
		p(i*8+2).y=0
		p(i*8+2).x=bldg(i).center.x-bldg(i).w/2
		p(i*8+2).z=bldg(i).center.z+bldg(i).d/2
		p(i*8+3).y=0
		p(i*8+3).x=bldg(i).center.x+bldg(i).w/2
		p(i*8+3).z=bldg(i).center.z+bldg(i).d/2
		p(i*8+4).y=bldg(i).h
		p(i*8+4).x=bldg(i).center.x+bldg(i).w/2
		p(i*8+4).z=bldg(i).center.z+bldg(i).d/2
		'back face
		p(i*8+5).y=bldg(i).h
		p(i*8+5).x=bldg(i).center.x-bldg(i).w/2
		p(i*8+5).z=bldg(i).center.z-bldg(i).d/2
		p(i*8+6).y=0
		p(i*8+6).x=bldg(i).center.x-bldg(i).w/2
		p(i*8+6).z=bldg(i).center.z-bldg(i).d/2
		p(i*8+7).y=0
		p(i*8+7).x=bldg(i).center.x+bldg(i).w/2
		p(i*8+7).z=bldg(i).center.z-bldg(i).d/2
		p(i*8+8).y=bldg(i).h
		p(i*8+8).x=bldg(i).center.x+bldg(i).w/2
		p(i*8+8).z=bldg(i).center.z-bldg(i).d/2
	Next
End Sub
'spinning cube
Data -25, 25, 25
Data -25,-25, 25
Data  25,-25, 25
Data  25, 25, 25

Data -25, 25,-25
Data -25,-25,-25
Data  25,-25,-25
Data  25, 25,-25

'make shift camera
Data -5, 5, 0
Data -5,-5, 0
Data  5,-5, 0
Data  5, 5, 0

Data -20, 20,-10
Data -20,-20,-10
Data  20,-20,-10
Data  20, 20,-10


Post Reply