Media View replacement

Blitz3D Forums/Blitz3D Programming/Media View replacement

Yan
 #1
Here's what I use as a model viewer.

It's almost as old as B3D itself and has had new features hacked in over the years, as they've become available or as I've needed them. So the things pretty crusty.

It's *far* from being *the* model viewer, but I still find it useful...

;Compile Me
;Then drop any model onto me to view

;KEYS:-
;space toggles bone mode
;i for more model info (just mesh size ATM)
;h Show help
;w toggles wireframe
;r to reload model (handy for texture changes etc)
;c toggles camera between map and model mode
;s toggles flat shading
;l toggles full bright
;v toggles vertex colour
;b toggles backfaces
;t toggles textures

;-= Model Mode =-
;LMB to rotate model
;RMB to reset model (and camera) rotation / position
;MMB to move model along X / Y axis
;MWHEEL to scale model (up / down CSR) + SHIFT for x10 (just zooms camera)
;0,1,2,3 to animate model
;Left / Right CSR to adjust anim speed

;-= Map Mode =-
;Mouse X/Y to rotate camera
;Up / Down CSR to move camera backward and forward
;Left / Right CSR to strafe camera
;RMB to increase speed x5

ChangeDir SystemProperty("AppDir")

Const screen_w = 640
Const screen_h = 480

Global tab
Global polys
Global surfaces
Global textures

Type texture 
	Field texture[256], used
	Field name$
End Type

AppTitle "Yan's Rough'N'Ready model Viewer"

Graphics3D screen_w, screen_h, 0, 2

input_model$ = Lower$(CommandLine$())
input_model$ = Replace$(input_model$, Chr$(34), "")

TextureFilter "#a", 514
TextureFilter "#c", 128
TextureFilter "#e", 64
TextureFilter "#m", 4

mtype$ = Right$(input_model$, 4)
If mtype$ = ".md2"
	md2 = 1
Else
	If (mtype$ = ".3ds") Or (mtype$ = ".b3d") Or (Right$(mtype$, 2) = ".x")
		md2 = 0
	Else
		RuntimeError input_model$ + " is not a supported model type"
	EndIf
EndIf

If md2
	model = LoadMD2(input_model$)
	texture_md2(model, input_model$)
	PositionEntity model, 0, 0, 0
	length = MD2AnimLength(model)
Else
	model = LoadAnimMesh(input_model$)
	PositionEntity model, 0, 0, 0
	length = AnimLength(model)
	get_textures(model)
;	For t.texture=Each texture
;		DebugLog "Name   : " + t\name$
;		For ti=1 To t\used
;			DebugLog "Handle : " + t\texture[ti]
;		Next
;		DebugLog "Used   : " + t\used
;		DebugLog ""
;	Next
	count_polys(model)
EndIf 

cam = CreateCamera()
PositionEntity cam, 0, 0, -75

light = CreateLight(1)
LightColor light, 148 , 148, 148
PositionEntity light, 0, 250, -200 

anim_text$ = "0 - Stopped"
scale# = 1
inc# = 0.01
speed# = 1
mz = 0
mx = 0
my = 0
axis = 1
info = 0
help = 0
wf = 0
t_on = 2
camera_mode = 0
camera_text$ = "Model"
cam_speed = 1
fx = 0
htw = 262
hth = 212
htx = (screen_w Shr 1)
hty = (screen_h Shr 1) - (hth - 12)

Repeat
	mz = MouseZSpeed()
	
	If KeyHit(19)
		surfaces = 0
		textures = 0
		polys = 0
		tp# = EntityPitch(model)
		ty# = EntityYaw(model)
		tr# = EntityRoll(model)
		txa# = EntityX(model)
		tya# = EntityY(model)
		tza# = EntityZ(model)
		FreeEntity model
		For t.texture = Each texture
			For ti=1 To t\used
				FreeTexture t\texture[ti]
			Next
			Delete t
		Next
		
		If md2
			model = LoadMD2(input_model$)
			texture_md2(model, input_model$)
			PositionEntity model, txa#, tya#, tza#
			length = MD2AnimLength(model)
		Else
			model = LoadAnimMesh(input_model$)
			PositionEntity model, txa#, tya#, tza#
			length = AnimLength(model)
			get_textures(model)
			count_polys(model)
		EndIf
		
		RotateEntity model, tp#, ty#, tr#
		ScaleEntity model, scale#, scale#, scale#
	EndIf
	
	If camera_mode = 0
		If md2
			If length > 1
				If KeyHit(2)
					AnimateMD2 model, 1, 0.1, 1, length
					anim_text$ = "1 - Loop"
				EndIf
				
				If KeyHit(3)
					AnimateMD2 model, 2, 0.1, 1, length
					anim_text$ = "2 - Ping Pong"
				EndIf
				
				If KeyHit(4)
					AnimateMD2 model, 3, 0.1, 1, length
					anim_text$ = "3 - Single Shot"
				EndIf
				
				If KeyHit(11)
					AnimateMD2 model, 0
					anim_text$ = "0 - Stop"
				EndIf
			EndIf		
		Else
			If length > 1
				If KeyHit(2)
					Animate model, 1, 0.1
					anim_text$ = "1 - Loop"
				EndIf
				
				If KeyHit(3)
					Animate model, 2, 0.1
					anim_text$ = "2 - Ping Pong"
				EndIf
				
				If KeyHit(4)
					Animate model, 3, 0.1
					anim_text$ = "3 - Single Shot"
				EndIf
				
				If KeyHit(11)
					Animate model, 0
					anim_text$ = "0 - Stopped"
				EndIf
			EndIf
		EndIf
		
		If KeyDown(42) Or KeyDown(54)
			inc# = 0.1
		Else
			inc# = 0.01
		EndIf
		
		If KeyDown(200) Or (mz = 1)
			scale# = scale# + inc#
			If scale# > 50 Then  scale# = 50
			ScaleEntity model, scale#, scale#, scale# 
		EndIf
		
		If KeyDown(208) Or (mz = -1)
			scale# = scale# - inc#
			If scale# < 0 Then scale# = 0
			ScaleEntity model, scale#, scale#, scale#
		EndIf
		
		If KeyHit(205)
			speed# = speed# + inc#
			If speed# > 10 Then speed# = 10
		EndIf
		
		If KeyHit(203)
			speed# = speed# - inc#
			If speed# < 0 Then speed# = 0
		EndIf
		
		If KeyHit(46)
			camera_mode = 1
			camera_text$ = "Map"
			RotateEntity model, 0, 0, 0
			FlushMouse()
			HidePointer()
		EndIf
		
		If MouseDown(1)	
			TurnEntity model, -MouseYSpeed(), 0, 0, 1
			TurnEntity model, 0, MouseXSpeed(), 0
		Else
			If MouseDown(3)
				TranslateEntity model, MouseXSpeed() * 0.1, -(MouseYSpeed() * 0.1), 0, 1
			Else
				MouseXSpeed()
				MouseYSpeed()
			EndIf
		EndIf
		
		If MouseHit(2)
			RotateEntity model, 0, 0, 0
			PositionEntity model, 0, 0, 0
			PositionEntity cam, 0, 0, -75
			RotateEntity cam, 0, 0, 0 
		EndIf
	Else
		mxs# = MouseXSpeed() * 0.25
		mys# = MouseYSpeed() * 0.25
		MoveMouse screen_w Shr 1, screen_h Shr 1
		
		TurnEntity cam, -mys#, 0, 0, 0
		TurnEntity cam, 0, -mxs#, 0, 1
		
		If KeyDown(200) Or (mz = 1)
			MoveEntity cam, 0, 0, cam_speed
		EndIf
		
		If KeyDown(208) Or (mz = -1)
			MoveEntity cam, 0, 0, -cam_speed
		EndIf
		
		If KeyDown(205)
			MoveEntity cam, cam_speed, 0, 0
		EndIf
		
		If KeyDown(203)
			MoveEntity cam, -cam_speed, 0, 0
		EndIf
		
		If MouseDown(2)
			cam_speed = 5
		Else
			cam_speed = 1
		EndIf
		
		If KeyHit(46)
			camera_mode = 0
			camera_text$ = "Model"
			FlushMouse()
			ShowPointer()
		EndIf	
	EndIf
	
	If KeyHit(23) Then info = 1 - info
	
	If KeyHit(35) Then help = 1 - help
	
	If KeyHit(17)
		wf = (wf + 1) Mod 3
		WireFrame wf Mod 2
	EndIf
	
	If KeyHit(31)
		fx = fx Xor 4
		rec_fx(model, fx)
	EndIf
	
	If KeyHit(38)
		fx = fx Xor 1
		rec_fx(model, fx)
	EndIf
	
	If KeyHit(47)
		fx = fx Xor 2
		rec_fx(model, fx)
	EndIf
	
	If KeyHit(48)
		fx = fx Xor 16
		rec_fx(model, fx)
	EndIf
	
	If KeyHit(20)
		t_on = 2 - t_on
		For t.texture = Each texture
			For ti=1 To t\used
				TextureBlend t\texture[ti], t_on
			Next
		Next
	EndIf
	
	If KeyHit(57)
		axis = axis + 1
		If axis = 5 Then axis = 0
	EndIf
		
	UpdateWorld speed#
	RenderWorld
	
	If md2
		frame# = MD2AnimTime(model)
	Else
		frame# = AnimTime(model)
	EndIf
	
	If axis Then draw_bone_axis(model, cam, axis)
	
	If wf = 2 Then wire_frame(model, cam)
	
	Color 255, 255, 255
	Text screen_w - 180, 0, "Total Length  : " + length
	
	Text 0, 0, "Triangles : " + polys
	Text 0, 12, "Surfaces  : " + surfaces
	Text 0, 24, "Textures  : " + textures
	
	Text screen_w - 180, 12, "Current Frame : " + Left$(String$("0", 4 - Instr(frame#, ".")) + Str$(frame#), 6)
	Text screen_w - 180, 24, "Current Speed : " + Left$(String$("0", 4 - Instr(speed#, ".")) + Str$(speed#), 6)
	
	Text 0, screen_h - 14, "Anim Mode   : " + anim_text$
	Text 0, screen_h - 26, "Camera Mode : " + camera_text$
	
	Text screen_w - 110, screen_h - 14, "Scale : " + Left$(String$("0", 3 - Instr(scale#, ".")) + Str$(scale#), 5) 
	
	If info
		If md2 = 0
			Text screen_w Shr 1, (screen_h Shr 1) - 12, "Width  : " + MeshWidth(model), 1, 1
			Text screen_w Shr 1, screen_h Shr 1, "Height : " + MeshHeight(model), 1, 1
			Text screen_w Shr 1, (screen_h Shr 1) + 12, "Depth  : " + MeshDepth(model), 1, 1
		EndIf
	EndIf
	
	If help
		Color 0, 0, 200
		Rect htx - htw, hty - 12, (htw Shl 1), (hth Shl 1), 1
		
		Color 255, 255, 255
		Rect htx - htw, hty - 12, (htw Shl 1), (hth Shl 1), 0
		
		Text htx, hty, "-= General =-", 1, 1
		Text htx, (hty + 12), "space toggles bone mode", 1, 1
		Text htx, (hty + 24), "i for more model info (just mesh size ATM)", 1, 1
		Text htx, (hty + 36), "h Show help", 1, 1
		Text htx, (hty + 48), "w toggles wireframe", 1, 1
		Text htx, (hty + 60), "r to reload model (handy for texture changes etc)", 1, 1
		Text htx, (hty + 72), "c toggles camera between map and model mode", 1, 1
		Text htx, (hty + 84), "s toggles flat shading", 1, 1
		Text htx, (hty + 96), "l toggles full bright", 1, 1
		Text htx, (hty + 108), "v toggles vertex colour", 1, 1
		Text htx, (hty + 120), "b toggles backfaces", 1, 1
		Text htx, (hty + 132), "t toggles textures", 1, 1
		
		Text htx, (hty + 156), "-= Model Mode =-", 1, 1
		Text htx, (hty + 168), "LMB to rotate model", 1, 1
		Text htx, (hty + 180), "RMB to reset model (and camera) rotation / position", 1, 1
		Text htx, (hty + 192), "MMB to move model along X / Y axis", 1, 1
		Text htx, (hty + 204), "MWHEEL to scale model (up / down CSR) + SHIFT for x10", 1, 1
		Text htx, (hty + 216), "0,1,2,3 to animate model", 1, 1
		Text htx, (hty + 228), "Left / Right CSR to adjust anim speed", 1, 1
		
		Text htx, (hty + 252), "-= Map Mode =-", 1, 1
		Text htx, (hty + 266), "Mouse X/Y to rotate camera", 1, 1
		Text htx, (hty + 278), "Up / Down CSR to move camera backward and forward", 1, 1
		Text htx, (hty + 290), "Left / Right CSR to strafe camera", 1, 1
		Text htx, (hty + 302), "RMB to increase speed x5", 1, 1	
	EndIf
	
	Flip 0
	Delay(33)
Until KeyDown(1)

End

Function draw_bone_axis(root, cam, mode, pjx_2d=-1, pjy_2d=-1)
	Local j, jx_2d, jy_2d, child, tz#
	
	; Joints position
	CameraProject cam, EntityX(root, 1), EntityY(root, 1), EntityZ(root, 1)
	jx_2d = ProjectedX() : jy_2d = ProjectedY()
	; X axis
	Color 255, 0, 0
	TFormPoint 2, 0, 0, root, 0
	CameraProject cam, TFormedX(), TFormedY(), TFormedZ()
	Line jx_2d, jy_2d, ProjectedX(), ProjectedY()
	; Y axis
	Color 0, 255, 0
	TFormPoint 0, 2, 0, root, 0
	CameraProject cam, TFormedX(), TFormedY(), TFormedZ()
	Line jx_2d, jy_2d, ProjectedX(), ProjectedY()
	; Z axis
	Color 0, 0, 255
	TFormPoint 0, 0, 2, root, 0
	CameraProject cam, TFormedX(), TFormedY(), TFormedZ()		
	Line jx_2d, jy_2d, ProjectedX(), ProjectedY()
	; Pivot
	Color 255, 255, 255
	Oval jx_2d - 2, jy_2d - 2, 4, 4, 1
	
	If (mode = 2) Or (mode = 4)
		Color 255, 255, 255
		Text jx_2d, jy_2d, EntityName$(root), 0, 1 
	EndIf
	
	If (mode = 3) Or (mode = 4)
		If (pjx_2d <> -1)
			If (pjy_2d <> -1)
				Color 255, 0, 255
				Line jx_2d, jy_2d, pjx_2d, pjy_2d
			EndIf
		EndIf
	EndIf
	
	If EntityClass$(root) <> "Pivot"
		jx_2d = -1
		jy_2d = -1
	EndIf
	
	For j=1 To CountChildren(root)
		child = GetChild(root, j)
		If child Then draw_bone_axis(child, cam, mode, jx_2d, jy_2d)
	Next
End Function

Function count_polys(mesh)
	Local s, c 
	
	If EntityClass$(mesh) = "Mesh"
		For s=1 To CountSurfaces(mesh)
			polys = polys + CountTriangles(GetSurface(mesh, s))
		Next
	EndIf
			
	For c=1 To CountChildren(mesh)
		count_polys(GetChild(mesh, c))
	Next
End Function

;Function count_surfaces(mesh)
;	Local c
;	
;	If EntityClass$(mesh) = "Mesh" Then surfaces = surfaces + CountSurfaces(mesh)
;			
;	For c=1 To CountChildren(mesh)
;		count_surfaces(GetChild(mesh, c))
;	Next
;End Function

Function wire_frame(mesh, cam)
	Local si, s, ti, v, tvx[2], tvy[2], child, j
	
	If EntityClass$(mesh) = "Mesh"
		LockBuffer
		
		For si=1 To CountSurfaces(mesh)
			s = GetSurface(mesh, si)
			For ti=0 To CountTriangles(s) - 1
				For v=0 To 2
					vi = TriangleVertex(s, ti, v)
					TFormPoint VertexX(s, vi), VertexY(s, vi), VertexZ(s, vi), mesh, 0
					CameraProject cam, TFormedX(), TFormedY(), TFormedZ()			
					tvx[v] = ProjectedX()
					tvy[v] = ProjectedY()
				Next
	
				If (((tvx[0] - tvx[1]) * (tvy[2] - tvy[1])) - ((tvy[0] - tvy[1]) * (tvx[2] - tvx[1]))) < 0
					Color 255, 255, 255
					Line tvx[0], tvy[0], tvx[1], tvy[1]
					Line tvx[1], tvy[1], tvx[2], tvy[2]
					Line tvx[2], tvy[2], tvx[0], tvy[0]
				EndIf
			Next
		Next
		
		UnlockBuffer
	EndIf
	
	For j=1 To CountChildren(mesh)
		child = GetChild(mesh, j)
		If child Then wire_frame(child, cam)
	Next

End Function

Function get_textures(mesh)
	Local c, b, cs, bt, bi, match, ttex$, tname$ 
	
	If EntityClass$(mesh) = "Mesh"
		surfaces = surfaces + CountSurfaces(mesh)
		
		For cs=1 To CountSurfaces(mesh)
			b = GetSurfaceBrush(GetSurface(mesh, cs))
			
			For bi=0 To 7 
				bt = GetBrushTexture(b, bi)
				ttex$ = TextureName$(bt)
				tname$ = Right$(ttex$, Len(ttex$) - last_slash(ttex$))
				
				If tname$ <> ""					
					match = 0
					For t.texture = Each texture
						If tname$ = t\name$
							t\used = t\used + 1
							t\texture[t\used] = bt
							match = 1
							Exit
						EndIf
					Next
					
					If (Not match)
						t.texture = New texture
						t\texture[1] = bt
						t\used = 1
						t\name$ = tname$
						textures = textures + 1
					EndIf
				Else
					FreeTexture bt
				EndIf 
			Next
			
			FreeBrush b
		Next
	EndIf
				
	For c=1 To CountChildren(mesh)
		get_textures(GetChild(mesh, c))
	Next
End Function

Function texture_md2(mesh, fname$)
	Local name$, path$, p$, sp, dir, d$, ext$ = ".jpg.bmp.tif.png.pcx",txt
	
	fname$ = Lower$(fname$)
	
	sp = last_slash(fname$)
		
	p$ = Left$(fname$, sp)
	
	name$ = Right$(fname$, Len(fname$) - sp)
	name$ = Left$(name$, Instr(name$, ".") - 1)
		
	dir = ReadDir(p$)
	
	d$ = NextFile(dir)
	While d$ <> ""
		If FileType(p$ + d$) = 1
			If Instr(d$, name$) > 0
				If Instr(ext$, Right$(d$, 4)) > 0
					txt = LoadTexture(p$ + d$)
					EntityTexture mesh, txt
					FreeTexture txt
					Return
				EndIf
			EndIf
		EndIf
		d$ = NextFile(dir)
	Wend
End Function

Function last_slash(path$)
	Local sp
	
	For sp=Len(path$) To 1 Step -1
		If (Mid$(path$, sp, 1) = "/") Or (Mid$(path$, sp, 1) = "") Then Return sp
	Next
	
	Return Len(path$)	
End Function

Function rec_fx(mesh, flags)
	Local c	
	
	If EntityClass$(mesh) = "Mesh" Then EntityFX mesh, flags
			
	For c=1 To CountChildren(mesh)
		rec_fx(GetChild(mesh, c), flags)
	Next
End Function


I should really rewrite this from scratch...But..If it ain't broke... etc. ;o)