Learn 3D Graphics Programming on the PC/Learn_3D_Graphics_Programming_on_the_PC_Ferraro.iso/rwwin/rwvbview.fr_/rwvbview.bin

Text File | 1995-11-14 | 15KB | 448 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "RenderWare VB Object Viewer"
   ClientHeight    =   3648
   ClientLeft      =   876
   ClientTop       =   1464
   ClientWidth     =   4104
   Height          =   4200
   Icon            =   RWVBVIEW.FRX:0000
   Left            =   828
   LinkTopic       =   "Form1"
   ScaleHeight     =   3648
   ScaleWidth      =   4104
   Top             =   960
   Width           =   4200
   Begin Timer tmrAnimate
      Interval        =   20
      Left            =   720
      Top             =   120
   End
   Begin CommonDialog OpenFileDlg
      DialogTitle     =   "Load Script or Picture into Scene"
      Filter          =   "Script file (*.rwx) | *.rwx | Picture file (*.ras;*.bmp) | *.ras;*.bmp"
      Left            =   120
      Top             =   120
   End
   Begin Menu File
      Caption         =   "&File"
      Begin Menu Open
         Caption         =   "&Open..."
      End
      Begin Menu Exit
         Caption         =   "E&xit"
      End
   End
   Begin Menu Help
      Caption         =   "&Help"
      Begin Menu About
         Caption         =   "&About"
      End
   End
End
Const SHIFT_MASK = 1
Const CTRL_MASK = 2
Const ALT_MASK = 4

Const LEFT_BUTTON = 1
Const RIGHT_BUTTON = 2
Const MIDDLE_BUTTON = 4

Dim Scene As Long

Dim Camera As Long
Dim CameraTilt As Single
Dim CameraDistance As Single

Dim Light As Long

Dim SpinMatrix As Long

Dim LastX As Integer
Dim LastY As Integer

Dim AnimMode As Integer
Dim FrameNumber As Integer

Const ANoAction = 0
Const ASpinClump = 1

Dim PickedClump As Long
Dim MouseMoveMode As Integer

Const MMNoAction = 0
Const MMDragClump = 1
Const MMDragClumpInZ = 2
Const MMPanLight = 3
Const MMPanAndZoomCamera = 4
Const MMScrollBackdrop = 5
Const MMSpinClump = 6
Const MMTiltCamera = 7

Sub About_Click ()
    frmAbout.Show 1
End Sub

Sub Exit_Click ()
    Unload Me
End Sub

Sub Form_Load ()
    Dim VRet As Variant

    CameraTilt = 0
    CameraDistance = -7
    FrameNumber = 0

    If RwOpen("MSWindows", 0) = 0 Then
        If RwGetError() = E_RW_NOMEM Then
            MsgBox "Insufficient memory to open the RenderWare(tm) library", MB_OK
        Else
            MsgBox "Error opening the RenderWare(tm) library", MB_OK
        End If
        End
    End If

    Camera = RwCreateCamera(1024, 768, 0)
    If Camera = 0 Then
        If RwGetError() = E_RW_NOMEM Then
            MsgBox "Insufficient memory to create the RenderWare(tm) camera", MB_OK
        Else
            MsgBox "Error creating the RenderWare(tm) camera", MB_OK
        End If
        RwClose
        End
    End If

    VRet = RwSetCameraBackColor(Camera, 0, 0, 1)

    VRet = RwTiltCamera(Camera, CameraTilt)
    VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)

    VRet = RwSetCameraViewwindow(Camera, .2, .2)

    Scene = RwCreateScene()
    If Scene = 0 Then
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) scene", MB_OK
        End
    End If

    Light = RwCreateLight(rwDIRECTIONAL, -1, -1, -1, 1)
    If Light = 0 Then
        VRet = RwDestroyScene(Scene)
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) light", MB_OK
        End
    End If

    VRet = RwAddLightToScene(Scene, Light)

    SpinMatrix = RwCreateMatrix()
    If SpinMatrix = 0 Then
        VRet = RwDestroyScene(Scene)
        VRet = RwDestroyCamera(Camera)
        RwClose
        MsgBox "Error creating the RenderWare(tm) matrix", MB_OK
        End
    End If
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Pick As RwPickRecord
    Dim VRet As Variant

    x = x / Screen.TwipsPerPixelX
    y = y / Screen.TwipsPerPixelY
    If (Button And LEFT_BUTTON) <> 0 Then
        If RwPickScene(Scene, x, y, Camera, Pick) <> 0 Then
            Select Case Pick.type
            Case rwNAPICKOBJECT
                AnimMode = ANoAction
                PickedClump = 0

                If RwGetCameraBackdrop(Camera) <> 0 Then
                    If (Shift And (SHIFT_MASK Or CTRL_MASK)) = (SHIFT_MASK Or CTRL_MASK) Then
                        VRet = RwDestroyRaster(RwGetCameraBackdrop(Camera))
                        VRet = RwSetCameraBackdrop(Camera, 0)
                        RenderScene hWnd, hDC
                        MouseMoveMode = MMNoAction
                    Else
                        MouseMoveMode = MMScrollBackdrop
                    End If
                Else
                    MouseMoveMode = MMNoAction
                End If

            Case rwPICKEDCLUMP
                If (Shift And (SHIFT_MASK Or CTRL_MASK)) = (SHIFT_MASK Or CTRL_MASK) Then
                    VRet = RwDestroyClump(Pick.Object.clump.clump)
                    RenderScene hWnd, hDC
                    MouseMoveMode = MMNoAction
                    PickedClump = 0
                Else
                    PickedClump = Pick.Object.clump.clump
                    If (Shift And SHIFT_MASK) <> 0 Then
                        MouseMoveMode = MMDragClump
                    ElseIf (Shift And CTRL_MASK) <> 0 Then
                        MouseMoveMode = MMDragClumpInZ
                    Else
                        MouseMoveMode = MMSpinClump
                    End If
                End If
            End Select
        End If
    ElseIf (Button And RIGHT_BUTTON) <> 0 Then
        If (Shift And CTRL_MASK) <> 0 Then
            MouseMoveMode = MMPanLight
        ElseIf (Shift And SHIFT_MASK) <> 0 Then
            MouseMoveMode = MMTiltCamera
        Else
            MouseMoveMode = MMPanAndZoomCamera
        End If
    End If
    If MouseMoveMode <> MMNoAction Then
        LastX = x
        LastY = y
    End If
End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Parent As Long
    Dim tmpMatrix As Long
    Dim worldToLocal As Long
    Dim Up As RwV3d
    Dim Rght As RwV3d
    Dim At As RwV3d
    Dim xDelta As Single
    Dim yDelta As Single
    Dim xAngle As Single
    Dim yAngle As Single
    Dim ZoomDelta As Single
    Dim xOffset As Long
    Dim yOffset As Long
    Dim VRet As Variant

    x = x / Screen.TwipsPerPixelX
    y = y / Screen.TwipsPerPixelY
    Select Case MouseMoveMode
    Case MMScrollBackdrop
        VRet = RwGetCameraBackdropOffset(Camera, xOffset, yOffset)
        xOffset = xOffset + LastX - x
        yOffset = yOffset + LastY - y
        VRet = RwSetCameraBackdropOffset(Camera, xOffset, yOffset)

    Case MMPanAndZoomCamera
        VRet = RwVCMoveCamera(Camera, 0, 0, -CameraDistance)
        VRet = RwTiltCamera(Camera, -CameraTilt)
        VRet = RwPanCamera(Camera, LastX - x)
        CameraDistance = CameraDistance + (LastY - y) / 10
        VRet = RwTiltCamera(Camera, CameraTilt)
        VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)

    Case MMTiltCamera
        VRet = RwVCMoveCamera(Camera, 0, 0, -CameraDistance)
        VRet = RwTiltCamera(Camera, -CameraTilt)
        CameraTilt = CameraTilt + LastY - y
        VRet = RwTiltCamera(Camera, CameraTilt)
        VRet = RwVCMoveCamera(Camera, 0, 0, CameraDistance)

    Case MMSpinClump
        yAngle = x - LastX
        xAngle = y - LastY
        VRet = RwGetCameraLookUp(Camera, Up)
        VRet = RwGetCameraLookRight(Camera, Rght)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(Up, worldToLocal)
            VRet = RwNormalize(Up)
            VRet = RwTransformVector(Rght, worldToLocal)
            VRet = RwNormalize(Rght)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwRotateMatrix(SpinMatrix, Up.x, Up.y, Up.z, yAngle, rwREPLACE)
        VRet = RwRotateMatrix(SpinMatrix, Rght.x, Rght.y, Rght.z, xAngle, rwPOSTCONCAT)
        VRet = RwTransformClumpJoint(PickedClump, SpinMatrix, rwPOSTCONCAT)
        AnimMode = ASpinClump

    Case MMDragClump
        VRet = RwPushScratchMatrix()
        xDelta = (x - LastX) / 50
        yDelta = (LastY - y) / 50
        VRet = RwGetCameraLookRight(Camera, Rght)
        VRet = RwGetCameraLookUp(Camera, Up)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(Up, worldToLocal)
            VRet = RwNormalize(Up)
            VRet = RwTransformVector(Rght, worldToLocal)
            VRet = RwNormalize(Rght)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwTranslateMatrix(RwScratchMatrix(), Rght.x * xDelta, Rght.y * xDelta, Rght.z * xDelta, rwREPLACE)
        VRet = RwTranslateMatrix(RwScratchMatrix(), Up.x * yDelta, Up.y * yDelta, Up.z * yDelta, rwPOSTCONCAT)
        VRet = RwTransformClump(PickedClump, RwScratchMatrix(), rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()

    Case MMDragClumpInZ
        VRet = RwPushScratchMatrix()
        yDelta = (LastY - y) / 50
        VRet = RwGetCameraLookAt(Camera, At)
        Parent = RwGetClumpParent(PickedClump)
        If Parent <> 0 Then
            tmpMatrix = RwPushScratchMatrix()
            worldToLocal = RwPushScratchMatrix()
            VRet = RwGetClumpLTM(Parent, tmpMatrix)
            VRet = RwInvertMatrix(tmpMatrix, worldToLocal)
            VRet = RwTransformVector(At, worldToLocal)
            VRet = RwNormalize(At)
            VRet = RwPopScratchMatrix()
            VRet = RwPopScratchMatrix()
        End If
        VRet = RwTranslateMatrix(RwScratchMatrix(), At.x * yDelta, At.y * yDelta, At.z * yDelta, rwREPLACE)
        VRet = RwTransformClump(PickedClump, RwScratchMatrix(), rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()

    Case MMPanLight
        Dim scratch As Long

        VRet = RwPushScratchMatrix()
        scratch = RwScratchMatrix()
        VRet = RwRotateMatrix(scratch, 0, 1, 0, LastX - x, rwREPLACE)
        VRet = RwRotateMatrix(scratch, 1, 0, 0, LastY - y, rwPOSTCONCAT)
        VRet = RwTransformLight(Light, scratch, rwPOSTCONCAT)
        VRet = RwPopScratchMatrix()
    End Select

    If MouseMoveMode <> MMNoAction Then
        RenderScene hWnd, hDC
        LastX = x
        LastY = y
    End If
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    MouseMoveMode = MMNoAction
End Sub

Sub Form_Paint ()
    Dim VRet As Variant

    VRet = RwInvalidateCameraViewport(Camera)
    VRet = RwShowCameraImage(Camera, hDC)
End Sub

Sub Form_Resize ()
    Dim VRet As Variant
    Dim IRet As Integer
    Dim ScreenWidth As Integer
    Dim ScreenHeight As Integer

    ScreenWidth = Width / Screen.TwipsPerPixelX
    ScreenHeight = Height / Screen.TwipsPerPixelY
    VRet = RwSetCameraViewport(Camera, 0, 0, ScreenWidth, ScreenHeight)
    VRet = RwSetCameraBackdropViewportRect(Camera, 0, 0, ScreenWidth, ScreenHeight)
    RenderScene hWnd, hDC
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim VRet As Variant
    Dim Raster As Long

    VRet = RwDestroyMatrix(SpinMatrix)
    VRet = RwDestroyScene(Scene)
    Raster = RwGetCameraBackdrop(Camera)
    If Raster Then
        VRet = RwDestroyRaster(Raster)
        VRet = RwSetCameraBackdrop(Camera, 0)
    End If
    VRet = RwDestroyCamera(Camera)
    RwClose
End Sub

Sub Open_Click ()
    Dim clump As Long
    Dim Raster As Long
    Dim Extension As String
    Dim Filename As String
    Dim VRet As Long

    OpenFileDlg.Action = 1
    Filename = OpenFileDlg.Filename
    Extension = Right$(Filename, Len(Filename) - InStr(Filename, "."))
    If Extension = "BMP" Or Extension = "RAS" Then
        Raster = RwReadRaster(Filename, rwGAMMARASTER Or rwDITHERRASTER)
        If Raster <> 0 Then
            If RwGetCameraBackdrop(Camera) <> 0 Then
                VRet = RwDestroyRaster(RwGetCameraBackdrop(Camera))
            End If
            VRet = RwSetCameraBackdrop(Camera, Raster)
            VRet = RwSetCameraBackdropOffset(Camera, 0, 0)
            RenderScene hWnd, hDC
        Else
            ReportFileError Filename
        End If
    ElseIf Extension = "RWX" Then
        clump = RwReadShape(Filename)
        If clump <> 0 Then
            VRet = RwAddClumpToScene(Scene, clump)
            RenderScene hWnd, hDC
        Else
            ReportFileError Filename
        End If
    End If
End Sub

Sub RenderScene (ByVal hWnd As Integer, ByVal hDC As Integer)
    Dim VRet As Long

    VRet = RwBeginCameraUpdate(Camera, hWnd)
    VRet = RwClearCameraViewport(Camera)
    VRet = RwRenderScene(Scene)
    VRet = RwEndCameraUpdate(Camera)
    VRet = RwShowCameraImage(Camera, hDC)
End Sub

Sub ReportFileError (Filename As String)
    Select Case RwGetError()
    Case E_RW_NOMEM
        MsgBox "Insufficient memory to load file " + Filename, MB_OK
    Case Else
        MsgBox "Error reading file " + Filename, MB_OK
    End Select
End Sub

Sub tmrAnimate_Timer ()
    Dim VRet As Variant

    If PickedClump <> 0 And AnimMode <> ANoAction And MouseMoveMode <> MMSpinClump Then
        Select Case AnimMode
        Case ASpinClump:
            VRet = RwTransformClumpJoint(PickedClump, SpinMatrix, rwPOSTCONCAT)
            FrameNumber = FrameNumber + 1
            If FrameNumber >= 128 Then
                FrameNumber = 0
                VRet = RwPushScratchMatrix()
                VRet = RwGetClumpJointMatrix(PickedClump, RwScratchMatrix())
                VRet = RwOrthoNormalizeMatrix(RwScratchMatrix(), RwScratchMatrix())
                VRet = RwTransformClumpJoint(PickedClump, RwScratchMatrix(), rwREPLACE)
                VRet = RwPopScratchMatrix()
            End If
            RenderScene hWnd, hDC
        End Select
    End If
End Sub