Basic4Android 3D Object Rotate

Sub Process_Globals
	Type Node (X As Double, Y As Double, Z As Double)
	Type Face (Nodes As List)
	Type Obj (Nodes() As Node, Faces() As Face)
	Dim PI As Double = 3.14159
End Sub

Sub Globals
	Dim DCube As Obj = CreateCube(-100dip,-100dip,-100dip,200dip,200dip,200dip)
	Dim XOffset As Int = 200dip
	Dim YOffset As Int = 200dip

	Dim IsDown As Boolean
	Dim OldPoX As Int
	Dim OldPoY As Int
	Dim DragSensitivity As Int = 5
End Sub

Sub InitNode(X As Double, Y As Double, Z As Double) As Node

	Dim NewNode As Node
	NewNode.X = X
	NewNode.Y = Y
	NewNode.Z = Z
	Return NewNode

End Sub

Sub InitFace(Nodes As List) As Face

	Dim NewFace As Face
	NewFace.Nodes = Nodes
	Return NewFace

End Sub

Sub CreateCube(X As Double, Y As Double, Z As Double, W As Double, H As Double, D As Double) As Obj

	Dim Cube As Obj

	Dim Nodes(8) As Node
	Nodes(0) = InitNode(X,Y,Z)
	Nodes(1) = InitNode(X,Y,Z+D)
	Nodes(2) = InitNode(X,Y+H,Z)
	Nodes(3) = InitNode(X,Y+H,Z+D)
	Nodes(4) = InitNode(X+W,Y,Z)
	Nodes(5) = InitNode(X+W,Y,Z+D)
	Nodes(6) = InitNode(X+W,Y+H,Z)
	Nodes(7) = InitNode(X+W,Y+H,Z+D)

	Dim Faces(6) As Face
	Faces(0) = InitFace(Array As Int(1, 3, 7, 5))
	Faces(1) = InitFace(Array As Int(1, 0, 4, 5))
	Faces(2) = InitFace(Array As Int(1, 3, 2, 0))
	Faces(3) = InitFace(Array As Int(4, 6, 2, 0))
	Faces(4) = InitFace(Array As Int(4, 6, 7, 5))
	Faces(5) = InitFace(Array As Int(6, 7, 3, 2))

	Cube.Nodes = Nodes
	Cube.Faces = Faces

	Return Cube

End Sub

Sub RotateX(Theta As Double, DObject As Obj)

	Dim Rad As Double = (2 * PI) * Theta / 360

	Dim TSin As Double = Sin(Rad)
	Dim TCos As Double = Cos(Rad)

	For N=0 To DObject.Nodes.Length - 1

		Dim Y As Double = DObject.Nodes(N).Y
		Dim Z As Double = DObject.Nodes(N).Z

		DObject.Nodes(N).Y = Y * TCos - Z * TSin
		DObject.Nodes(N).Z = Z * TCos + Y * TSin

	Next
End Sub

Sub RotateY(Theta As Double, DObject As Obj)

	Dim Rad As Double = (2 * PI) * Theta / 360

	Dim TSin As Double = Sin(Rad)
	Dim TCos As Double = Cos(Rad)

	For N=0 To DObject.Nodes.Length - 1

		Dim X As Double = DObject.Nodes(N).X
		Dim Z As Double = DObject.Nodes(N).Z

		DObject.Nodes(N).X = X * TCos - Z * TSin
		DObject.Nodes(N).Z = Z * TCos + X * TSin

	Next
End Sub

Sub RotateZ(Theta As Double, DObject As Obj)

	Dim Rad As Double = (2 * PI) * Theta / 360

	Dim TSin As Double = Sin(Rad)
	Dim TCos As Double = Cos(Rad)

	For N=0 To DObject.Nodes.Length - 1

		Dim X As Double = DObject.Nodes(N).X
		Dim Y As Double = DObject.Nodes(N).Y

		DObject.Nodes(N).Y = X * TCos - Y * TSin
		DObject.Nodes(N).Z = X * TSin + Y * TCos

	Next
End Sub

Sub DrawObject(DObj As Obj)

	Dim Canvas As Canvas
	Canvas.Initialize(Activity)

	Canvas.DrawColor(Colors.ARGB(255,0,0,0))

	For F=0 To DObj.Faces.Length - 1
		Dim NodeList As List = DObj.Faces(F).Nodes
		Dim Str As String = NodeList.Get(0)
		Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(0)).x,YOffset + DObj.Nodes(NodeList.Get(0)).Y,XOffset + DObj.Nodes(NodeList.Get(1)).X,YOffset + DObj.Nodes(NodeList.Get(1)).y, Colors.Red, 3)
		Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(1)).x,YOffset + DObj.Nodes(NodeList.Get(1)).Y,XOffset + DObj.Nodes(NodeList.Get(2)).X,YOffset + DObj.Nodes(NodeList.Get(2)).y, Colors.Red, 3)
		Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(2)).x,YOffset + DObj.Nodes(NodeList.Get(2)).Y,XOffset + DObj.Nodes(NodeList.Get(3)).X,YOffset + DObj.Nodes(NodeList.Get(3)).y, Colors.Red, 3)
		Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(3)).x,YOffset + DObj.Nodes(NodeList.Get(3)).Y,XOffset + DObj.Nodes(NodeList.Get(0)).X,YOffset + DObj.Nodes(NodeList.Get(0)).y, Colors.Red, 3)
	Next

	For N=0 To DObj.Nodes.Length - 1
		Dim Rect1 As Rect
		Rect1.Initialize(XOffset + DObj.Nodes(N).X - 4, YOffset + DObj.Nodes(N).Y - 4, XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).Y + 4)
		Canvas.DrawOval(Rect1, Colors.blue, True, 5)
		Canvas.DrawText("N:" & (N + 1) & " (X:" & Round(DObj.Nodes(N).X) & " Y:"& Round(DObj.Nodes(N).y) & " Z:" & Round(DObj.Nodes(N).z) & ")", XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).y + 4, Typeface.DEFAULT, 10, Colors.white, "LEFT")
	Next
End Sub

Sub Activity_Create(FirstTime As Boolean)
	Activity.LoadLayout("main")
	DrawObject(DCube)
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

Sub Activity_Touch (Action As Int, X As Float, Y As Float)
	Select Action
      Case Activity.ACTION_DOWN
         IsDown = True
		 OldPoX = X
		 OldPoY = Y
      Case Activity.ACTION_MOVE
         If(IsDown = True) Then
		 	Dim NewPoX As Int = X - OldPoX
			Dim NewPoY As Int = Y - OldPoY

		 	RotateX(NewPoY / DragSensitivity, DCube)
			RotateY(NewPoX / DragSensitivity, DCube)

			OldPoX = X
			OldPoY = Y

			DrawObject(DCube)
		 End If
      Case Activity.ACTION_UP
         IsDown = False
   End Select
End Sub