



  'OPENGL /WINDOWS API Example


' Revised 15:21 04/10/2013
' Charles Pegge
  '#case capital
  '#compact
  $ filename "t.exe"
  includepath "$/inc/"
  'include "RTL32.inc"
  'include "RTL64.inc"
  include "minwin.inc"
  include "Ogl.inc"
  '
  /*

  Window size wWidth wHeight
  Active view:
    0 = none
    1 = upper left
    2 = upper right
    3 = lower left
    4 = lower right

  */
   
  dim as sys a
  dim gmf(256) as GLYPHMETRICSFLOAT

  dim as quad
    '
    'TIMING
    '
    grtic1,grtic2,freq
    
  dim as double
    '
    'TIMING
    '
    fps,grlap
  
  dim as sys
    '
    'STATE VARIABLES
    '
    refresh,bselect,kselect,keyd,cha,ReqShutDown,
    bLeft,bMid,bRight,bWheel,
    wWidth,wHeight,
    '
    'GL CONTEXT
    '
    hDC,hRC,
    '
    shadows,shadowable,
    antialias, multisampling,
    nPixelFormat,ReqNewMode,arbMultisampleFormat,
    arbMultisampleSupported,
    '
    'TIMING
    '
    timerval, doredraw,
    '
    'POSITIONAL
    '
    xpos, ypos,
    sposx,sposy,mposx,mposy,eposx,eposy,
    '
    'Rotation around each axis
    '
    rot_x, rot_y, rot_z,
    active_view


  
'====================================================================
' DrawTorus() - Draw a solid torus (use a display list for the model)
'====================================================================

sub DrawTorus
finit
  static as double
  
  twopi          = pi()*2,
  torus_major    = 1.5,
  torus_minor    = 0.5,
  torus_major_res= 32,
  torus_minor_res= 32


  static as sys

    torus_list, i,j,k
  
  static as single

    a, b, s, t, x, y, z, nx, ny, nz, gscale,tmc,tmd,tme
  
  if not torus_list
    '
    'Record the Torus plot list
    '--------------------------
    '
    torus_list = glGenLists 1
    glNewList( torus_list, GL_COMPILE_AND_EXECUTE )
    '
    'Draw the torus
    '
    for i = 0 to TORUS_MINOR_RES-1
      '
      glBegin GL_QUAD_STRIP
      '
      for j = 0 to TORUS_MAJOR_RES
        '
        for k = 1 to 0 step -1
          '
          s = mod( i+k,TORUS_MINOR_RES + 0.5)
          t = mod(j,TORUS_MAJOR_RES)
          '
          'CALCULATE POINT ON SURFACE
          '--------------------------
          '
          tmd=s*twopi/TORUS_MINOR_RES
          tme=t*twopi/TORUS_MAJOR_RES

          tmc=TORUS_MAJOR+TORUS_MINOR * cos tmd
          '
          x = tmc * cos tme
          y = TORUS_MINOR * sin tmd
          z = tmc * sin tme
          '
          'CALCULATE SURFACE NORMAL
          '------------------------
          '
          a=TORUS_MAJOR * cos tme
          nx = x - a
          ny = y
          a=TORUS_MAJOR * sin tme
          nz = z - a
          '
          'SCALING OF NORMALS
          '
          gscale = recip ( sqr( nx*nx + ny*ny + nz*nz ))
          nx*=gscale
          ny*=gscale
          nz*=gscale
          '
          glNormal3f nx, ny, nz
          glVertex3f x, y, z
          '
        next
        '
      next
      '
      glEnd()
      '
    next
    '
    glEndList()
    '
  else
    '  
    'Playback displaylist
    '
    glCallList( torus_list )
  end if
end sub



''================================================
'' DrawScene() - Draw the scene (a rotating torus)
''================================================

sub DrawScene

  static as single,
  
  model_diffuse(4)  => (1.0, 0.8, 0.0, 1.0),
  model_specular(4) => (0.0, 0.0, 1.0, 1.0),
  model_shininess=0.1

  glPushMatrix

  'Rotate the object
  
  glRotatef rot_x*0.5, 1.0, 0.0, 0.0
  glRotatef rot_y*0.5, 0.0, 1.0, 0.0
  glRotatef rot_z*0.5, 0.0, 0.0, 1.0

  'Set model color (used for orthogonal views, lighting disabled)
  '
  glColor4fv model_diffuse

  'Set model material (used for perspective view, lighting enabled)
  '
  glMaterialfv GL_FRONT, GL_DIFFUSE,   model_diffuse
  glMaterialfv GL_FRONT, GL_SPECULAR,  model_specular
  glMaterialf  GL_FRONT, GL_SHININESS, model_shininess
  '
  DrawTorus

  glPopMatrix
    
end sub


'============================================================
' DrawBorder() - Draw a 2D border (used for orthogonal views)
'============================================================

sub DrawBorder( byval gscale as single, st as sys )
  dim as single x,y
  glPushMatrix

  'Setup modelview matrix (flat XY view)
  '
  glLoadIdentity
  gluLookAt _ 
  0.0, 0.0, 1.0, 
  0.0, 0.0, 0.0,
  0.0, 1.0, 0.0
  'We don't want to update the Z-buffer
  '
  glDepthMask GL_FALSE

  'Set color
  '---------
  glDisable GL_LIGHTING
  glColor3f 0.7, 0.7, 0.4
  glBegin GL_LINES

  dim h as sys
  'h=gsteps*0.5
  h=st*0.5
  x = gscale * h
  y = gscale * h
    
  'Horizontal lines
  '----------------
  
  glVertex3f -x, -y, 0.0
  glVertex3f  x, -y, 0.0
  glVertex3f -x,  y, 0.0
  glVertex3f  x,  y, 0.0

  'Vertical lines
  
  glVertex3f -x, -y, 0.0
  glVertex3f -x,  y, 0.0
  glVertex3f  x, -y, 0.0
  glVertex3f  x,  y, 0.0

  glEnd

  'Enable Z-buffer writing again
  '
  glDepthMask GL_TRUE

  glPopMatrix
  
end sub


'========================================================
' DrawGrid() - Draw a 2D grid (used for orthogonal views)
'========================================================

sub DrawGrid( byval gscale as single, byval gsteps as integer )

  dim as sys i
  dim as single x,y

  glPushMatrix

  'Set background color
  '
  glClearColor 0.15, 0.15, 0.3, 0.0
  glClear GL_COLOR_BUFFER_BIT

  'Setup modelview matrix (flat XY view)
  '
  glLoadIdentity
  gluLookAt _
  0.0, 0.0, 1.0,
  0.0, 0.0, 0.0,
  0.0, 1.0, 0.0
  '
  'We don't want to update the Z-buffer
  '
  glDepthMask GL_FALSE
  '
  'Set grid color
    
  glDisable GL_LIGHTING
  glColor3f 0.0, 0.5, 0.5

  glBegin GL_LINES

  dim g,h as sys

  g=gsteps
  h=g*0.5
    
  '' Horizontal lines
  
  x = gscale * h
  y = (-gscale) * h
  '
  for i = 0 to g
    glVertex3f -x, y, 0.0
    glVertex3f x,  y, 0.0
    y+=gscale
  next

  '' Vertical lines
  
  x = -gscale * h
  y = gscale * h
  '
  for i = 0 to g
    glVertex3f x, -y, 0.0
    glVertex3f x,  y, 0.0
    x+=gscale
  next

  glEnd

  'Enable Z-buffer writing again
  '
  glDepthMask GL_TRUE

  glPopMatrix
  
end sub

 sys e

'===============
' DrawAllViews( )
'===============

sub DrawAllViews( )
  sys bb
  static as single,
  
  light_position(4) => (0.0, 8.0, 8.0, 1.0),
  light_diffuse (4) => (0.5, 0.5, 0.5, 1.0),
  light_specular(4) => (0.5, 0.5, 0.5, 1.0),
  light_ambient (4) => (0.5, 0.5, 0.5, 1.0)
  static as double aspect
  
  '
  'Calculate aspect of window
  '
  if wheight > 0
    aspect = wwidth / wheight
  else
    aspect = 1.0
  end if
  '
  glClearColor 0.1, 0, 0.5, 0
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  '
  glEnable GL_SCISSOR_TEST
  '
  glEnable GL_DEPTH_TEST
  glDepthFunc GL_LEQUAL


  '======================
  '** ORTHOGONAL VIEWS **
  '======================
  

  'For orthogonal views, use wireframe rendering
  '---------------------------------------------

  glPolygonMode GL_FRONT_AND_BACK, GL_LINE

  'Enable line anti-aliasing
  '
  glEnable GL_LINE_SMOOTH
  glEnable GL_BLEND
  glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA

  'Setup orthogonal projection matrix

  glMatrixMode GL_PROJECTION
  glLoadIdentity
  dim as sys a
  glOrtho  -3*aspect, 3.0*aspect, -3.0, 3.0, 1.0, 50

  dim w,h as sys
  w=wwidth : h=wheight
  sar w : sar h
 
  glMatrixMode GL_MODELVIEW
  glLoadIdentity


  'Upper left view (TOP VIEW)
  '--------------------------
  '
  glViewport 0,h,w,h
  glScissor  0,h,w,h
  DrawGrid 0.4,12
  if active_view=1 then DrawBorder 0.45,12
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  gluLookAt _
  0.0, 10.0, 0.1,  'Eye-position (above)
  0.0,  0.0, 0.0,  'View-point
  0.0,  1.0, 0.0   'Up-vector
  DrawScene

  'Lower left view (FRONT VIEW)
  '----------------------------
  '
  glViewport 0,0,w,h
  glScissor  0,0,w,h
  'glMatrixMode GL_MODELVIEW
  '
  DrawGrid 0.4, 12
  if active_view=3 then DrawBorder 0.45,12
  glLoadIdentity
  '
  gluLookAt _
  0.0, 0.0, 10.0,  'Eye-position (in front of)
  0.0, 0.0,  0.0,  'View-point
  0.0, 1.0,  0.0   'Up-vector
  '
  DrawScene

  'Lower right view (SIDE VIEW)
  '----------------------------
  '
  glViewport w,0,w,h
  glScissor  w,0,w,h
  DrawGrid 0.4, 12
  if active_view=4 then DrawBorder 0.45,12
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  
  gluLookAt _
  10.0, 0.0, 0.0,  'Eye-position (to the right)
   0.0, 0.0, 0.0,  'View-point
   0.0, 1.0, 0.0   'Up-vector
  
  DrawScene

  'Disable line anti-aliasing
  '
  glDisable GL_LINE_SMOOTH
  glDisable GL_BLEND


  '======================
  '** PERSPECTIVE VIEW **
  '======================

  'For perspective view, use solid rendering
  '
  glPolygonMode GL_FRONT_AND_BACK, GL_FILL

  'Enable face culling (faster rendering)
  '
  glEnable GL_CULL_FACE
  glCullFace GL_BACK
  glFrontFace GL_CW

  'Setup perspective projection matrix
  '
  glMatrixMode GL_PROJECTION
  glLoadIdentity
  gluPerspective 65.0, aspect, 1.0, 50.0

  'Upper right view (PERSPECTIVE VIEW
  '
  glViewport  w, h, w, h
  glScissor   w, h, w, h
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  
  gluLookAt _
  3.0, 1.5, 3.0,  'Eye-position
  0.0, 0.0, 0.0,  'View-point
  0.0, 1.0, 0.0   'Up-vector
  '
  'Configure and enable light source 1
  '
  glLightfv GL_LIGHT1, GL_POSITION, light_position
  glLightfv GL_LIGHT1, GL_AMBIENT,  light_ambient
  glLightfv GL_LIGHT1, GL_DIFFUSE,  light_diffuse
  glLightfv GL_LIGHT1, GL_SPECULAR, light_specular

  glEnable GL_LIGHT1
  glEnable GL_LIGHTING

  DrawScene

  glDisable GL_LIGHTING
  glDisable GL_CULL_FACE
  glDisable GL_DEPTH_TEST
  glDisable GL_SCISSOR_TEST


end sub




  'dim keys(256) as sys
  'dim mapref(16) as sys
  'dim cameraProjectionMatrix(16) as single

  dim as double,
  
  modelview(16),
  projection(16)



sub do_the_next_frame(byval hWnd as sys )  ' construct each frame
                                              '
  static as sys signal = 0
  ' timing

  QueryPerformanceCounter &grtic2
  grlap=(grtic2-grtic1)*1e6/freq
  ' fps=0.99*fps+10000/grlap ' moving average frames per sec
  ' screen refresh
  ' if bselect+kselect+refresh=0 then grtic1=grtic2: goto xdo_frame ' no need to update frame
  refresh=0
  'glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT)

  '=============
  DrawAllViews()
  '=============
  glFinish   ' wait until all operations complete
  SwapBuffers hDC
  'if firstframe=0 then SetWindowPos hWnd,HWND_TOP,100,100,500,500,0: firstframe=1
  grtic1=grtic2
  '
xdo_frame:

end sub                                    '





'----------------------------------------------------------------
function WndProc (sys hWnd, wMsg, wParam, lparam) as sys callback
'================================================================

  static cxClient as sys
  static cyClient as sys
  dim hdc as sys

    dim viewport(4) as long

    dim as sys a,b,c,i,j
    dim as sys x,y,z

    if wmsg=wm_paint then refresh=1


  '==========
  select wMsg
  '==========
  '
  
  '---------------
  case WM_ACTIVATE
  '===============
      
    if HIword(wParam) then exit function
    
  '--------------      
  case WM_DESTROY
  '==============
      
    goto termination

  '------------    
  case WM_TIMER
  '============
  
    if wParam=1
      do_the_next_frame (hWnd)
      if ReqShutDown then goto termination
    end if

  '---------------
  case WM_KEYDOWN
  '==============
  
    wParam=wParam and 255
    'keys(wParam) = 1: keyd=wParam: kselect=wParam
    if wParam=27 then ReqShutDown=1 : goto termination


  '---------------
  case WM_DESTROY
  '===============

    goto termination1

  '----------------
  case WM_MOUSEMOVE
  '================

    bselect=bselect or 1
    mPosX = LOword(lParam)
    mPosY = HIword(lParam)
    '
    if bleft=1
      '
      x=mPosX : y=mPosY
      '
      'Depending on which view was selected, rotate around different axes
      '
      '=================
      select active_view
      '=================

      '-----
      case 1
      '=====
        '
        rot_x = rot_x + y - ypos
        rot_z = rot_z + x - xpos
        '
      '-----
      case 3
      '=====
      
        rot_x = rot_x + y - ypos
        rot_y = rot_y + x - xpos
        '
      '-----
      case 4
      '=====
        '
        rot_y = rot_y + x - xpos
        rot_z = rot_z + y - ypos
        '
      '--------
      case else
      '========
        '
        'Do nothing for perspective view, or if no view is selected
        '
      '=========
      end select
      '=========
      '
      'Remember mouse position
      '
      xpos = x
      ypos = y
      '
    end if

  '----------------
  case WM_LBUTTONUP
  '================

    bLeft = 0:ePosX=mPosX:ePosY=mPosy
    '
    'Deselect any previously selected view
    '
    active_view = 0

  '----------------
  case WM_MBUTTONUP
  '================

    bMid = 0:ePosX=mPosX:ePosY=mPosy

  '----------------
  case WM_RBUTTONUP
  '================
 
    bRight = 0:ePosX=mPosX:ePosY=mPosy

  '------------------
  case WM_LBUTTONDOWN
  '==================

    bLeft  = 1:sPosX=mPosX:sPosY=mPosy
    bSelect = bselect or 2
    xpos = LOword(lParam)
    ypos = HIword(lParam)
    '
    ' Detect which of the four views was clicked
    '
    active_view = 1
    if xpos >= wwidth\2
      active_view+=1
    end if
    if ypos >= wheight\2
      active_view = active_view + 2
    end if
    doredraw = TRUE

  '------------------
  case WM_MBUTTONDOWN
  '==================

    bMid  = 1 : sPosX=mPosX:sPosY=mPosy
    bSelect = bselect or 2

  '------------------
  case WM_RBUTTONDOWN
  '==================

    bRight = 1:sPosX=mPosX:sPosY=mPosY
    bSelect = bselect or 2

  '-----------------
  case WM_MOUSEWHEEL
  '=================

    bWheel = HIword(wParam)
    bselect=1

  '------------    
  case WM_SIZE
  '============
  
    wWidth = loword lParam
    wHeight = hiword lParam
    '
    'Set the viewport to new dimensions
    '
    if wHeight > 0 and wWidth > 0
      glViewport 0, 0, wWidth, wHeight
     viewport(1)=>0,0,wWidth,wHeight
      '
      glMatrixMode   GL_PROJECTION
      glLoadIdentity
      gluPerspective 45, wWidth/wHeight, 1.0, 100
      glMatrixMode   GL_MODELVIEW
      glGetDoublev   GL_MODELVIEW_MATRIX, modelview
      glGetDoublev   GL_PROJECTION_MATRIX, projection
    end if


  '------------------
  case WM_ERASEBKGND
  '==================
  
  function = 1

  
  '--------
  case else
  '========

    function=DefWindowProc hWnd,wMsg,wParam,lParam

  '=========
  end select
  '=========
  ;
  
  exit function 
  ;
  termination:
    '
    if ReqShutDown<0 then exit function ' dont terminate
    '
  termination1:
    '
    KillTimer hWnd,1
    'CLOSE
    glDeleteLists 1000, 255 ' font
    wglMakeCurrent hDC, null
    wglDeleteContext hRC
    ReleaseDC hWnd,hDC
    PostQuitMessage 0

end function ' WndProc






'--------------------------------------------
sub initialise_OpenGL  ( sys hWnd, hDC, hRC )
 '===========================================

    'BuildFont
    dim glFont       as LOGFONT
    dim glFontHandle as sys
    '
    glFont.lfHeight         = 1                            'Height Of Font
    glFont.lfWeight         = FW_BOLD                       'Font Weight
    glFont.lfCharSet        = ANSI_CHARSET                  'Character Set Identifier
    glFont.lfOutPrecision   = OUT_TT_PRECIS                 'Output Precision
    glFont.lfClipPrecision  = CLIP_DEFAULT_PRECIS           'Clipping Precision
    glFont.lfQuality        = ANTIALIASED_QUALITY           'Output Quality
    glFont.lfPitchAndFamily = FF_DONTCARE or DEFAULT_PITCH  'Family And Pitch
    copy0 &glFont.lfFaceName, `Arial` '`Comic Sans MS`      'Font Name
    '
    glFontHandle = CreateFontIndirect(&glFont)
    glFontHandle = SelectObject(hDC, glFontHandle)
    '
    'wglUseFontOutlines hDC, 0, 255, 1000, 0.0, 0.2, WGL_FONT_POLYGONS, ?gmf)
    '
    DeleteObject(glFontHandle)
end sub




'-------------------------
Function WinMain
  (
  byval inst as sys,
  byval prevInst as sys,
  byval cmdline as sys,
  byval show as sys
  )
  as sys
'=========================

  ; window handle
  
  dim a,b,c,npixelformat,hWnd as sys
  dim wc as WNDCLASSEX
  dim wm as MSG

  with wc
    .cbsize=sizeof WNDCLASSEX
    .style=CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc=@WndProc
    .cbClsExtra=0
    .cbWndExtra=0    
    .hInstance=inst
    .hIcon=LoadIcon 0, IDI_APPLICATION
    .hCursor=LoadCursor 0,IDC_ARROW
    .hbrBackground=GetStockObject WHITE_BRUSH
    .lpszMenuName=0
    .lpszClassName=@"Opengl"
  end with
  
  if not RegisterClassEx @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if                  '

  hWnd=CreateWindowEx 0,wc.lpszClassName,"4 Port Viewer Demo",
  WS_OVERLAPPEDWINDOW,
  CW_USEDEFAULT,CW_USEDEFAULT,480,480,
  0,0,inst,0
      
  if not hWnd
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if   


  'setup pixel format

  dim pfd as PIXELFORMATDESCRIPTOR
  '
  pfd.nSize           = sizeof PIXELFORMATDESCRIPTOR 'Size of UDT structure
  pfd.nVersion        = 1                            'Version. Always set to 1.
  pfd.dwFlags         = PFD_DRAW_TO_WINDOW or _      'Support Window
                        PFD_SUPPORT_OPENGL or _      'Support OpenGL
                        PFD_DOUBLEBUFFER             'Support Double Buffering
  pfd.iPixelType      = PFD_TYPE_RGBA                'Red, Green, Blue, & Alpha Mode
  pfd.cColorBits      = 32                           '32-Bit Color Mode
  pfd.cRedBits        = null                         'Ignore Color and Shift Bits...
  pfd.cRedShift       = null                         '...
  pfd.cGreenBits      = null                         '...
  pfd.cGreenShift     = null                         '...
  pfd.cBlueBits       = null                         '...
  pfd.cBlueShift      = null                         '...
  pfd.cAlphaBits      = null                         'No Alpha Buffer
  pfd.cAlphaShift     = null                         'Ignore Shift Bit.
  pfd.cAccumBits      = null                         'No Accumulation Buffer
  pfd.cAccumRedBits   = null                         'Ignore Accumulation Bits...
  pfd.cAccumGreenBits = null                         '...
  pfd.cAccumBlueBits  = null                         '...
  pfd.cAccumAlphaBits = null                         '... Good Cereal! ;)
  pfd.cDepthBits      = 16                            ' bits z-buffer depth 8 16 24
  pfd.cStencilBits    = 1                             'Stencil Buffer
  pfd.cAuxBuffers     = null                         'No Auxiliary Buffer
  pfd.iLayerType      = PFD_MAIN_PLANE               'Main Drawing Plane
  pfd.bReserved       = null                         'Reserved
  pfd.dwLayerMask     = null                         'Ignore Layer Masks...
  pfd.dwVisibleMask   = null                         '...
  pfd.dwDamageMask    = null                         '...
  hDC   = GetDC(hWnd)
  nPixelFormat = ChoosePixelFormat(hDC, @pfd) ' First without multisampling
  SetPixelFormat(hDC, nPixelFormat, @pfd)
  finit
  hRC = wglCreateContext (hDC)
  wglMakeCurrent hDC, hRC
  ReqNewMode=0 ' done

  'initialise_OpenGL(hWnd,hDC,hRC)

  ShowWindow hWnd,show
  UpdateWindow hWnd
  '
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  glClearColor 0.5, 0, 0, 0
  SwapBuffers hDC
  '
  timerval=16 ' a bit less than 1/60 sec
  SetTimer hWnd,1,timerval,null
  ' 
  'MESSAGE LOOP
  '
  while GetMessage @wm,0,0,0
    TranslateMessage @wm
    DispatchMessage @wm
  wend
  '
  function=wm.wparam

end function ; end of WinMain

  a=TRUE

  dim cmdline,inst as sys
  cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  

  WinMain (inst,0,cmdline,SW_NORMAL)

  
