Issue with 3D Spinning Cube sample in MapTriangle doc

[mdijkens]

I am playing with the samples of _MAPTRIANGLE to get a better understanding of the 3D rotation workings...

As a basis I am using 'Example 2: A 3D Spinning Cube demo using a software image and _MAPTRIANGLE' on the wiki page 

If I put

Code: (Select All)

PIT(OB&) = 90
  YAW(OB&) = 0
ROL(OB&) = 10

With Pitch of 90 degrees, Roll becomes Yaw so the above values would result in the cube rotated to P=90,Y=10,R=0

It must have to do with the formulas here:

Code: (Select All)

RX& = (TZ& * CP - TY& * SP) * SY - ((TZ& * SP + TY& * CP) * SR + TX& * CR) * CY
RY& = (TZ& * SP + TY& * CP) * CR - TX& * SR
RZ& = (TZ& * CP - TY& * SP) * CY + ((TZ& * SP + TY& * CP) * SR + TX& * CR) * SY

But I can't get my head around it.

Can someone give this a try and see what's the error is in these formulas? 

[mdijkens]

If it helps / easier to follow/debug, you can also take a look at my code based on that example 2:

Code: (Select All)

Type XYZtype
  x As Single
  y As Single
  z As Single
End Type
Type XYtype
  x As Single
  y As Single
End Type

_Define A-Z As SINGLE
Const FALSE = 0, TRUE = Not FALSE
PLANESIZE% = 1000

' CREATE PLANES
Dim P(5) As Long
createPlanes P(), PLANESIZE%

' BUILD CUBE IN OBJECT ARRAY
Dim As XYZtype O(5, 3) 'Object (PLANE,POINT)
createObject O(), PLANESIZE%

' CREATE SCREEN
fullScreen 0

'autoRotate O(), P()
mouseRotate O(), P()
End

Sub mouseRotate (O() As XYZtype, P() As Long)
  mScale = _Height(0) / 4
  rotate3D O(), P(), 100, PITCH, YAW, ROLL
  Do
    Do While _MouseInput
      If _MouseButton(1) Then
        If Not moving% Then
          x0 = _MouseX
          y0 = _MouseY
          moving% = TRUE
        End If
      Else
        moving% = FALSE
      End If
    Loop
    If moving% Then
      mdx = (x0 - _MouseX) / mScale
      mdy = (y0 - _MouseY) / mScale
      newP = PITCH + mdx * Sin(ROLL) + mdy * Cos(ROLL) * Cos(YAW)
      newY = YAW + mdx * Cos(ROLL) * Cos(PITCH) + mdy * Sin(ROLL) * Sin(PITCH)
      newR = ROLL + mdx * Sin(PITCH) * Cos(YAW) + mdy * -Sin(YAW) * Cos(PITCH)

      '@TEMP: DEBUG FIXED VALUES ROLL With PITCH=-.5
      newP = _Pi(-.5)
      newY = 0
      newR = _Pi(.1)

      rotate3D O(), P(), 100, newP, newY, newR
      Locate 1, 1, 0
      Print Using "Pitch=####.#"; 360 * newP / _Pi(2)
      Print Using "  Yaw=####.#"; 360 * newY / _Pi(2)
      Print Using " Roll=####.#"; 360 * newR / _Pi(2)
      _Display
    Else
      YAW = newY
      ROLL = newR
      PITCH = newP
    End If
  Loop Until InKey$ <> ""
End Sub

Sub autoRotate (O() As XYZtype, P() As Long)
  Scale = 1: dScale = 1.01
  Do
    _Limit 600
    PITCH = PITCH + .01: If PITCH > _Pi(2) Then PITCH = PITCH - _Pi(2)
    YAW = YAW + .02: If YAW > _Pi(2) Then YAW = YAW - _Pi(2)
    ROLL = ROLL + .03: If ROLL > _Pi(2) Then ROLL = ROLL - _Pi(2)

    Scale = Scale * dScale: If Scale < 1 Or Scale >= 500 Then dScale = 1 / dScale
    rotate3D O(), P(), Scale, PITCH, YAW, ROLL

    If Abs(Timer - t!) >= 1 Then t! = Timer: fps% = fp%: fp% = 0 Else fp% = fp% + 1
    Locate 1, 1, 0: Print "  FPS="; fps%
    Print Using "Pitch=###.#"; 360 * PITCH / _Pi(2)
    Print Using "  Yaw=###.#"; 360 * YAW / _Pi(2)
    Print Using " Roll=###.#"; 360 * ROLL / _Pi(2)
    _Display
  Loop Until InKey$ <> ""
End Sub

Sub rotate3D (O() As XYZtype, P() As Long, SCALE, PITCH, YAW, ROLL)
  Static As XYtype P2D(4) '  SCREEN PLANE COORDINATES (#POINTS PER PLANE)
  Static As XYZtype P3D(4) ' 3D PLANE COORDINATES (#POINTS PER PLANE)
  Static MidX%, MidY%, MidZ%, PlaneSize%
  If PlaneSize% = 0 Then
    PlaneSize% = _Width(P(0)) - 1
    MidX% = 0: MidY% = 0: MidZ% = -18 * PlaneSize%
  End If
  Scaler = SCALE * _Height(0) / 10
  PitchSin = Sin(PITCH): PitchCos = Cos(PITCH)
  YawSin = Sin(YAW): YawCos = Cos(YAW)
  RollSin = Sin(ROLL): RollCos = Cos(ROLL)
  Cls
  For plane% = 0 To 5
    For pnt% = 0 To 3
      ' TRANSLATE, THEN ROTATE
      TX = O(plane%, pnt%).x: TY = O(plane%, pnt%).y: TZ = O(plane%, pnt%).z
      RX = (TZ * PitchCos - TY * PitchSin) * YawSin - ((TZ * PitchSin + TY * PitchCos) * RollSin + TX * RollCos) * YawCos
      RY = (TZ * PitchSin + TY * PitchCos) * RollCos - TX * RollSin
      RZ = (TZ * PitchCos - TY * PitchSin) * YawCos + ((TZ * PitchSin + TY * PitchCos) * RollSin + TX * RollCos) * YawSin
      ' ROTATE, THEN TRANSLATE
      RX = RX + MidX%: RY = RY + MidY%: RZ = RZ + MidZ%
      P3D(pnt%).x = RX: P3D(pnt%).y = RY: P3D(pnt%).z = RZ
      P2D(pnt%).x = _Width(0) / 2 + (Scaler * RX / RZ)
      P2D(pnt%).y = _Height(0) / 2 + (Scaler * RY / RZ)
    Next pnt%
    ' CHECK TO SEE IF PLANE IS VISIBLE
    x1 = P3D(0).x: y1 = P3D(0).y: z1 = P3D(0).z
    x2 = P3D(1).x: y2 = P3D(1).y: z2 = P3D(1).z
    x3 = P3D(2).x: y3 = P3D(2).y: z3 = P3D(2).z
    t1 = -x1 * (y2 * z3 - y3 * z2)
    t2 = x2 * (y3 * z1 - y1 * z3)
    t3 = x3 * (y1 * z2 - y2 * z1)
    VISIBLE = t1 - t2 - t3
    If VISIBLE > 0 Then
      ' DRAW PLANE
      xx1 = P2D(0).x: yy1 = P2D(0).y
      xx2 = P2D(1).x: yy2 = P2D(1).y
      xx3 = P2D(2).x: yy3 = P2D(2).y
      xx4 = P2D(3).x: yy4 = P2D(3).y
      _MapTriangle (0, 0)-(0, PlaneSize%)-(PlaneSize%, PlaneSize%), P(plane%) To(xx3, yy3)-(xx2, yy2)-(xx1, yy1), , _Smooth
      _MapTriangle (0, 0)-(PlaneSize%, PlaneSize%)-(PlaneSize%, 0), P(plane%) To(xx3, yy3)-(xx1, yy1)-(xx4, yy4), , _Smooth
    End If
  Next plane%
End Sub

Sub createPlanes (P() As Long, PLANESIZE%)
  font& = _LoadFont(Environ$("SYSTEMROOT") + "\fonts\lucon.ttf", PLANESIZE%, "MONOSPACE, BOLD")
  For PLANE% = 0 To 5
    P(PLANE%) = _NewImage(PLANESIZE%, PLANESIZE%, 32)
    _Dest P(PLANE%): _Font font&
    Color QBcolor(8 + 6 - PLANE%), QBcolor(1 + PLANE%)
    Cls
    _PrintString (-PLANESIZE% * .4, PLANESIZE% * .09), Str$(PLANE%)
  Next PLANE%
End Sub

Sub createObject (O() As XYZtype, PLANESIZE%)
  Restore ObjectData
  For plane% = 0 To 5
    For pnt% = 0 To 3
      Read x, y, z
      O(plane%, pnt%).x = x * PLANESIZE% / 2: O(plane%, pnt%).y = y * PLANESIZE% / 2: O(plane%, pnt%).z = z * PLANESIZE% / 2
    Next pnt%
  Next plane%
  ObjectData:
  ' PLANE 0
  Data 1,-1,1
  Data -1,-1,1
  Data -1,1,1
  Data 1,1,1
  ' PLANE 1
  Data 1,-1,-1
  Data 1,-1,1
  Data 1,1,1
  Data 1,1,-1
  ' PLANE 2
  Data -1,-1,-1
  Data 1,-1,-1
  Data 1,1,-1
  Data -1,1,-1
  ' PLANE 3
  Data -1,-1,1
  Data -1,-1,-1
  Data -1,1,-1
  Data -1,1,1
  ' PLANE 4
  Data 1,1,1
  Data -1,1,1
  Data -1,1,-1
  Data 1,1,-1
  ' PLANE 5
  Data 1,-1,-1
  Data -1,-1,-1
  Data -1,-1,1
  Data 1,-1,1
End Sub

Function QBcolor& (qc%)
  Static q%, qbc&(256)
  If qc% >= q% Then
    tt& = _NewImage(1, 1, 0)
    For q% = 0 To 255
      qbc&(q%) = _PaletteColor(q%, tt&)
    Next q%
    _FreeImage tt&
  End If
  QBcolor& = qbc&(qc% Mod q%)
End Function

Sub fullScreen (size%)
  $If WIN Then
    Declare Library
      Function getMetrics& Alias GetSystemMetrics (ByVal n As Long)
    End Declare
    xwin% = getMetrics(16): ywin% = getMetrics(17): xborder% = getMetrics(5): yborder% = getMetrics(6): caption% = getMetrics(4)
  $Else
      xwin% = _DesktopWidth: ywin% = _DesktopHeight
  $End If
  Select Case size%
    Case 1 ' taskbar visible
      w% = xwin%: h% = ywin% + caption%: x% = xborder% + 2: y% = yborder% + caption% + 2
    Case 2 'taskbar and titlebar visible
      w% = xwin%: h% = ywin%: x% = xborder% + 2: y% = yborder% + 2
    Case Else 'default full screen
      w% = _DesktopWidth: h% = _DesktopHeight: x% = xborder% + 2: y% = yborder% + caption% + 2
  End Select
  Screen _NewImage(w%, h%, 32): Do: Loop Until _ScreenExists: _ScreenMove -x%, -y%
  _Source 0: _Dest 0
End Sub

If you remark the 3 'test' lines in mouseRotate that are setting fixed values to newP, newY and newR, you can run and drag mouse down from plane0 to plane4. If you then drag left/right you see it 'yaws' instead of 'rolls' from plane0 perspective