'*******************************************************************************************
' 	program demonstrating making a virtual terrain in Rapidq DIRECT 3D
'	lights are moved by mouse, scaling and rotation changed by clicking - all by
'	 QD3DFrame or MeshBuilder (QD3DMeshBuilder)
'JohnK
'******************************************************************************************
'
'

$TYPECHECK ON							'this will make you a better programmer in the end
$INCLUDE "\rapidq\include\RapidQ_D3D.INC"		'constants


DECLARE SUB DXInitialize(Sender AS QDXScreen)		'initalize Direct3D Retained mode interface
DECLARE SUB DXInitializeSurface(Sender AS QDXScreen)'initialize Direct Draw surface
DECLARE SUB DXTimerExpired
DECLARE SUB ToggleRotation (Button as integer, X as integer, Y as integer)
DECLARE SUB MakeRandomTerrMesh (TheMeshBuilder AS QD3DMeshBuilder)
DECLARE SUB LoadBitMap_For_Height (TheBitMap AS QBITMAP)
DECLARE SUB Cancel_Load
DECLARE SUB HeightMapMesh(HeightMap AS QBITMAP, TheMeshBuilder AS QD3DMeshBuilder)
DECLARE SUB Create_Height_Mesh
DECLARE SUB MakeSkyBox(HeightMap AS QBITMAP)
DECLARE SUB Reload_Height_Map
DECLARE SUB Load_Background
DECLARE SUB Load_Terrain_Texture
DECLARE SUB Load_Sky_Texture
DECLARE SUB Turn_On_Fog
DECLARE SUB CloseApp


DIM MeshFrame 		AS QD3DFrame			'possible for root frame all 3d objects should be attached to a frame
DIM LightFrame 		AS QD3DFrame			'lights must be placed on a frame. Camera is attached to a frame by RapidQ for you
DIM MeshBuilder 	AS QD3DMeshBuilder		'mesh builder to create a mesh out of the face
DIM wrap 			AS QD3DWRAP				'object to hold texture wrapping information
DIM FloorMesh		AS QD3DMeshBuilder		'build a square box around the scene
DIM SkyBox			AS QD3DMeshBuilder		'build a square box around the scene
DIM Terr_Texture	AS QD3DTexture			'info for holding texture
DIM Sky_Texture		AS QD3DTexture			'info for sky texture
DIM HeightBitMap	AS QBITMAP				'bitmap with pixel values the determine the height of our scene

DIM Face 			AS QD3DFACE

DIM Max_X			AS DOUBLE				'dimensions of scene mesh
DIM Min_X			AS DOUBLE
DIM Max_Z			AS DOUBLE
DIM Min_Z			AS DOUBLE
DIM yScale			AS DOUBLE				'scale for height

DIM RotAngl 		AS SINGLE : RotAngl = 0.05		'constant angle of rotation
DIM RotateIt 		AS INTEGER: RotateIt = 0 		'toggle on/off rotation
DIM Step_size		AS INTEGER: Step_size = 1		'step size through terrain map (increase if using large bitmaps)
DIM CancelTerrLoad	AS INTEGER: CancelTerrLoad = 0	'cancel loading the height map for terrain




CREATE Form AS QForm
	Caption = "Direct 3D Example - click or move mouse"
    Width = 640
    Height = 480
    Center
	CREATE MainMenu AS QMAINMENU
		CREATE FileMenu AS QMENUITEM					'***** FILE  MENUS ********
			Caption = "  &File"
		CREATE OpenMapMnu AS QMENUITEM
				Caption = "  Load Height Map":	OnClick = Reload_Height_Map
		END CREATE
		CREATE LoadTerrTexMnu AS QMENUITEM
				Caption = "  Load Terrain Texture Map": OnClick = Load_Terrain_Texture
		END CREATE
		CREATE LoadSkyTexMnu AS QMENUITEM
				Caption = "  Load Sky Texture Map": OnClick = Load_Sky_Texture
		END CREATE
		CREATE LoadBackgrdMnu AS QMENUITEM
				Caption = "  Load Background Image": OnClick = Load_Background
		END CREATE
		CREATE ExitMnu AS QMENUITEM
				Caption = "  Exit"
				OnClick = CloseApp
		END CREATE
		END CREATE
	END CREATE

    CREATE DXScreen AS QDXScreen				'really a direct draw surface?
        Init(640,480)
        Align = 5								'alClient - need this to center Direct Draw screen onto Form
        BitCount = 32							'16 bits/pixel use 32 for alpha bending on fast 3d cards
        Use3D = 1								'load Direct3D Retained mode
        UseHardware = 1							'3D accelerated video cards are cheap, get one!!
        OnInitialize = DXInitialize					'load your meshs/faces to the frames, set lights, camera
		OnInitializeSurface = DXInitializeSurface	'screen is ready to be drawn
		OnMouseDown = ToggleRotation				'mouse click stops/starts rotation
	END CREATE
END CREATE

DIM DXTimer AS QDXTimer					'regularly update display
    DXTimer.Enabled = 1
    DXTimer.Interval = 0
    DXTimer.Activeonly = 0
    DXTimer.OnTimer = DXTimerExpired


	Form.ShowModal						'get the program running

'***********************************************************************





SUB DXInitialize(Sender AS QDXScreen)
	DIM Ambient AS QD3DLight			'need at least one light this can be local sub-- we won't modify it
	DIM Light AS QD3DLight				'will define as point ligth that gives rich illumination to see the walls
	DIM Face AS QD3DFace				'can't modify so just declare it in sub that makes the face
	DIM Face2 AS QD3DFace				'can't modify so just declare it in sub that makes the face
	DIM x as double, y as double, z as double

	DXScreen.CreateFrame(MeshFrame)		'create the frames objects will be attached to
	DXScreen.CreateFrame(LightFrame)	'probably allocates memory, handles, etc
	DXScreen.CreateMeshBuilder(MeshBuilder)
	DXScreen.CreateMeshBuilder(SkyBox)
	DXScreen.CreateMeshBuilder(FloorMesh)


''		*********  First we create the lights  ******************
	DXScreen.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.2, 0.2, 0.5, Ambient)	'ambient is dim grey
	DXScreen.AddLight(Ambient)			'ambient light moves with root frame (and object since it is on root frame)

	DXScreen.CreateLightRGB(D3DRMLIGHT_POINT, 0.8, 0.8, 0.2, Light)		'point light is bright yellow, units depend on MeshBuilder.SetRGB(1, 1, 1)
	'Light.Parent = DXScreen
	DXScreen.AddLight(Light)			'use this to attach light to  root frame so light moves with objects
	LightFrame.AddLight(Light)			'attach light to frame to move the light!
	LightFrame.SetPosition(0, 2, -1)	'units are x,y,z


''		*********  next create a face of polygons  ******************
	Create_Height_Mesh
	'MakeRandomTerrMesh (MeshBuilder)								'generate a random mesh
	MeshBuilder.SetQuality(D3DRMRENDER_GOURAUD)				'highest rendering Quality is D3DRMRENDER_PHONG, but not much diff
	MeshFrame.AddVisual(MeshBuilder)						'add it to a frame to move, translate, etc.
	MeshFrame.AddVisual(SkyBox)								'add sky to frame
	MeshFrame.AddVisual(FloorMesh)							'add Floor to frame, all will rotate/move together now
	DXScreen.SetCameraPosition(0, 1, 12)	'distance in each axis from origin, move the camera around instead of 3d object
	DXScreen.CameraLookAt(MeshFrame, D3DRMCONSTRAIN_Z)		'constrain the angle that the camera looks at
END SUB


SUB DXInitializeSurface(Sender AS QDXScreen)
   DXScreen.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY OR D3DRMRENDERMODE_DISABLESORTEDALPHAZWRITE)' OR D3DRMRENDERMODE_VIEWDEPENDENTSPECULAR)
END SUB

SUB DXTimerExpired
	DIM yView AS DOUBLE
	DIM xView AS DOUBLE
 
	yView = 2 * Screen.MouseY / HeightBitMap.Height: IF yView < 1.0 THEN yView = 1.0
	xView = 10 - Screen.MouseX / HeightBitMap.Width
	DXScreen.SetCameraPosition(xView, yView, 2.5* yView)	'really a camera translation
	LightFrame.SetPosition(Screen.MouseX/20, Screen.MouseY/20,  Screen.MouseY/20)	'units are x,y,z
	DXScreen.ForceUpdate(0,0,50,40)     ' Update FPS text only
	DXScreen.Move(1)                    ' This does the rotation by 2 times
	DXScreen.Render
	DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), &HFFFFFF, -1)
	DXScreen.Flip
END SUB



SUB ToggleRotation (Button as integer, X as integer, Y as integer)
	IF Button = 0 THEN
		MeshBuilder.Scale(0.5, 0.5, 0.5)			'make it smaller by 2x
		SkyBox.Scale(0.5, 0.5, 0.5)
		FloorMesh.Scale(0.5, 0.5, 0.5)
	END IF
	IF Button = 1 THEN
		MeshBuilder.Scale(2, 2, 2)					'make it bigger by 2x
		SkyBox.Scale(2, 2, 2)
		FloorMesh.Scale(2, 2, 2)
	END IF
	IF RotateIt THEN 
		MeshFrame.SetRotation(0, 0, 0, 0)
		RotateIt= 0 
	ELSE
		MeshFrame.SetRotation(0, 1, 0, RotAngl)		' rotate about y-axis, Angle of rotation is variable
		LightFrame.SetPosition(-1, 2, 0)			'units are x,y,z
		RotateIt = 1
	END IF
END SUB



SUB LoadBitMap_For_Height (TheBitMap AS QBITMAP)
	DIM openDialog AS QOPENDIALOG


    openDialog.Caption = "select a 24-bit bitmap for terrain"
    'openDialog.filter = "*.bmp (bitmaps)|*.bmp"
    IF openDialog.execute THEN
		TheBitMap.LoadFromFile (openDialog.filename)
	ELSE
		Application.Terminate			'nothing to render, forget it
	END IF
END SUB



SUB HeightMapMesh(HeightMap AS QBITMAP, TheMeshBuilder AS QD3DMeshBuilder)
	DIM Xmap 	AS INTEGER: Xmap = 0	'coordinates of the height map
	DIM Ymap 	AS INTEGER: Ymap = 0
	DIM x 		AS DOUBLE				'colors for the vertices
	DIM y 		AS DOUBLE
	DIM z 		AS DOUBLE				'coordinates of terrain
	DIM xc 		AS DOUBLE
	DIM zc 		AS DOUBLE				'center of our scene


	DIM fColor 	AS SINGLE				'floating point representation of color
	'DIM Face 	AS QD3DFace

	IF HeightMap.PixelFormat < 6 THEN
		ShowMessage "Height maps must be 24-bit images"		'pf24bit
		EXIT SUB
	END IF

	CancelTerrLoad = 0					'let user break if too long
	CREATE WaitForm AS QFORM
		Parent = Form:	Caption = "Calculating map ...":	Width = 300: Height = 120: Center
		CREATE CancelMyLoad AS QBUTTON
			left = 120: top = 45:	Caption = "Cancel":		OnClick = Cancel_Load
		END CREATE
  		CREATE Gauge AS QGauge
    		Height = 20: Top = 15: left = 20: Width = 250: max = HeightMap.Width
		END CREATE
		Show
	END CREATE

	xc = HeightMap.Width/2								'//center the terrain in our mesh
	zc = HeightMap.Height/2
	yScale = (HeightMap.Width + HeightMap.Height)/4		'//give it some real height

	FOR Xmap = 0 TO (HeightMap.Width - (2* Step_size)) STEP Step_size
		FOR Ymap = 0 TO (HeightMap.Height - (2* Step_size)) STEP Step_size
		IF (HeightMap.Pixel(Xmap, Ymap)) = (HeightMap.Pixel(Xmap + Step_size, Ymap)) = _
			(HeightMap.Pixel(Xmap + Step_size, Ymap)) = (HeightMap.Pixel(Xmap + Step_size, Ymap+ Step_size)) THEN
			'nothing skip
		ELSE
			x = Xmap : z = Ymap
			DXScreen.CreateFace(Face)
			y = (HeightMap.Pixel(Xmap, Ymap) AND 255) /yScale		'// Get the (X, Y, Z) value for the bottom left vertex	
			Face.AddVertex(x - xc, y, z - zc)			'//vertex is each point of a face
	
			x = Xmap : z = Ymap + Step_size				'// Get the (x,y,z) values for the top left vertex	
			y = (HeightMap.Pixel(Xmap, Ymap + Step_size) AND 255) /yScale
			Face.AddVertex(x - xc, y, z - zc)			'//vertex is each point of a face

			x = Xmap + Step_size: z = Ymap + Step_size		'//top right vertex	
			y = (HeightMap.Pixel(Xmap + Step_size, Ymap + Step_size) AND 255) /yScale
			Face.AddVertex(x - xc, y, z - zc)

			x = Xmap + Step_size: z = Ymap		'//bottom right vertex
			y = (HeightMap.Pixel(Xmap + Step_size, Ymap) AND 255) /yScale
			Face.AddVertex(x - xc, y, z - zc)

		'	fColor = (HeightMap.Pixel(Xmap, Ymap) + HeightMap.Pixel(Xmap + Step_size, Ymap + Step_size))/2
		'	SELECT CASE fColor							'// Set the color value of the current vertice.
		'		CASE IS > 130
		'			Face.SetColorRGB (fColor, fColor, fColor ) 	'//snow
		'		CASE IS < 2
		'			 Face.SetColorRGB (0, 60, 200 ) 			'//water
		'		CASE ELSE
		'			Face.SetColorRGB (0, fColor, 0 )			'//grass
		'	END SELECT

			TheMeshBuilder.AddFace(Face)						'//add this face to a mesh via meshbuilder
		END IF
		NEXT Ymap
		Gauge.Position = Xmap
		DOEVENTS
		IF CancelTerrLoad THEN WaitForm.Close: EXIT SUB
	NEXT Xmap
	WaitForm.Close
END SUB




SUB MakeSkyBox(HeightMap AS QBITMAP)
	DIM Xmap 	AS INTEGER: Xmap = 0				'coordinates of the height map
	DIM Ymap 	AS INTEGER: Ymap = 0
	DIM x0 		AS DOUBLE				'colors for the vertices
	DIM z0 		AS DOUBLE
	DIM Face 	AS QD3DFace

	x0 = -HeightMap.Width/2									'//center the terrain in our mesh
	z0 = -HeightMap.Height/2
	Xmap = -x0 - Step_size
	Ymap = -z0 - Step_size
	yScale = (HeightMap.Width + HeightMap.Height)/1.5		'//give it some real height


	DXScreen.CreateFace(Face)
	Face.AddVertex(Xmap, 0, z0): Face.AddVertex(Xmap, yScale, z0)
	Face.AddVertex(x0, yScale, z0): Face.AddVertex(x0, 0, z0) : 	 		'front
	Face.SetColorRGB(2255, 255, 255)'(0,0,190)
	SkyBox.AddFace(Face)

	DXScreen.CreateFace(Face)
	Face.AddVertex(Xmap, 0, Ymap):	Face.AddVertex(Xmap, yScale, Ymap)
	Face.AddVertex(Xmap, yScale, z0): 	Face.AddVertex(Xmap, 0, z0) 		'right
	Face.SetColorRGB(2255, 255, 255)'(0,0,190)
	SkyBox.AddFace(Face)

	DXScreen.CreateFace(Face)
	Face.AddVertex(x0, 0, Ymap): 	Face.AddVertex(x0, yScale, Ymap)
	Face.AddVertex(Xmap, yScale, Ymap): Face.AddVertex(Xmap, 0, Ymap)  		'back
	Face.SetColorRGB(2255, 255, 255)'(0,0,190)
	SkyBox.AddFace(Face)

	DXScreen.CreateFace(Face)
	Face.AddVertex(x0, 0, z0):	Face.AddVertex(x0, yScale, z0)
	Face.AddVertex(x0, yScale, Ymap):	Face.AddVertex(x0, 0, Ymap):   		'left
	Face.SetColorRGB(2255, 255, 255)'(0,0,190)
	SkyBox.AddFace(Face)

	DXScreen.CreateFace(Face)
	Face.AddVertex(x0, yScale, z0):	Face.AddVertex(Xmap, yScale, z0)
	Face.AddVertex(Xmap, yScale, Ymap):	Face.AddVertex(x0, yScale, Ymap):   'ceiling
	Face.SetColorRGB(2255, 255, 255)'(0,0,190)
	SkyBox.AddFace(Face)

	DXScreen.CreateFace(Face)
	Face.AddVertex(x0, 0, Ymap):	Face.AddVertex(Xmap, 0, Ymap)	
	Face.AddVertex(Xmap,0, z0):		Face.AddVertex(x0, 0, z0)				'floor
	Face.SetColorRGB(0, 60, 200 ) 											'//water
	FloorMesh.AddFace(Face)
END SUB




SUB MakeRandomTerrMesh (TheMeshBuilder AS QD3DMeshBuilder)
''		*********  next create a face of 4-sided polygons  ******************
RANDOMIZE
	DIM x AS DOUBLE, y AS DOUBLE, z AS DOUBLE
	DIM HeightScale AS SINGLE
	DIM StepRes AS SINGLE
	DIM MaxX AS DOUBLE, MaxY AS DOUBLE			'terrain dimension
	DIM MatX AS INTEGER, MatY AS INTEGER		'index for matrix
	DIM indxX AS INTEGER, indxY AS INTEGER
	DIM Face AS QD3DFace						'won't modify in main program so just declare it in sub

	StepRes = 1
	MaxX = 20: MaxY = 20
	MatX = MaxX/StepRes + 1
	MatY = MaxY/StepRes + 1
	HeightScale = 5
	DIM MeshMat (MatX *2, MatY*2)	AS DOUBLE		'matrix for height map
	MEMSET (VARPTR(MeshMat(0,0)),0, sizeof(MeshMat()))
	FOR IndxX =0 TO MatX *2
	FOR IndxY = 0 TO MatY *2
		MeshMat(IndxX, IndxY) = RND(100)/100 * HeightScale		'set random height map
	NEXT IndxY
	NEXT IndxX

	indxX = 0 : indxY =0
	FOR x = -MaxX to MaxX STEP StepRes
	FOR y = -MaxY to MaxY STEP StepRes
		DXScreen.CreateFace(Face)
		Face.AddVertex(x, y, MeshMat(IndxX, IndxY))
		Face.AddVertex(x + StepRes, y, MeshMat(IndxX +1, IndxY))		'a plane in x,y,z coordinates, z is flat
		Face.AddVertex(x + StepRes, y + StepRes, MeshMat(IndxX+1, IndxY+1))			'make vertices in either clockwise or counter clockwise 
		Face.AddVertex(x, y + StepRes, MeshMat(IndxX, IndxY+1))
	'	IF MeshMat(IndxX, IndxY) < (HeightScale/1.5) THEN Face.SetColorRGB (0.2, 0.8, 0.0)
		TheMeshBuilder.AddFace(Face)					'make the polygons on the face into a mesh for rendering
		IndxY++ : if IndxY > MaxY  *2 THEN IndxY = 0
	NEXT y
		IndxX++
	NEXT x
END SUB


SUB Turn_On_Fog
	MeshFrame.FogEnabled = 1
	MeshFrame.FogMode = D3DRMFOG_EXPONENTIAL 'D3DRMFOG_LINEAR
	MeshFrame.FogColor = RGB(255,255,255)
	MeshFrame.SetFogParams(-1.0, 1.0, 1.0)'-HeightBitMap.Width, HeightBitMap.Width, 1.0)
END SUB


SUB Load_Terrain_Texture
	DIM openDialog AS QOPENDIALOG

    openDialog.Caption = "select a bitmap for texture"
    openDialog.filter = "*.bmp (bitmaps)|*.bmp"
    IF openDialog.execute THEN 
        MeshBuilder.loadTexture(openDialog.fileName)
        DXScreen.createWrap(D3DRMWRAP_SPHERE, 0,0,0, 0,0,1, 0,1,0, 0,0, 1,1, wrap)'args-[1,2,3] wrap origin, [4,5,6] z-axis vector, [7,8,9] y-axis vector, [10,11] and [12,13] origin and scale factor of texture
        wrap.apply(MeshBuilder)
		DXScreen.SetTextureQuality(D3DRMTEXTURE_LINEAR)'(D3DRMTEXTURE_MIPLINEAR)
	END IF
END SUB

SUB Load_Sky_Texture
	DIM openDialog AS QOPENDIALOG

    openDialog.Caption = "select a bitmap for sky"
    openDialog.filter = "*.bmp (bitmaps)|*.bmp"
    IF openDialog.execute THEN 
        SkyBox.loadTexture(openDialog.fileName)
        DXScreen.createWrap(D3DRMWRAP_SPHERE, 0,0,0, 0,0,1, 0,1,0, 0,0, 1,1, wrap)'args-[1,2,3] wrap origin, [4,5,6] z-axis vector, [7,8,9] y-axis vector, [10,11] and [12,13] origin and scale factor of texture
        wrap.apply(SkyBox)
		DXScreen.SetTextureQuality(D3DRMTEXTURE_LINEAR)'D3DRMTEXTURE_MIPLINEAR)
	END IF
END SUB


SUB Load_Background
	DIM TheTexture AS QD3DTexture
	DIM openDialog AS QOPENDIALOG
'	DIM a as integer

DIM a as SINGLE
a = DXSCREEN.VIEW.GETFRONT
showmessage str$(a)

'DXSCREEN.FastPset(12,12,242)
	'DXSCREEN.SETVELOCITY(1, 0, 1, 0)

	'DXSCREEN.VIEW.GETBACK
	'DXSCREEN.VIEW.SETFRONT (RVFRONT)
	'DXSCREEN.VIEW.SETBACK (RVBACK)
	'DXSCREEN.VIEW.SETPLANE (LEFT, RIGHT, BOTTOM, TOP)

  '  openDialog.Caption = "select a bitmap for texture"
  '  openDialog.filter = "*.bmp (bitmaps)|*.bmp"

   ' IF openDialog.execute THEN 
	'	DXScreen.LoadTexture(openDialog.filename, TheTexture)
	'	DXScreen.SetBackgroundImage(TheTexture)
		'MeshBuilder.SetTexture(TheTexture)' AS QD3DTexture) 

'	END IF
END SUB



SUB Reload_Height_Map
	MeshFrame.DeleteVisual(MeshBuilder)					'Delete the old meshes
	MeshFrame.DeleteVisual(SkyBox)						'Delete the old meshes
	MeshFrame.DeleteVisual(FloorMesh)
	MeshFrame.DeleteFrame(MeshFrame)					'may not work
	DXScreen.CreateFrame(MeshFrame)						'wipe out old frame
	Create_Height_Mesh									'in with the new
END SUB
	


SUB Create_Height_Mesh
	DXScreen.CreateFrame(MeshFrame)
	DXScreen.CreateMeshBuilder(MeshBuilder)
	LoadBitMap_For_Height (HeightBitMap)
	HeightMapMesh(HeightBitMap, MeshBuilder)				'make a mesh from a bitmap file
	MakeSkyBox(HeightBitMap)
	MeshBuilder.SetQuality(D3DRMRENDER_GOURAUD)				'highest rendering Quality is D3DRMRENDER_PHONG, but not much diff
	MeshFrame.AddVisual(MeshBuilder)						'add it to a frame to move, translate, etc.
	MeshFrame.AddVisual(SkyBox)
	DXScreen.CameraLookAt(MeshFrame, D3DRMCONSTRAIN_Z)		'constrain the angle that the camera looks at
END SUB




SUB Cancel_Load
	CancelTerrLoad = 1
END SUB




SUB CloseApp
	MeshFrame.DeleteFrame(MeshFrame)
	MeshFrame.DeleteVisual(MeshBuilder)	'just in case we need to free up resources
	MeshFrame.DeleteVisual(SkyBox)
	Application.Terminate
END SUB