home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Post-Proce2075897172007.psc / mdlMain.bas < prev    next >
BASIC Source File  |  2007-07-18  |  8KB  |  320 lines
  1. Attribute VB_Name = "mdlMain"
  2.  
  3. Option Explicit
  4.  
  5.  
  6. Public Const Pi As Single = 3.14159265358979
  7.  
  8. Public confDevice As D3DPRESENT_PARAMETERS
  9.  
  10. Private objDX As DirectX8
  11. Private objD3D As Direct3D8
  12.  
  13. Public objD3DDev As Direct3DDevice8
  14. Public objD3Dhlp As D3DX8
  15.  
  16. Private txHelp As Direct3DTexture8
  17.  
  18. Private mhWalls As clsMesh
  19. Private txWalls As Direct3DTexture8
  20.  
  21. Private mhStatue As clsMesh
  22. Private txStatue As Direct3DTexture8
  23.  
  24. Public camAlpha As Single
  25. Public camBeta As Single
  26. Public camDistance As Single
  27. Public camShift As Single
  28.  
  29. Public psTextureFade As Long
  30.  
  31. Private rtOriginalImage As clsRenderTarget
  32. Private rtAccumulator As clsRenderTarget
  33. Private rtTemp As clsRenderTarget
  34.  
  35. Public ppScreenQuad As clsPostProcessing
  36. Private ppHelpRect As clsPostProcessing
  37.  
  38. Public effFilter As Long
  39. Public effMotion As Long
  40. Public effUV As Long
  41.  
  42. Public shwHelp As Long
  43. Public shwWalls As Long
  44.  
  45. Public Sub Initialize()
  46.  
  47.   On Error Resume Next
  48.  
  49.   Set objDX = New DirectX8
  50.   Set objD3D = objDX.Direct3DCreate
  51.   Set objD3Dhlp = New D3DX8
  52.   
  53.   Static confDisplay As D3DDISPLAYMODE
  54.   objD3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, confDisplay
  55.   
  56.   With confDevice
  57.     .AutoDepthStencilFormat = D3DFMT_D24S8
  58.     .BackBufferCount = 1
  59.     .BackBufferFormat = confDisplay.Format
  60.     .BackBufferHeight = wndRender.ScaleHeight
  61.     .BackBufferWidth = wndRender.ScaleWidth
  62.     .EnableAutoDepthStencil = 1
  63.     .flags = 0
  64.     .FullScreen_PresentationInterval = 0
  65.     .FullScreen_RefreshRateInHz = 0
  66.     .hDeviceWindow = wndRender.hWnd
  67.     .MultiSampleType = D3DMULTISAMPLE_NONE
  68.     .SwapEffect = D3DSWAPEFFECT_DISCARD
  69.     .Windowed = 1
  70.   End With
  71.  
  72.   Set objD3DDev = objD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, confDevice.hDeviceWindow, D3DCREATE_HARDWARE_VERTEXPROCESSING, confDevice)
  73.   If Not Err.Number = 0 Then
  74.     Err.Clear
  75.     MsgBox "Failed to create Direct3DDevice8. Application will now quit.", vbCritical Or vbOKOnly, "Error"
  76.     Shutdown
  77.   End If
  78.  
  79.   
  80.   camDistance = 150
  81.   camAlpha = 35 * Pi / 180
  82.   camBeta = 15 * Pi / 180
  83.   camShift = 50
  84.   
  85.   
  86.   effFilter = 1
  87.   effMotion = 1
  88.   effUV = 1
  89.   
  90.   shwHelp = 1
  91.   shwWalls = 1
  92.   
  93.   
  94.   psTextureFade = shCompile(App.Path & "\psh_TextureFade_ps.1.1.txt")
  95.  
  96.  
  97.   Set txHelp = txLoad(App.Path & "\texHelp.png")
  98.   Set txWalls = txLoad(App.Path & "\texWalls.png")
  99.   Set txStatue = txLoad(App.Path & "\texStatue.png")
  100.  
  101.  
  102.   Set mhWalls = New clsMesh
  103.   If Not mhWalls.objLoad(App.Path & "\objWalls.obj") Then
  104.     mhWalls.memClear
  105.     MsgBox "Failed to load mesh file: '" & App.Path & "\objWalls.obj" & "'.", vbCritical Or vbOKOnly, "Error"
  106.   End If
  107.  
  108.   Set mhStatue = New clsMesh
  109.   If Not mhStatue.objLoad(App.Path & "\objStatue.obj") Then
  110.     mhStatue.memClear
  111.     MsgBox "Failed to load mesh file: '" & App.Path & "\objStatue.obj" & "'.", vbCritical Or vbOKOnly, "Error"
  112.   End If
  113.  
  114.  
  115.   Set rtOriginalImage = New clsRenderTarget
  116.   rtOriginalImage.rtAquire
  117.   rtOriginalImage.rtCreate confDevice.BackBufferWidth, confDevice.BackBufferHeight
  118.   
  119.   Set rtAccumulator = New clsRenderTarget
  120.   rtAccumulator.rtAquire
  121.   rtAccumulator.rtCreate confDevice.BackBufferWidth, confDevice.BackBufferWidth
  122.  
  123.   Set rtTemp = New clsRenderTarget
  124.   rtTemp.rtAquire
  125.   rtTemp.rtCreate confDevice.BackBufferWidth, confDevice.BackBufferWidth
  126.  
  127.  
  128.   Set ppHelpRect = New clsPostProcessing
  129.   
  130.   Set ppScreenQuad = New clsPostProcessing
  131.   ppScreenQuad.objCreate5Tap confDevice.BackBufferWidth, confDevice.BackBufferWidth
  132.  
  133. End Sub
  134.  
  135.  
  136. Public Sub Render()
  137.  
  138.   On Error Resume Next
  139.  
  140.   With objD3DDev
  141.     
  142.     
  143.     If effMotion = 1 Then
  144.       
  145.       'pass0: render scene into RT texture
  146.       rtOriginalImage.rtEnable True
  147.     
  148.     End If
  149.     
  150.     
  151.     .Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, &HFF3F3F3F, 1, 0
  152.     .BeginScene
  153.     
  154.     
  155.     Static camX As Single
  156.     Static camY As Single
  157.     Static camZ As Single
  158.     camX = Sin(camAlpha) * Cos(camBeta) * camDistance
  159.     camY = Sin(camBeta) * camDistance
  160.     camZ = Cos(camAlpha) * Cos(camBeta) * camDistance
  161.     
  162.     
  163.     Static matView As D3DMATRIX
  164.     D3DXMatrixLookAtLH matView, mkVec3f(camX, camY + camShift, camZ), mkVec3f(0, 0 + camShift, 0), mkVec3f(0, 1, 0)
  165.     .SetTransform D3DTS_VIEW, matView
  166.     
  167.     Static matProjection As D3DMATRIX
  168.     D3DXMatrixPerspectiveFovLH matProjection, 1, confDevice.BackBufferHeight / confDevice.BackBufferWidth, 1, 100000
  169.     .SetTransform D3DTS_PROJECTION, matProjection
  170.   
  171.     
  172.     
  173.     Static iMap As Long
  174.     For iMap = 0 To 1 Step 1
  175.       .SetTextureStageState iMap, D3DTSS_TEXCOORDINDEX, iMap
  176.       If effFilter = 1 Then
  177.         .SetTextureStageState iMap, D3DTSS_MAXANISOTROPY, 16
  178.         .SetTextureStageState iMap, D3DTSS_MAGFILTER, D3DTEXF_ANISOTROPIC
  179.         .SetTextureStageState iMap, D3DTSS_MINFILTER, D3DTEXF_ANISOTROPIC
  180.         .SetTextureStageState iMap, D3DTSS_MIPFILTER, D3DTEXF_ANISOTROPIC
  181.       Else
  182.         .SetTextureStageState iMap, D3DTSS_MAGFILTER, D3DTEXF_POINT
  183.         .SetTextureStageState iMap, D3DTSS_MINFILTER, D3DTEXF_POINT
  184.         .SetTextureStageState iMap, D3DTSS_MIPFILTER, D3DTEXF_POINT
  185.       End If
  186.       .SetTextureStageState iMap, D3DTSS_ADDRESSU, D3DTADDRESS_CLAMP
  187.       .SetTextureStageState iMap, D3DTSS_ADDRESSV, D3DTADDRESS_CLAMP
  188.     Next iMap
  189.     
  190.     
  191.     .SetRenderState D3DRS_LIGHTING, 0
  192.     .SetRenderState D3DRS_CULLMODE, D3DCULL_CCW
  193.     
  194.     .SetPixelShader 0
  195.   
  196.   
  197.     If shwWalls = 1 Then
  198.       .SetTexture 0, txWalls
  199.       If Not mhWalls.objRender Then
  200.         MsgBox "Error rendering 'Walls' mesh. Application will now quit.", vbCritical Or vbOKOnly, "Error"
  201.         Shutdown
  202.       End If
  203.     End If
  204.   
  205.     .SetTexture 0, txStatue
  206.     If Not mhStatue.objRender Then
  207.       MsgBox "Error rendering 'Statue' mesh. Application will now quit.", vbCritical Or vbOKOnly, "Error"
  208.       Shutdown
  209.     End If
  210.   
  211.     
  212.       
  213.     If shwHelp = 1 Then
  214.       ppHelpRect.memClear
  215.       ppHelpRect.objCreateUser 0.3, -0.5, 1, -1
  216.       .SetPixelShader 0
  217.       .SetTexture 0, txHelp
  218.       .SetRenderState D3DRS_ALPHABLENDENABLE, 1
  219.       .SetRenderState D3DRS_SRCBLEND, 1
  220.       .SetRenderState D3DRS_DESTBLEND, 3
  221.       ppHelpRect.objRender
  222.       .SetRenderState D3DRS_ALPHABLENDENABLE, 0
  223.     End If
  224.   
  225.     .EndScene
  226.     
  227.     
  228.     
  229.     If effMotion = 1 Then
  230.     
  231.       rtOriginalImage.rtEnable False
  232.       
  233.       'pass1: add rendered scene to accumulator using pixel shader (render to temp RT texture)
  234.       rtTemp.rtEnable True
  235.         .SetTexture 0, rtOriginalImage.objTexture
  236.         .SetTexture 1, rtAccumulator.objTexture
  237.         .SetPixelShader psTextureFade
  238.         ppScreenQuad.objRender
  239.         .SetTexture 1, Nothing
  240.       rtTemp.rtEnable False
  241.       
  242.       rtAccumulator.rtEnable True
  243.         .SetTexture 0, rtTemp.objTexture
  244.         .SetPixelShader 0
  245.         ppScreenQuad.objRender
  246.       rtAccumulator.rtEnable False
  247.       
  248.       
  249.       'pass2: show the accumulator
  250.       .SetTexture 0, rtAccumulator.objTexture
  251.       ppScreenQuad.objRender
  252.     
  253.     End If
  254.     
  255.     
  256.     
  257.     .SetTexture 0, Nothing
  258.     
  259.     
  260.     If Not .TestCooperativeLevel = 0 Then
  261.       MsgBox "Cooperative level lost. Application will now quit.", vbCritical Or vbOKOnly, "Error"
  262.       Shutdown
  263.     Else
  264.       .Present ByVal 0, ByVal 0, 0, ByVal 0
  265.     End If
  266.   End With
  267.  
  268.  
  269.   If Not Err.Number = 0 Then
  270.     Err.Clear
  271.     MsgBox "Unexpected error occured in rendering pipeline. Application will now quit.", vbCritical Or vbOKOnly, "Error"
  272.     Shutdown
  273.   End If
  274.  
  275.  
  276. End Sub
  277.  
  278.  
  279. Public Sub Shutdown()
  280.  
  281.   On Error Resume Next
  282.  
  283.   Set txHelp = Nothing
  284.  
  285.   ppScreenQuad.memClear
  286.   Set ppScreenQuad = Nothing
  287.  
  288.   ppHelpRect.memClear
  289.   Set ppHelpRect = Nothing
  290.  
  291.   rtOriginalImage.rtDestroy True
  292.   rtTemp.rtDestroy True
  293.   rtAccumulator.rtDestroy True
  294.   
  295.   Set rtTemp = Nothing
  296.   Set rtAccumulator = Nothing
  297.   Set rtOriginalImage = Nothing
  298.  
  299.   Set txWalls = Nothing
  300.  
  301.   mhWalls.memClear
  302.   Set mhWalls = Nothing
  303.  
  304.   Set txStatue = Nothing
  305.  
  306.   mhStatue.memClear
  307.   Set mhStatue = Nothing
  308.   
  309.   objD3DDev.DeletePixelShader psTextureFade
  310.  
  311.   Set objD3DDev = Nothing
  312.   Set objD3D = Nothing
  313.   Set objDX = Nothing
  314.   
  315.   If Not Err.Number = 0 Then Err.Clear
  316.   End
  317.  
  318. End Sub
  319.  
  320.