voxel_dx.frm

Deleta Force 引擎的雏形

    
    'ShowCursor 0
    ' Create the DirectDraw object
    DirectDrawCreate ByVal 0&, dd, Nothing
    ' This app is full screen and will change the display mode
    dd.SetCooperativeLevel Me.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX
    ' Set the display mode
    dd.SetDisplayMode ResolutionX, ResolutionY, 8, 0, 0
        
    'load bitmaps
    Picture1.Picture = LoadPicture(App.Path & "\texture.gif")
    Picture2.Picture = LoadPicture(App.Path & "\height.gif")
       
    ' Fill front buffer description structure...
    With ddsdFront
        ' Structure size
        .dwSize = Len(ddsdFront)
        ' Use DDSD_CAPS and BackBufferCount
        .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
        ' Primary, flipable surface
        .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
        ' One back buffer (you can try 2)
        .dwBackBufferCount = 1
    End With
    ' Create front buffer
    dd.CreateSurface ddsdFront, ddsFront, Nothing
        
    ' Retrieve the back buffer object
    ddCaps.dwCaps = DDSCAPS_BACKBUFFER
    ddsFront.GetAttachedSurface ddCaps, ddsBack
    
    'Read palette from .PAL file
    'p.s. most paint programs import and export RIFF
    'palettes in this format
    Open App.Path & "\voxel.pal" For Random As 1 Len = 1
    For a% = 0 To 255
        Get #1, (a% * 4) + 25, gpals(a%).peRed
        Get #1, (a% * 4) + 26, gpals(a%).peGreen
        Get #1, (a% * 4) + 27, gpals(a%).peBlue
    Next
    Close
    
    'set palette
    dd.CreatePalette DDPCAPS_8BIT, gpals(0), lpDDpalette, Nothing
    ddsFront.SetPalette lpDDpalette
            
    b1.Top = 0: b1.Left = 0
    b1.Right = 319: b1.Bottom = 239
   
    'Render loop
    While Not blnend
        u& = GetCursorPos(ps)
        'reposition based on mouse
        vp_x = vp_x - (ps.x - 160) / 10
        vp_y = vp_y - (ps.y - 120) / 10
        
        DRAWNEXTFRAME
        u = DoEvents
    Wend
    
    'clean up
    
 '   Set pDDs = Nothing
    
    dd.FlipToGDISurface
    dd.RestoreDisplayMode
    dd.SetCooperativeLevel 0, DDSCL_NORMAL
    Set ddsBack = Nothing
    Set lpDDpalette = Nothing
    Set ddsFront = Nothing
    Set dd = Nothing
    'ShowCursor 1
    
    Unload Voxel_dx

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
blnend = True
End Sub




Sub DRAWNEXTFRAME()
         
    ' these are used to address the pixel using matrices
    'dim pos As Integer
    
    ddsd.dwFlags = DDSD_ALL
    ddsd.dwSize = Len(ddsd)
    
    ' get bitmap info
    ddsBack.GetSurfaceDesc ddsd
    b1.Top = 0: b1.Left = 0
    b1.Right = ddsd.dwWidth
    b1.Bottom = ddsd.dwHeight
    GetObjectAPI Picture1.Picture, Len(bmp1), bmp1 'texture
    GetObjectAPI Picture2.Picture, Len(bmp2), bmp2 'height map

    'lock
    ddsBack.Lock b1, ddsd, DDLOCK_WAIT, ByVal 0&
    
    ' have the local matrix point to DDSBack
    With sa
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = ddsd.dwHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = ddsd.dwWidth
        .pvData = ddsd.lpSurface
    End With
    CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4

    ' have the local matrix point to texture
    With sa2
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmp1.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = bmp1.bmWidthBytes
        .pvData = bmp1.bmBits
    End With
    CopyMemory ByVal VarPtrArray(pict2), VarPtr(sa2), 4

    ' have the local matrix point to height map
    With sa3
        .cbElements = 1
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = bmp2.bmHeight
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = bmp2.bmWidthBytes
        .pvData = bmp2.bmBits
    End With
    CopyMemory ByVal VarPtrArray(pict3), VarPtr(sa3), 4

    '***********************************
    ' Here is where we draw a frame
    '***********************************
    For c = 0 To 319
        For r = 0 To 239
            pict(c, r) = 0
        Next
    Next
    
    '**********************************************************
    'Thanks to Andre' LaMothe for the C source code this Voxel
    'demonstration is based on.  David Brebner 24/1/98
    '**********************************************************
    
    For c = 0 To SCREEN_WIDTH 'cast a ray for each column of the screen
        ' seed starting point for cast
        x_ray = vp_x
        y_ray = vp_y
        z_ray = vp_z
    
        ' compute deltas to project ray at, note the spherical cancelation factor
        dx = Cos((raycast_ang + c) / 360)
        dy = Sin((raycast_ang + c) / 360)
        
        ' dz is a bit complex, remember dz is the slope of the ray we are casting
        ' therefore, we need to take into consideration the down angle, or
        ' x axis angle, the more we are looking down the larger the intial dz
        ' must be
        dz = dslope * -100
        
        ' reset current voxel scale
        curr_voxel_scale = 0
    
        ' reset row
        curr_row = 239
        
        
        For curr_step = 0 To MAX_STEPS ' enter into casting loop
            xr = x_ray And 511 'trim
            yr = y_ray And 511 'trim
            ' get current height in height map
            ' and the added multiplication factor used to scale the mountains
            column_height = pict3(xr, yr) * 2
            
            'test if column height is greater than current voxel height for current step
            'from intial projection point
            If column_height > z_ray Then
                ' we know that we have intersected a voxel column, therefore we must
                ' render it until we have drawn enough pixels on the display such that
                ' thier projection would be correct for the height of this voxel column
                ' or until we have reached the top of the screen
    
                ' get the color for the voxel
                color = pict2(xr, yr)
    
                ' draw vertical column voxel
                Do
                    ' draw a pixel
                    pict(c, curr_row) = color
    
                    ' now we need to push the ray upward on z axis, so increment the slope
                    dz = dz + dslope
    
                    ' now translate the current z position of the ray by the current voxel
                    ' scale per unit
                    z_ray = z_ray + curr_voxel_scale
                    
                    ' test if we are done with column
                    curr_row = curr_row - 1
                    If (curr_row <= 0) Then
                        ' force exit of outer steping loop
                        curr_step = MAX_STEPS
                        Exit Do
                    End If
                    
                Loop Until z_ray > column_height
            End If
            ' update the position of the ray
            x_ray = x_ray + dx
            y_ray = y_ray + dy
            z_ray = z_ray + dz
    
            ' update the current voxel scale, remember each step out means the scale increases
            ' by the delta scale
            curr_voxel_scale = curr_voxel_scale + dslope * 0.5
    
        Next
        
    
    Next


    ' clear the temporary array descriptor
    ' without destroying the local temporary array
    CopyMemory ByVal VarPtrArray(pict), 0&, 4
    CopyMemory ByVal VarPtrArray(pict2), 0&, 4
    CopyMemory ByVal VarPtrArray(pict3), 0&, 4

    ddsBack.Unlock ByVal 0&
    
    ' Flip the buffers
    Do
        ddsFront.Flip Nothing, 0
        If Err.Number = DDERR_SURFACELOST Then ddsFront.Restore
    Loop Until Err.Number = 0
End Sub

Private Sub Form_Load()
'set up the default starting positions
vp_z = 500: vp_x = 200: vp_y = 200
dslope = 0.05
raycast_ang = 100

End Sub