' OpenglSceneFrameSpQ.inc
' This is custom made for the Quad Rotate2 with the frame size

 'CONDITIONAL/DEFAULT EQUATES
  ' custom made for cubic sphere 
  %% title  "OpenGl Scene"
  %% width  300
  %% height 300
  %% keydown
  '
  #ifndef ExplicitMain
  MainWindow     width,height,%WS_POPUP 
  #endif




  #case capital
  def NULL null
  '=============
  'Opengl Window
  '=============

  'MS Child Windows
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx

  '15:20 14/09/2012
  '08:16 15/03/2017
  '15:28 13/01/2018
  'Charles E V Pegge
  '
  % Opengl


  % SelectBufSize 1024

  'GLOBALS
  ========
  sys    running=1, act=0, opening=1, closing=0, pausing=0
  dword  SelectBuf[SelectBufSize]
  sys    actn
  sys    hchw[16]
  sys    pick, picking, picked, pickex
  sys    picktext, pickchar, pickpix[4]
  int    texn[0x100],texe 'for texture index
  int    lisn[0x400],lisi 'for compiled lists
  int    lpane=0,rpane=0
  double aspect
  string filedrop
  '
  'FRAME ACTION MODES
  '==================
  'act=0 'general
  'act=1 mouse or keyboard event
  'act=2 timer event
  'act=3 window move event
  'act=4 window size event
  'act=5 window closing

  macro SetFun(name)
  ==================

  @name=wglGetProcAddress ""#name#""

  if @name=0 then print ""#name#" ?" ': exit sub

  end macro

  ! scene(sys hwnd)

  macro ActOpengl
  ===============
  'itr multithread issue
  if pausing then
    if act then scene hwnd
  else
    scene hwnd
  end if
  swapBuffers hdc
  opening=0
  act=0
  if key[bkey] then
    act=1
  end if
  end macro
  '
  '
  uses chaos
  uses winutil
  uses timeutil
  uses imgwin


  sub WaitForEvent(int n=1)
  =========================
  pausing=n
  end sub

  sub CloseWindow()
  =================
  if not closing then
    SendMessage hwndMain,WM_CLOSE,0,0
  end if
  end sub

  '
  GLYPHMETRICSFLOAT gmf[1024] 'support 4 fonts

  sub setPerspective()
  ====================
  glMatrixMode GL_PROJECTION
  glLoadIdentity
  'gluPerspective 45.0, aspect, 1.0, 1.0e6 'viewAngle,aspect,near,far
  static single znear=1,zfar=1.0e5,fovy=45.0
  static single y = zNear * tan(rad(fovy/2))
  single x = y * aspect
  glFrustum -x, x, -y, y, zNear, zFar
  glMatrixMode GL_MODELVIEW
  end sub

  macro TimeFrame
  ===============
  static sys   countn
  static float FramePeriod,stepn
  scope
  static quad   t1,t2
  stepn=1
  t1=t2
  TimeMark t2
  if t1
    FramePeriod=TimeDiff t2,t1
    if FramePeriod>.02              'quantum 60Hz 0.0166
      stepn=round(FramePeriod*60.0) 'moment scale
      countn+=stepn-1               'count missed frames
    end if
  end if
  end scope
  end macro


  macro NewFrame()
  ================
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  glEnable GL_DEPTH_TEST
  glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
  glEnable GL_BLEND
  glPolygonMode GL_FRONT_AND_BACK, GL_FILL
  glEnable GL_NORMALIZE
  glLoadIdentity
  end macro
  '
  macro ActiveFrame()
  ===================
  'TimeFrame
  SnapShots(hwnd) 'Ctrl-P take snapshot
  NewFrame
  end macro
  '
  macro LazyFrame()
  =================
  if act>2
  elseif bleft+bmid+bWheel+bright+bkey+mmove+actn
    SnapShots(hwnd) 'Ctrl-P take snapshot
    mmove=0
    if actn then actn--
  else
    sleep 100
  end if
  NewFrame
  end macro
  '
  macro DozyFrame()
  =================
  scope
  static done
  if act>2
  elseif bleft+bmid+bWheel+bright+bkey+mmove+actn
    SnapShots(hwnd) 'Ctrl-P take snapshot
    mmove=0
    if actn then actn--
    done=0
  elseif not done
    done=1
  else
    sleep 100
    'exit sub
  end if
  NewFrame
  end scope
  end macro
  '
  macro StillFrame()
  =================
  scope
  static done
  if done
    if bkey
      SnapShots(hwnd) 'Ctrl-P take snapshot
    end if
    if act<3
      sleep 100
      exit sub
    end if
  else
    done=1
  end if
  NewFrame
  end scope
  end macro


  'http://www.opengl.org/sdk/docs/man2/xhtml/glFog.xml

  macro Fog(r,g,b,d)
  ==================
  float FogColor[4]={r,g,b, .99}
  glfogi   GL_FOG_MODE,    GL_EXP
  glfogf   GL_FOG_DENSITY, d
  glfogfv  GL_FOG_COLOR,   FogColor
  glfogf   GL_FOG_INDEX,   0
  glfogf   GL_FOG_START,  -1.0
  glfogf   GL_FOG_END,    -100.0
  glEnable GL_FOG
  end macro


  function limit(float mn,v,mx) as float
  ======================================
  if v<mn then v=mn
  if v>mx then v=mx
  return v
  end function

  type vector float x,y,z

  macro DotProduct(u,v)
  =====================
  u.x*v.x + u.y*v.y + u.z*v.z
  end macro

  macro VectorUnity(v)
  ====================
  'adjusts x,y,z to give scalar value of 1.0
  scope
  double r
  r=1/sqr(v##.x*v##.x + v##.y*v##.y + v##.z*v##.z)
  v##.x*=r : v##.y*=r : v##.z*=r
  end scope
  end macro

  macro VectorDiff(pr,pt,pd)
  ==========================
  pr##.x=pt##.x-pd##.x
  pr##.y=pt##.y-pd##.y
  pr##.z=pt##.z-pd##.z
  end macro

  sub SurfaceNormal(vector *n,*p1,*p2,*p3)
  ========================================
  'assumes triangle points are defined anticlockwise
  vector u,v
  VectorDiff(u,p2,p1)
  VectorDiff(v,p3,p1)
  n.x=(u.y*v.z)-(u.z*v.y)
  n.y=(u.z*v.x)-(u.x*v.z)
  n.z=(u.x*v.y)-(u.y*v.x)
  end sub


  macro shading() if not pick then glEnable GL_LIGHTING

  macro flat()    glDisable GL_LIGHTING


  'OBJECT SELECTING SYSTEM
  '=======================
  '
  macro PickSetup()
  =================
  '
  #ifdef ColorCodedPick
  if pick
    glDisable GL_FOG
    glDisable GL_TEXTURE_2D
    flat
    glcolor4f 0,0,0,1
    static float bkx=1.0e7,bky=1.0e7,bkz=-9.9e5
    QuadTex bkx,bky,bkz 'BACKDROP (itr glClearColor flickering)
  end if
  #endif
  end macro

  #ifdef ColorCodedPick
  '
  macro BeginPick()
  =================
  if bLeft+bMid+bWheel+bRight then
    if picking=0 then
      pick=1
    end if
    picking=1 'inhibit further picks till buttons released
  else
    picking=0
  end if
  RebuildFrame:
  end macro

  macro EndPick()
  ===============
  if pick then
    glReadpixels mposx-lpane, crect.bottom-mposy, 1, 1, GL_RGBA, GL_UNSIGNED_BYTE, @pickpix
    pickex=pickpix and 0xffffff
    picked=pickex
    pick=0
    'print picked
    goto RebuildFrame 'FULL RENDER
  end if
  end macro

  macro picklabel() glcolor3ubv

  macro label() glcolor3ubv


  #else 'GL_SELECT RENDERING TECHNIQUE

  macro PickPrep
  ==============
  glInitNames()
  glSelectBuffer SelectBufSize, selectBuf
  glRenderMode GL_SELECT
  glPushName 0 'an arbitrary value
  picked=0
  pick=1
  '2 x 2 pixel viewport at mouse position
  glMatrixMode GL_PROJECTION
  glLoadIdentity
  gluPickMatrix( mposx-lpane, crect.bottom-mposy, 2.0, 2.0, byval @crect) 'pixel selection zone
  gluPerspective 45.0, aspect, 1.0, 1.0e6 'viewAngle,aspect,near,far
  glMatrixMode GL_MODELVIEW
  end macro
  '
  macro BeginPick()
  ===================
  if bleft+bmid+bWheel+bright<>0 and pick+picking=0
    PickPrep
    picking=1
  elseif bleft+bmid+bWheel+bright+pick=0
    picking=0
  end if
  RebuildFrame:
  '
  end macro
  '
  macro PickResult
  ================
  scope
  indexbase 1
  glPopName()
  sys hits,c,i
  dword w,v,u
  hits=glRenderMode(GL_RENDER)
  i=1
  c=hits*4
  v=SelectBuf(i+1)
  while i<c
    u=SelectBuf(i+1) 'min
    if u<=v
      w=SelectBuf(i+3) 'last stacked name
      v=u
    end if
    i+=3+SelectBuf(i) 'skip number of names on stack
  wend
  pick=0
  setPerspective
  picked=w
  end scope
  end macro
  '
  macro EndPick
  =============
  if pick
    PickResult
    goto RebuildFrame
  end if
  end macro
  '
  sub PickLabel(sys n)
  ====================
  if pick then glLoadName n
  end sub
  '
  macro label() PickLabel
  '
  #endif 'PICK SYSTEMS
  '
  '
  sub Lighting(float*li)
  ======================
  glLightfv GL_LIGHT1, GL_POSITION, li[1]
  glLightfv GL_LIGHT1, GL_AMBIENT,  li[5]
  glLightfv GL_LIGHT1, GL_DIFFUSE,  li[9]
  glLightfv GL_LIGHT1, GL_SPECULAR, li[13]
  glEnable GL_LIGHT1
  end sub
  '
  macro StandardLighting(li)
  ==========================
  static float li={
  0.0, 8.0, 8.0, 0.0,  'position / w=0 parallel or w=1 for directional
  1.0, 1.0, 1.0, 1.0,  'ambient
  1.0, 1.0, 1.0, 1.0,  'diffuse 
  1.0, 1.0, 1.0, 1.0   'specular
  }
  Lighting li
  glEnable GL_LIGHTING
  end macro
  '
  sub Material(float* ma)
  =======================
  if pick then exit sub
  glMaterialfv GL_FRONT, GL_AMBIENT,   ma[1]
  glMaterialfv GL_FRONT, GL_DIFFUSE,   ma[5]
  glMaterialfv GL_FRONT, GL_SPECULAR,  ma[9]
  glMaterialf  GL_FRONT, GL_SHININESS, ma[13] '0..1000 -> smallest
  end sub
  '
  macro StandardMaterial(ma)
  ==========================
  static float ma={
  .15, 0.15, 0.15, 1.0, 'ambient
  0.7, 0.70, 0.70, 1.0, 'diffuse
  0.1, 0.10, 0.10, 1.0, 'specular  
  0.                    'shininess
  }
  Material ma
  end macro
  type Pixel4
    dword color
    =
    byte r,g,b,a
  end type




  'CREATE OPENGL TEXTURE
  '=====================

  Sub MakeTexture(sys pPixelArray, xSize, ySize, TexNum )
  =======================================================
  '
  glBindTexture GL_TEXTURE_2D, TexNum
  '
  'GL_NEAREST
  'GL_LINEAR
  '
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR
  '
  'GL_NEAREST
  'GL_LINEAR
  'GL_NEAREST_MIPMAP_NEAREST         0x2700
  'GL_LINEAR_MIPMAP_NEAREST          0x2701
  'GL_NEAREST_MIPMAP_LINEAR          0x2702
  'GL_LINEAR_MIPMAP_LINEAR           0x2703
  '
  glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
  glTexImage2D GL_TEXTURE_2D, 0, 4, xSize, ySize, 0, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
  '
  End Sub

  sub MinTexture(sys n,f,h,b)
  ===========================
  long v[16]
  'b background
  'h half
  'f forground
  v<=
  b,b,b,b,
  b,f,h,b,
  b,h,f,b,
  b,b,b,b
  MakeTexture @v, 4, 4, n
  End sub

  sub QuadTex(float x,y,z)
  ========================
  glBegin GL_QUADS
  glTexCoord2f 0.0,0.0 : glVertex3f -x,-y, z
  glTexCoord2f 1.0,0.0 : glVertex3f  x,-y, z
  glTexCoord2f 1.0,1.0 : glVertex3f  x, y, z
  glTexCoord2f 0.0,1.0 : glVertex3f -x, y, z    
  glend
  end sub

  sub QuadNorm(optional float x,y,z, optional sys m)
  ==================================================
  'Configured As Front Face
  sys mo=1
  if @m then mo=m
  if not x then x=1.0
  if not y then y=x
  glBegin GL_QUADS
  glNormal3f   0.0 , 0.0  , 1.0
  if m=0 then glTexCoord2f 0.0 , 0.0
  glVertex3f -x , -y , z  
  if m=0 then glTexCoord2f 1.0 , 0.0
  glVertex3f  x , -y , z  
  if m=0 then glTexCoord2f 1.0 , 1.0
  glVertex3f  x ,  y , z  
  if m=0 then glTexCoord2f 0.0 , 1.0
  glVertex3f -x ,  y , z  
  glEnd
  end sub

  function CompileList(optional sys list) as sys
  ==============================================
  indexbase 1
  if not list then
    function = glGenLists 1
    lisn[++lisi]=function 'LOG FOR DELETION AT END
  else
    function = list
  end if
  glNewList function, GL_COMPILE
  end function
  '
  macro BeginGlCompile(n)
  =======================
  #ifndef n
  static sys n
  #endif
  if n=0 then
  n=CompileList
  end macro
  '
  macro EndGlCompile()
  ====================
  glEndList
  end if
  end macro
  '

  macro go(n)
  ===========
  if n then glCallList n
  end macro
  '
  macro DeleteAllGlCompiled
  =========================
  scope
  indexbase 1
  sys i,a
  for i=1 to lisi
    a=lisn[i]
    if a then glDeleteLists a,1
  next
  end scope
  end macro

  macro GenTextures(n)
  ====================
  glGenTextures n,texn
  end macro
  '
  macro DeleteTextures(n)
  =======================
  glDeleteTextures n,texn
  end macro


  sub Sides(sys n,float x,y, optional sys m)
  ========================================
  float r=1.0
  float w=tan(pi/n)
  float a=360/n
  for i=1 to n
  QuadNorm x*w,y*w,r,m : glRotatef a,0,1,0 'anticlockwise: front right.back,left
  next
  end sub

  function CubeForm(optional sys m) as sys
  ========================================
  glPushMatrix
  Sides 4,1,1,m
  glRotatef 90.0,1,0,0 'bottom
  QuadNorm 1.0,1.0,1.0,m
  glRotatef 180.0,1,0,0 'top
  QuadNorm 1.0,1.0,1.0,m
  glPopMatrix
  end function


  sub LoadTexture(optional string fi, int n,res,*wi,*ht,*pflip)
  ===========================================================
  sys flip
  if not fi then exit sub
  'if n>32 then exit sub
  if not n then texe++ : n=texe
  string imgs=""
  if @pflip then flip=pflip else flip=6
  LoadPixImage fi,res,imgs, wi, ht, flip
  If not res then
    MakeTexture strptr imgs,wi,ht,texn[n]
  else
    MakeTexture strptr imgs,res,res,texn[n]
  end if
  end sub

  sub texture(int n)
  ==================
  if n<=0
    glDisable GL_TEXTURE_2D
  else
    if not pick then 
      glEnable GL_TEXTURE_2D
      glBindTexture GL_TEXTURE_2D, texn[n]
    end if
  end if
  end sub

  macro NewTexture(n)
  ===================
  static int n = ++ texe
  end macro


  function GetTexture(int *n, string fi, int res=0, *wi=null, *ht=null) as sys
  ============================================================================
  'static int texe=20 'image counter max 0xff
  if n=0 then
    texe++
    n=texe
    'res=0 'use wi and ht of image
    LoadTexture fi,n,res,wi,ht
  end if
  texture n
  return n
  end function

  macro CreateTexture(n,f)
  ========================
  static int n,n##wi,n##ht
  GetTexture n,f,0,n##wi,n##ht
  end macro

  sub DynSynthTexture(int *n, any*v, int c)
  =========================================
  int w=sqr(c/4)
  MakeTexture @v, w, w, texn[n]
  end sub

  macro CreateSynthTexture(n,v,c)
  ===============================
  NewTexture n
  #ifdef c
    DynSynthtexture n,v,c
  #else
    DynSynthtexture n,v,bytesof(v)
  #endif
  end macro

  sub snapshots(sys hwnd)
  =======================
  static sys photo
  sys g,tr
  if key[80] and key[VK_CONTROL] and photo=0
    if key[VK_SHIFT]
      tr=1 'transparent background
    end if
    if not GDIplus 2 then GDIplus 1 : g=1
    if tr
      TakeSnapShot hwnd,"tim75.png","image/png",75,tr,1
    else
      TakeSnapShot hwnd,"tim50.jpg","image/jpeg",50,0,1
      'SaveClientImage hwnd
    end if
    if g then GDIplus 0
    photo=1
  elseif key[80]=0
    photo=0
  end if
  end sub

  '% ANSI_CHARSET        = 0
  '% DEFAULT_CHARSET     = 1
  '% SYMBOL_CHARSET      = 2

  sub BuildFont (sys hWnd,hDC,hRC, base=1024, string name="Arial", int weight=FW_NORMAL, charset=DEFAULT_CHARSET)
  ===============================================================================================================
  indexbase 0
  LOGFONT   glFont
  sys       glFontHandle
  '
  glFont.lfHeight         = 1                             'Height Of Font
  glFont.lfWeight         = weight                        'Font Weight FW_BOLD etc
  glFont.lfCharSet        = 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
  glFont.lfFaceName       = name    ' "Arial" "Lucida Console" "Consolas" ' "Courier New"    'Font Name
  '
  glFontHandle = CreateFontIndirect(@glFont)
  glFontHandle = SelectObject(hDC, glFontHandle)
  wglUseFontOutlinesA (hDC, 0, 256, base, 0.0, .25, WGL_FONT_POLYGONS, @gmf[base-1024])
  DeleteObject(glFontHandle)
  end sub

  function GetWordArea(string s, single *x,*y, optional sys fnt)
  ==============================================================
  '
  'TYPE POINTFLOAT
  '  x AS SINGLE
  '  y AS SINGLE
  'END TYPE
  '
  'TYPE GLYPHMETRICSFLOAT
  '  gmfBlackBoxX AS SINGLE
  '  gmfBlackBoxY AS SINGLE
  '  gmfptGlyphOrigin AS POINTFLOAT
  '  gmfCellIncX AS SINGLE
  '  gmfCellIncY AS SINGLE
  'END TYPE
  '
  indexbase 0
  sys v
  x=0
  v=77+fnt*256 '77=='M'
  'y=gmf[v].gmfCellIncY
  y=gmf[v].gmfBlackBoxY
  sys a,b,e=len s
  for b=1 to e
    a=asc(s,b)+fnt*256
    x+=gmf[a].gmfCellIncX
  next
  end function

  function PutBoxArea(single x,y, optional z)
  ===========================================
  glbegin GL_QUADS
  glvertex3f 0,0,z
  glvertex3f x,0,z
  glvertex3f x,y,z
  glvertex3f 0,y,z
  glend
  end function

  function print3D(optional string s, float lf, sys fnt)
  ======================================================
  float x,y
  if lf
    glPushMatrix
  end if
  if s
    if pick then
      GetWordArea s,x,y,fnt
      PutBoxArea  x,y
      glTranslatef x,0,0
    else
      glPushAttrib GL_LIST_BIT
      glListBase   1024+fnt*256
      glCallLists len(s), GL_UNSIGNED_BYTE, strptr s
      glPopAttrib
    end if
  end if
  if lf
    glPopMatrix
    glTranslatef .0,-lf,.0 'line feed
  end if
  end function
  '
  '
  function gprint(optional string s, float lf, sys fnt)
  =====================================================
  glScalef 1.,1.,.001
  print3D s,lf,fnt
  glScalef 1.,1.,1000
  end function

  sub placetop(sys n,*ord,c)
  ==========================
  sys b,i
  for i=1 to c
    if ord[i]=n then b=i : exit for
  next
  if (b=0)or(b=c) then return
  for i=b to < c
    ord[i]=ord[i+1] 'SHUNT THE REST, USING THE VACANT POSITION
  next
  ord[c]=n 'FRONT POSITION
  end sub


  
  macro Navigation()
  ==================
  '
  'VIEW CONTROL WITH KEYBOARD KEYS
  '
  static float cmmx,cmmy,cmmz,cmax,cmay,cmaz,ns
  glrotatef    cmax,1,0,0 'rotate yz : pitch
  glrotatef    cmay,0,1,0 'rotate xz : yaw
  glrotatef    cmaz,0,0,1 'rotate xy : roll
  glTranslatef cmmx,cmmy,cmmz
  '
  if not key[VK_CONTROL]
    ns=0.02
    if key[VK_SHIFT] then ns=0.1
    if key[37] then cmmx+=ns*cos(rad(cmay)) : cmmz+=ns*sin(rad(cmay)) 'left
    if key[39] then cmmx-=ns*cos(rad(cmay)) : cmmz-=ns*sin(rad(cmay)) 'right
    if key[38] then cmmx-=ns*sin(rad(cmay)) : cmmz+=ns*cos(rad(cmay)) 'up
    if key[40] then cmmx+=ns*sin(rad(cmay)) : cmmz-=ns*cos(rad(cmay)) 'dpwn
    if key[33] then cmmy-=ns 'pgup
    if key[34] then cmmy+=ns 'pgdn
  else
    ns=.4
    if key[VK_SHIFT] then ns=1.0
    if key[37] then cmay-=ns 'left
    if key[39] then cmay+=ns 'right
    if key[38] then cmax-=ns 'up 
    if key[40] then cmax+=ns 'down
    if key[33] then cmaz+=ns 'pgup
    if key[34] then cmaz-=ns 'pgdn
    if key[36] 
      cmax=0. : cmay=0. : cmaz=0. 'HOME'
    end if
  end if
  end macro
  '
  '
  '
  macro MoveObjectWithMouse(vv)
  =============================
  static float dx,dy,dz,df
  if picked then
    if bleft then
      'df=-1.05*vv##.p.z/crect.right
      df=-vv##.p.z*0.785/crect.bottom
      dx=df*(mposx-sposx)
      dy=df*(sposy-mposy)
    else
      vv##.p.x+=dx
      vv##.p.y+=dy
      vv##.p.z+=dz
      dx=0.0
      dy=0.0
      dz=0.0
    end if
  end if
  end macro

  macro MoveObjectWithKeys(vv,mv,an)
  ==================================
  if picked
    if key[VK_CONTROL]
      if key[37] then vv##.a.y-=an  ' left
      if key[39] then vv##.a.y+=an  ' right
      if key[38] then vv##.a.x-=an  ' up
      if key[40] then vv##.a.x+=an  ' down
      if key[33] then vv##.a.z+=an  ' PgUp
      if key[34] then vv##.a.z-=an  ' PgDn
      if key[36] 
        vv##.a.x=0. : vv##.a.y=0. : vv##.a.z=0. 'HOME'
      end if
    else
      scope
      static float m
      if key[VK_SHIFT] then m=mv*3 else m=mv
      if key[37] then vv##.p.x-=m  ' left
      if key[39] then vv##.p.x+=m  ' right
      if key[38] then vv##.p.y+=m  ' up
      if key[40] then vv##.p.y-=m  ' down
      if key[33] then vv##.p.z-=m  ' PgUp
      if key[34] then vv##.p.z+=m  ' PgDn
      end scope
    end if
  end if
  end macro


 

  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  'Button	The class for a button.
  'ComboBox	The class for a combo box.
  'Edit	        The class for an edit control.
  'ListBox	The class for a list box.
  'MDIClient	The class for an MDI client window.
  'ScrollBar	The class for a scroll bar.
  'Static	The class for a static control.

  sys WndProcExtra 'callback for customised windows message processing

  ! Initialize(sys hWnd)
  ! Release(sys hWnd)
  !*wglSwapIntervalEXT(int b) extern
  
  function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
  ================================================================
  static   sys a
  'globals sys hDC,hRC
  '
  if WndProcExtra
    a=call WndProcExtra(hwnd,uMsg,wParam,lParam)
    if a then exit function
  end if
  '
  select umsg 
  '
  MouseMessages()
  KeyboardMessages()
  '
  case WM_TIMER       : act=2
  case WM_MOVE        ': act=3
  case WM_SIZE        : act=4
    'finit 'intitialise fpu
    GetClientRect  hWnd,cRect
    crect.right=crect.right-lpane-rpane
    'MoveWindow hchw , lpane , 0 , crect.right , crect.bottom , TRUE
    glViewport 0, 0, crect.right, crect.bottom
    aspect=crect.right/crect.bottom 'WIDTH/HEIGHT
    setPerspective
    'ActOpengl 'CONTINUOUS REFRESH
  case WM_ERASEBKGND  : 
     'actopengl 'REFRESH
     return 1
   case WM_DROPFILES
    filedrop = rtrim GetDropFiles(wparam)
    DragFinish(wparam)
    '
  case WM_CLOSE
    SendMessage hwnd, WM_DESTROY, 0, 0
  case WM_CREATE
  '
  'SETUP DEVICE CONTEXT AND RENDER CONTEXT
  '
  if minCreate then exit function
  '
  'int style=WS_CHILD | WS_VISIBLE
  int style=WS_POPUP | WS_BORDER
  % ID_FIRSTCHILD  100
  int id=ID_FIRSTCHILD
  hchw=hwnd
  'hchw=CreateWindowEx(0,"static", null, style, 0,0,100,100, hwnd, id, inst, null)
  hDC=GetDC hchw
  SelectPixelformat(hDC)
  hRC = wglCreateContext hDC
  wglMakeCurrent hDC, hRC

  #ifdef fontA
    BuildFont hWnd, hDC, hRC, 1024,"Arial",FW_NORMAL,0
  #endif
  #ifdef fontB
    BuildFont hWnd, hDC, hRC ,1280, "Courier New",600,1
    'BuildFont hWnd, hDC, hRC ,1280, fontB
  #endif
  '
  'SYNC FRAME RATE - 60HZ
  'sys p=wglgetprocaddress "wglSwapIntervalEXT" : call p 1
  SetFun wglSwapIntervalEXT
  if @wglSwapIntervalEXT then wglSwapIntervalEXT 1
  '
  Initialize hWnd
  SetWindowText hwnd,title
  'SET PRECISE CLIENT AREA
  RECT rc
  GetClientRect hwnd,rc
  'MoveWindow hWnd,rc.left,rc.top, width*2-rc.right, height*2-rc.bottom,1
  MoveWindow hWnd,rc.left,rc.top, width*2-rc.right+lpane+rpane, height*2-rc.bottom,1
  '
  'SendMessage hwnd,WM_SIZE,0,0
  '
  case WM_DESTROY
  '
  if minCreate
    exit function
  end if
  act=5
  closing=1
  ActOpengl 'final calls      
  Release hWnd
  #ifdef fontA
    glDeleteLists 1024, 256
  #endif
  #ifdef fontB
    glDeleteLists 1280, 256
  #endif
  wglMakeCurrent hDC, null
  wglDeleteContext hRC
  ReleaseDC hchw,hDC
  running=0
  PostQuitMessage 0
  return 0
  '
  case else
  '
  return DefWindowProc(hwnd, uMsg, wParam, lParam) 'unprocessed messages 
  '
  end select
  '
  end function


  macro StepAngle(a,i)
  ====================
  static float a
  if not pick then
    a+=i
    if a>360 then a-=360
  end if
  end macro