  '
  ' OPENGL / WINDOWS API
  '
  ' 05:12 04/12/2010
  ' 04:40 14/09/2011
  ' 12:30 28/11/2011
  ' 17:37 14/09/2012
  ' 09:11 10/02/2013
  '
  ' Charles Pegge

  #case capital
  def NULL null
  '
  includepath "$/inc/"
  %   Opengl
  sys act=0, running=1, closing=0
  ! action(sys hwnd)
  def ActOpengl action(hwnd)
  '
  include "Winutil.inc"
  '
  library ""
  '
  #ifdef GDIplus
    include "imgwin.inc"
  #endif
  '
  'declare ColorI(int*c) at @glColor4ubv, external 'reformulated prototype
  def ColorI glColor4ubv
  declare renderview()
  '
  uses OpenglGlob
  uses OpenglUtil
  uses glo2/texture
  uses glo2/geometry
  uses SysUtil.inc"
  '
  #ifdef GraphicalControls
    uses EditBox
    uses controls
    ControlsClass Controls
    Controls.build 1
  #endif
  '
  Geometries   'macro
  DrawingLists 'macro
  '
  'CONDITIONAL/DEFAULT EQUATES
  '
  %% title  "OpenGl Scene"
  width  = 800
  height = 800
  '

  #ifndef dll
    '
    QueryPerformanceFrequency @grfreq
    MainWindow width,height,WS_OVERLAPPEDWINDOW
    #ifdef GraphicalControls
      Controls.build 0
    #endif
    '
  #else 'a dll
    '
    function viewer() as sys, export
    QueryPerformanceFrequency @grfreq
    MainWindow width,height,WS_OVERLAPPEDWINDOW
    end function
    '
    sub finish() export
    #ifdef GraphicalControls
      Controls.build 0
    #endif
    terminate
    end sub
    '
  #endif
  '
  '---------------
  sub RenderView()
  '===============
  '
  glPushMatrix
  glscalef sca_a, sca_a, sca_a
  glTranslatef tra_x, tra_y, tra_z
  glRotatef rot_x, 1.0, 0.0, 0.0
  glRotatef rot_y, 0.0, 1.0, 0.0
  glRotatef rot_z, 0.0, 0.0, 1.0
  StandardMaterial  
  Scenes 'MACRO
  glPopMatrix
  '
  end sub

  '-------------------------------------------
  sub Draw3dView(sys l,b,w,h, double *x,*y,*z)
  '===========================================

  'For perspective view, use solid rendering
  '

  glEnable GL_NORMALIZE
  glEnable GL_SCISSOR_TEST
  glEnable GL_DEPTH_TEST
  glDepthFunc GL_LEQUAL
  '
  'glEnable GL_CULL_FACE 'faster rendering
  'glCullFace GL_BACK
  'glFrontFace GL_CW
  '
  projmode=0
  Setprojection projmode
  glEnable GL_LIGHTING
  Lighting()

  '
  glViewport  l, b, w, h
  glScissor   l, b, w, h
  '
  reqtex=1
  picklevel=1
  ViewFromHere x,y,z 'With eye-position
  picklevel=0
  '
  #ifdef GraphicalControls
  if listr then
    Controls.zone
    Controls.render
  end if
  #endif
  '
  reqtex=0
  glDisable GL_LIGHTING
  glDisable GL_CULL_FACE
  glDisable GL_DEPTH_TEST
  glDisable GL_SCISSOR_TEST
  '
  end sub


  '-------------------------------------------
  sub Draw2dView(sys l,b,w,h, double *x,*y,*z)
  '===========================================
  '
  glEnable GL_SCISSOR_TEST
  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
  '----------------------------------
  '
  projmode=1
  orthosize=3.0
  SetProjection projmode
  '
  glViewport l,b,w,h
  glScissor  l,b,w,h
  ViewFromHere 0, 0, 10 'Eye-position (in front of)

  glDisable GL_LINE_SMOOTH
  glDisable GL_BLEND
  glDisable GL_SCISSOR_TEST
  '
  end sub



  '-----------------
  sub DrawAllViews()
  '=================
  '
  ' 
  'Window size wWidth wHeight
  'Active view:
  '  0 = none
  '  1 = upper left
  '  2 = upper right
  '  3 = lower left
  '  4 = lower right
  '
  '
  '======================
  '** ORTHOGONAL VIEWS **
  '======================
  

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

  glEnable GL_SCISSOR_TEST


  'Enable line anti-aliasing
  '
  glEnable GL_LINE_SMOOTH
  glEnable GL_BLEND
  glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
  '
  'Setup orthogonal projection matrix
  '
  '
  sys w=wwidth*0.5 , h=wheight*0.5
  '
  orthosize=3.0
  projmode=1
 
  'Upper left view (TOP VIEW)
  '--------------------------
  '
  SetProjection projmode
  glViewport 0,h,w,h
  glScissor  0,h,w,h
  glPolygonMode GL_FRONT_AND_BACK, GL_LINE
  DrawGrid 0.4,12
  if active_view=1 then DrawBorder 0.45,12
  ViewFromHere 0, 10, 0.1 'Eye-position (above)
  '
  'Lower left view (FRONT VIEW)
  '----------------------------
  '
  SetProjection projmode
  glViewport 0,0,w,h
  glScissor  0,0,w,h
  glPolygonMode GL_FRONT_AND_BACK, GL_LINE
  DrawGrid 0.4, 12
  if active_view=3 then DrawBorder 0.45,12
  ViewFromHere 0, 0, 10 'Eye-position (in front of)

  'Lower right view (SIDE VIEW)
  '----------------------------
  '
  SetProjection projmode
  glViewport w,0,w,h
  glScissor  w,0,w,h
  glPolygonMode GL_FRONT_AND_BACK, GL_LINE
  DrawGrid 0.4, 12
  if active_view=4 then DrawBorder 0.45,12
  ViewFromHere 10, 0, 0 'Eye-position (to the right)
  
  ;Disable line anti-aliasing
  ;
  glDisable GL_LINE_SMOOTH
  glDisable GL_BLEND
  glDisable GL_SCISSOR_TEST


  ;======================
  ;** PERSPECTIVE VIEW **
  ;======================
  '
  'top right Corner
  '
  Draw3dView w,h,w,h, 0.0, 0.0, 6.0
  '
  end sub



  '--------------------------------------
  sub NextFrame()  'construct each frame
  '======================================
  '
  static sys signal = 0
  static single s1,s2,s3
  '
  ' timing
  '-------

  QueryPerformanceCounter @grtic2
  grlap=1e3*(grtic2-grtic1)/grfreq
  'grlap=1e3*(grtic3-grtic1)/grfreq 'frame processing time
  grtic1=grtic2
  agr=0.9*agr+.005*grlap 'rolling average grlap/
  ' 
  ;
  'Calculate aspect of window
  '--------------------------
  ;
  if wheight > 0
    aspect=wwidth/wheight
  else
    aspect=1.0
  end if
  '
  'Intialise next frame and select the view
  '----------------------------------------
  '
  glClearColor BackColor
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  '
  '--------
  'backdrop
  '========
  '
  if picklevel=0
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D,texn[1]
    glColor4f .0, .1, .0, 1.0
    SetBackGround 50, 50,-100.0
    glDisable GL_TEXTURE_2D
  end if

  objectr=1 : listr=0
  select case viewmode
  case 2 : Draw2dView 0,0,wwidth,wheight, 0.0, 0.0, 6.0
  case 3 : Draw3dView 0,0,wwidth,wheight, 0.0, 0.0, 6.0
  case 4 : DrawAllViews()
  case 5 : objectr=0 : listr=1 : Draw3dView 0,0,wwidth,wheight, 0.0, 0.0, 6.0 
  case 6 : objectr=1 : listr=1 : Draw3dView 0,0,wwidth,wheight, 0.0, 0.0, 6.0
  end select
  '
  '
  QueryPerformanceCounter @grtic3
  '
  xdo_frame:
  end sub                                    '




  '-------------------
  sub action(sys hwnd)
  '===================
  '
    def sta 2
    def stm .02
    def sts 1.01
    sys act=bleft or bmid bright or keyd or togsp or isNewView or acte

    if not act
      sleep 33
      goto naction
    end if
    '
    sys a,e,u
    '
    'KEYBOARD ACTION
    '===============
    '
    if keyd then
    '

    'keyboard action for all viewmodes
    '---------------------------------

    select keyd
    case 27  : ReqShutDown=1 : SendMessage hwnd,WM_DESTROY,0,0
    #ifdef FunctionKeys
    case 112 :                     'F1
    case 113 :                     'F2
    case 114 :                     'F3
    case 115 : viewmode=2          'F4 '1 port orthogonal wireframe
    case 116 : viewmode=3          'F5 '1 port perspective
    case 117 : viewmode=4          'F6 '4 port viewing
    case 118 : viewmode=5 : keyc=0 'F7 'editing
    case 119 : viewmode=6          'F8 'mixed text and perspective
    #endif
    end select
    '
    '
    '
    'for non editing modes
    '---------------------
    '
    if viewmode<>5 then
    'if selobject>0 then
    '
    #ifdef NavigationKeys
    '
    e=GetAsyncKeyState(0x4d) and 0x8001 'Check for M key (move)
    '
    if e then
      select keyd
      case 37  : tra_x -=stm/sca_a 'ARROW LEFT
      case 39  : tra_x +=stm/sca_a 'ARROW RIGHT
      case 38  : tra_y +=stm/sca_a 'ARROW UP
      case 40  : tra_y -=stm/sca_a 'ARROW DOWN
      '
      case 189 : rot_ys /=sts      '- REDUCE ANIMATION SPEED
      case 187 : rot_ys *=sts      '+ INCREASE ANIMATION SPEED
      end select
    else
      select keyd
      case 37  : rot_y -=sta       'ARROW LEFT
      case 39  : rot_y +=sta       'ARROW RIGHT
      case 38  : rot_x -=sta       'ARROW UP
      case 40  : rot_x +=sta       'ARROW DOWN
      '
      case 36  : tra_x -=stm/sca_a 'HOME
      case 35  : tra_x +=stm/sca_a 'END
      case 33  : tra_y +=stm/sca_a 'PG UP
      case 34  : tra_y -=stm/sca_a 'PG DOWN
      '
      case 189 : Sca_a /=sts       '- REDUCE
      case 187 : sca_a *=sts       '+ ENLARGE
      '
      case 120 : rot_x=0 : rot_y=0 : rot_z=0 : tra_x=0 : tra_y=0 : tra_z=0 : sca_a=1 'F0 reset
      '
      end select
    end if
    '
    #endif
    '
    '
    'SELECT SCENE
    '============
    '
    if keyd>=48 and keyd<=57 then
      scenenum=keyd-48
      if key(VK_SHIFT)   then scenenum+=10
      if key(VK_CONTROL) then scenenum+=20
    end if
    'end if 'selobject
    end if
    '
    '
    end if 'keyd keydown
    '
    '
    'MOUSE ACTION
    '============
    '
    static sys mMovX,mMovY
    '
    if bleft=1 'LEFT BUTTON DOWN
      '
      'quantify mouse movement between timer intervals
      '
      mMovX=mPosX-sposX
      mMovY=mPosY-sposY
      sposX=mPosX
      sposY=mPosY
      '
      'Depending on which view was selected, rotate around different axes
      '
      if viewmode=4 then
        '
        'Detect which of the four views was clicked
        '
        active_view = 1
        if ( sposx >= wwidth\2 )
          active_view+=1
        end if
        if ( sposy <= wheight\2 )
          active_view = active_view + 2
        end if
      else
        active_view=15
      end if
      '
      'for non edit modes
      '------------------
      '
      if viewmode<>5 then
      'if selobject>0 then
        '
        if keyd=77 'press M to move
          '
          tra_x +=0.2*mMovx*stm/sca_a
          tra_y +=0.2*mMovy*stm/sca_a
          '
        else 'otherwise rotate
        '
          select active_view
          case 1    : rot_x -= mMovY : rot_z += mMovX
          case 3    : rot_x -= mMovY : rot_y += mMovX
          case 4    : rot_y += mMovX : rot_z -= mMovY
          case else : rot_x -= mMovY : rot_y += mMovX
          end select
          '
        end if
      'end if 'Selobject
      end if 'non edit
      '
    end if 'bleft
    '
    if viewmode<>5 then 'not edit
      '
      'CHECK FOR OBJECT ANIMATION
      '==========================
      '
      if togsp<>0 then
        rot_y+=rot_ys
        if rot_y>=360 then rot_y-=360 'limit rotation angle
      end if
      '
    end if 'non edit
    '
    '
    'DECIDE WHETHER TO PRODUCE NEW FRAME
    '===================================
    '
    '
    '
    #ifdef GraphicalControls
    '
    'Edit Control interactions
    '-------------------------
    '
    if ViewMode=5 then
      Controls.action
    end if
    '
    #endif
    '
    '
    NextFrame()
    '
    naction:
    --------
    '
    'acte=0
    isNewView=0
    'glFinish   ' wait until all operations complete
    SwapBuffers hDC
    '
  end sub


  '----------------------------------------------------------------
  function WndProc (sys hWnd, wMsg, wParam, lparam) as sys callback
  '================================================================
  '
  static sys hr,hdlg,hGdip
  '
  '==========
  select wMsg
  '==========
  '
  'case WM_ACTIVATE    : if HIword(wParam)=0 : acte=0
  'case WM_SETFOCUS    : acte=0
  'case WM_KILLFOCUS   : acte=0
  '
  case WM_ERASEBKGND  : function=1
  case WM_SIZE        : wWidth=loword lParam : wHeight=hiword lParam
                      : isNewView=1 : action(hwnd) 'FOR CONTINUOUS REFRESH
  case WM_CHAR        : keyc=wParam and 255 ': print hex keyc
  case WM_KEYUP       : wParam and=255 : key(wParam)=0 : keyd=0
  case WM_LBUTTONUP   : bLeft  = 0 : ePosX=mPosX : ePosY=mPosy : active_view = 0 : exclu=0
  case WM_MBUTTONUP   : bMid   = 0 : ePosX=mPosX : ePosY=mPosy
  case WM_RBUTTONUP   : bRight = 0 : ePosX=mPosX : ePosY=mPosy
  case WM_MBUTTONDOWN : bMid   = 1 : sPosX=mPosX:sPosY=mPosy : bSelect or=2 : selobject=0
  case WM_MOUSEWHEEL  : bWheel=HIword(wParam) : bselect=1

  case WM_CREATE
  '=============
  '
  if minCreate then exit function
  #ifdef GDIplus 'FOR IMAGES
  GdiplusStartupInput StartupInput
  StartupInput.GdiplusVersion = 1
  hr=GdiplusStartup hGdip, StartupInput, byval 0
  if hr then
    print "Error initializing GDIplus: " hex hr
    exit function
  end if
  #endif
  '
  '
  hDC=GetDC hWnd
  SelectPixelFormat hDC
  hRC = wglCreateContext hDC
  wglMakeCurrent hDC, hRC
  ReqNewMode=0 ' done
  '
  #ifdef fontA
    BuildFont hWnd, hDC, hRC,fontA,1000
  #endif
  #ifdef fontB
    BuildFont hWnd, hDC, hRC,fontB,1500
  #endif
  #ifdef fontC
    BuildFont hWnd, hDC, hRC,fontC,2000
  #endif
  finit 'reinitialise fpu after npixelformat
  '
  glGenTextures 32, texn
  '
  #ifdef GDIplus
    #ifdef BackImage
      string imgs1
      LoadPixImage BackImage,256,imgs1
      MakeTexture *imgs1,256,256,texn[1]
    #endif
  #endif
  '
  DrawingList=CompileLists()
  '
  'timerval=10 ' 16=nominally 1/60 sec
  'SetTimer hWnd,1,timerval,NULL
  QueryPerformanceCounter @grtic1 'initial for lap measurement
  isnewview=1
  '
  case WM_DESTROY
  '==============
  '
  if minCreate then exit function
  'KillTimer hWnd,1
  '
  glDeleteTextures( 32, texn )
  CompileLists(-1)
  glDeleteLists 1000, 256 '768 ' fonts A B C
  '
  wglMakeCurrent hDC, NULL
  wglDeleteContext hRC
  ReleaseDC hWnd,hDC

  #ifdef GDIplus
  GdiplusShutdown hGdip
  #endif
  '
  running=0
  PostQuitMessage 0
  '
  case WM_KEYDOWN
  '============== 
  '
  wParam and=255 : key(wParam) = 1 : keyd=wParam : keyt=wParam
  if keyd=13
    if viewmode<>5
      togsp=1-togsp 'toggle state for ENTER key
    end if
  end if
  '
  'P snapshot
  '
  '
  if keyd=80 then
    #ifdef GDIplus
    a=GetAsyncKeyState(16) 'SHIFT P
    if a then
      TakeSnapShot hwnd,"tim75.png","image/png",75,1,1
    else 'P
      TakeSnapShot hwnd,"tim50.jpg","image/jpeg",50,0,1
    end if
    'image/jpeg image/png image/gif image/tiff image/bmp
    #endif
  end if

  case WM_MOUSEMOVE
  '================
  '
  bselect=bselect or 1
  mPosX = LOword(lParam)
  mPosY = wheight-HIword(lParam) '0 is bottom left
  '
  a=abs(mposx-sposx)+abs(mposy-sposy)
  if a>2 then ldblclk=0 'to cancel double click
  '
  'IsNewView=1 'only required for hover modes

  case WM_LBUTTONDOWN
  '==================
  '
  ldblclk+=1
  bLeft  = 1 : sPosX=mPosX : sPosY=mPosy
  bSelect or= 2
  doredraw = TRUE
  '
  case WM_RBUTTONDOWN
  '==================
  '
  bRight=1 : sPosX=mPosX : sPosY=mPosY
  bSelect or=2
  doredraw = TRUE

  case else
  '========
  '
  function=DefWindowProc hWnd,wMsg,wParam,lParam
  '
  end select
  '
  end function ' WndProc


  
