Depth Field

Category: Graphics - OpenGL

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc"
#Include "gl.inc"
#Include "glu.inc"
 
%ID_Timer = 1000
 
Global hDlg, hDC, hRC As DWord
Global H(), anglex, angley, anglez, scalefactor As Single
 
Function PBMain() As Long
   Dialog New Pixels, 0, "OpenGL Example",,, 320, 240,%WS_OverlappedWindow To hDlg
   Dialog Show Modal hdlg Call dlgproc
End Function
 
CallBack Function dlgproc()
   Local pt As Point
   Local XDelta, YDelta as Single
   Static SpinInWork,XLast,YLast As Long
 
   Select Case CB.Msg
      Case %WM_InitDialog : GetRenderContext
         InitializeScene
         ScaleFactor = 1
         BuildH
      Case %WM_Paint      : DrawScene 0,0,0  'redraw with no rotation
      Case %WM_Size       : ResizeScene Lo(Word, CB.lParam), Hi(Word, CB.lParam)
         DrawScene 0,0,0  'redraw with no rotation
      Case %WM_Close      : wglmakecurrent %null, %null 'unselect rendering context
         wgldeletecontext hRC        'delete the rendering context
         releasedc hDlg, hDC         'release device context
      Case %WM_MouseWheel
         Select Case Hi(Integer,CB.wParam)
            Case > 0  : ScaleFactor = ScaleFactor + 0.1 : DrawScene 0,0,0
            Case < 0  : ScaleFactor = ScaleFactor - 0.1 : DrawScene 0,0,0
         End Select
      Case %WM_SetCursor
         Select Case Hi(Word, CB.lParam)
            Case %WM_LButtonDown
               SpinInWork = 1
               GetCursorPos pt              'pt has xy screen coordinates
               ScreenToClient hDlg, pt       'pt now has dialog client coordinates
               XLast = Pt.x
               YLast = Pt.y
            Case %WM_MouseMove
               If SpinInWork Then
                  GetCursorPos pt           'pt has xy screen coordinates
                  ScreenToClient hDlg, pt    'pt now has dialog client coordinates
                  If pt.y < 0 Then Exit Select
                  XDelta = XLast - Pt.x
                  YDelta = YLast - Pt.y
                  DrawScene -YDelta, -XDelta, 0
                  XLast = pt.x
                  YLast = pt.y
               End If
            Case %WM_LButtonUp
               SpinInWork = 0
         End Select
   End Select
End Function
 
Sub GetRenderContext
   Local pfd As PIXELFORMATDESCRIPTOR   'pixel format properties for device context
   pfd.nSize       =  SizeOf(PIXELFORMATDESCRIPTOR)
   pfd.nVersion    =  1
   pfd.dwFlags     = %pfd_draw_to_window Or %pfd_support_opengl Or %pfd_doublebuffer
   pfd.dwlayermask = %pfd_main_plane
   pfd.iPixelType  = %pfd_type_rgba
   pfd.ccolorbits  = 24
   pfd.cdepthbits  = 24
 
   hDC = GetDC(hDlg)                                      'DC for dialog
   SetPixelFormat(hDC, ChoosePixelFormat(hDC, pfd), pfd)  'set properties of device context
   hRC = wglCreateContext (hDC)                           'get rendering context
   wglMakeCurrent hDC, hRC                                'make the RC current
End Sub
 
Sub InitializeScene
   glClearColor 0,0,0,0     'sets color to be used with glClear
   glClearDepth 1           'sets zvalue to be used with glClear
 
   glDepthFunc %gl_less                                'specify how depth-buffer comparisons are made
   glEnable %gl_depth_test                             'enable depth testing
   glShadeModel %gl_smooth                             'smooth shading
   glHint %gl_perspective_correction_hint, %gl_nicest  'best quality rendering
 
End Sub
 
Sub ResizeScene (w As Long, h As Long)
   glViewport 0, 0, w, h             'resize viewport to match window size
   glMatrixMode %gl_projection       'select the projection matrix
   glLoadIdentity                    'reset the projection matrix
   gluPerspective 45, w/h, 0.1, 100  'calculate the aspect ratio of the Window
   glMatrixMode %gl_modelview        'select the modelview matrix
End Sub
 
Sub DrawScene (dx As Single, dy As Single, dz As Single)
   Static anglex, angley, anglez As Single
 
   glClear %gl_color_buffer_bit Or %gl_depth_buffer_bit  'clear buffers
   glLoadIdentity               'clear the modelview matrix
 
   glTranslatef 0,0,-75
   glScalef scalefactor, scalefactor, scalefactor
   glRotatef -20, 1,0,0
 
   anglex = anglex + dx : glRotatef anglex, 1,0,0
   angley = angley + dy : glRotatef angley, 0,1,0
   anglez = anglez + dz : glRotatef anglez, 0,0,1
 
   DrawMap
 
   SwapBuffers hDC              'display the buffer (image)
End Sub
 
Sub BuildH
   Local i,j As Long
   ReDim H(50,50)
   Randomize Timer
   For i = 0 To 50
      For j = 0 To 50
         H(i,j) = Rnd(0,100)
      Next j
   Next i
End Sub
 
Sub DrawMap
   Local i,j,R,G,B As Single
   For i = 0 to 49
      glBegin %gl_triangle_strip
      For j = 0 To 50
         GradientZ H(i,j),100,0,R,G,B
         glColor3f     R, G, B
         glvertex3f    i-25, j-25, H(i,j)/35
 
         GradientZ H(i,j),100,0,R,G,B
         glColor3f     R, G, B
         glvertex3f  i+1-25, j-25, H(i+1,j)/35
      Next j
      glEnd
   Next i
End Sub
 
Function GradientZ(ZValue As Single, HiZ As Single, LoZ As Single, R as Single, G as Single, B as SingleAs Long
   'returns Long color, and RGB components, across the entire spectrum based on position of a number between two limits
   Local CRatio As Single, Exponent As Single
   Exponent = 0.365
   If HiZ <> LoZ Then
      CRatio = ABS((ZValue - LoZ) / (HiZ - LoZ))
   Else
      CRatio = 0
   End If
 
   If CRatio > 1 Then CRatio = 1
   If CRatio < 0 Then CRatio = 0
 
   Select Case CRatio
      Case Is < 0.25
         r = 0
         g = 255 * (((CRatio - 0) * 4) ^ Exponent)
         b = 255
      Case Is < 0.5
         r = 0
         g = 255
         b = 255 * ((1 - (CRatio - 0.25) * 4) ^ Exponent)
      Case Is < 0.75
         r = 255 * (((CRatio - 0.5) * 4) ^ Exponent)
         g = 255
         b = 0
      Case Else
         r = 255
         g = 255 * ((1 - (CRatio - 0.75) * 4) ^ Exponent)
         b = 0
 
   End Select
   Function = Rgb(r, g, b)
End Function
 
'gbs_00599
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm