

  #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
  '17:34 19/04/2018
  '10:48 20/06/2021
  '07:31 04/06/2022
  '15:45 30/11/2023


  'Charles E V Pegge
  '
  #fpnprecision single 'no prototype float numbers

  uses ogl

  % TRUE  1
  % FALSE 0

  % SelectBufSize 1024


  =================
  'GLOBAL VARIABLES
  =================
  % nmax 0x100
  sys    hchw[nmax],gwnd
  int    act, opening, closing, pausing
  dword  SelectBuf[SelectBufSize]
  int    actn
  int    pick, picking, picked
  int    picktext, pickpix[4]
  int    texn[nmax],texe 'for texture index
  int    lisn[nmax*4],lisi 'for compiled lists
  int    lpane=0,rpane=0
  int    FrameCount
  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 ActOpengl
  ===============
  'itr multithread issue
  'if not closing
  FrameCount++
  if pausing
    if act
      scene hwnd
    endif
  else
    scene hwnd
  end if
  swapBuffers hdc
  opening=0
  act=0
  if key[bkey] then
    act=1
  end if
  'endif
  end macro

  ! scene(sys hwnd)


  uses winutil
  uses imgwin
  uses chaos
  uses timeutil

  #ifndef opengles
    uses Glo2\OpenglSceneUtil
  #endif


  function KeyState(int k) as int
  ===============================
  return GetAsyncKeyState(k) and 0x8000 'key down
  end function


  def SetFun '(name)
  ==================
  @%1=wglGetProcAddress "%1"
  if @%1=0 then print "%1?"
  end def

  sub CloseScene()
  ================
    SendMessage hWndMain,WM_CLOSE,0,0
  end sub
  '
  sub WaitForEvent(int n=1)
  =========================
  pausing=n
  end sub
  '
 
  macro NewFrame()
  ================
  glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  glEnable GL_DEPTH_TEST
  glEnable GL_NORMALIZE
  glEnable GL_BLEND
  glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
  glPolygonMode GL_FRONT_AND_BACK, GL_FILL
  #ifndef opengles
    glLoadIdentity
  #endif
  end macro

  macro TimeFrame
  ===============
  static int   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 ActiveFrame()
  ===================
  'TimeFrame
  SnapShots(hwnd) 'if Ctrl-P then 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 int 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 int done
  if done>=2
    if bkey
      SnapShots(hwnd) 'Ctrl-P take snapshot
    end if
    if act<2
      sleep 100
      'exit sub
    end if
  else
    done=1
  end if
  NewFrame
  end scope
  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



 '
  type Pixel4
    dword color
    =
    byte r,g,b,a
  end type


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

  Sub MakeTexture(sys pPixelArray, int 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

  #define GL_MIRRORED_REPEAT                0x8370
  #define GL_CLAMP_TO_EDGE                  0x812F

  'glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE
  'glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE

  glTexImage2D GL_TEXTURE_2D, 0, 4, xSize, ySize, 0, GL_RGBA, GL_UNSIGNED_BYTE, pPixelArray
  '
  End Sub

  sub MinTexture(int 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


  '

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



  sub LoadTexture(optional string fi, int n,res,*wi,*ht,*pflip)
  ===========================================================
  int 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 int
  ============================================================================
  '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 int photo
  int 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


  sub placetop(int n,*ord,c)
  ==========================
  int 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]
    'MOVE
    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
    'ROTATE
    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.z/crect.right
      df=-vv.z*0.785/crect.bottom
      dx=df*(mposx-sposx)
      dy=df*(sposy-mposy)
    else
      vv.x+=dx
      vv.y+=dy
      vv.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.x-=m  ' left
      if key[39] then vv.x+=m  ' right
      if key[38] then vv.y+=m  ' up
      if key[40] then vv.y-=m  ' down
      if key[33] then vv.z-=m  ' PgUp
      if key[34] then vv.z+=m  ' PgDn
      end scope
    end if
  end if
  end macro


  'CONDITIONAL/DEFAULT EQUATES
  '
  %% title  "OpenGl Scene"
  %% keydown
  '
  #ifndef ExplicitMain
  MainWindow width,height,WS_OVERLAPPEDWINDOW,2
  #endif

  '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
  
#ifndef CustomWndProc 'default

  function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
  ================================================================
  static   int 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 lpane, 0, crect.right, crect.bottom
  aspect=crect.right/crect.bottom 'WIDTH/HEIGHT
  #ifndef opengles
    setPerspective
  #endif
  ActOpengl 'CONTINUOUS REFRESH

  case WM_ERASEBKGND
  '
  'actopengl 'REFRESH
  return 1

  case WM_DROPFILES
  '
  filedrop = rtrim GetDropFiles(wparam)
  DragFinish(wparam)
  act=4
  pick=1
  picking=1
  ActOpenGl 'exec pick cycle
  '
  case WM_CLOSE

  SendMessage hwnd, WM_DESTROY, 0, 0
  '
  case WM_CREATE

  'SETUP DEVICE CONTEXT AND RENDER CONTEXT
  '
  if minCreate
    return DefWindowProc(hwnd, uMsg, wParam, lParam) 'unprocessed messages
  endif
  '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, hInst, null)
  hDC=GetDC hchw
  SelectPixelformat(hDC)
  opening=1
  hRC = wglCreateContext hDC
  wglMakeCurrent hDC, hRC

  #ifndef opengles
    def BuildFontM BuildFont (hWnd, hDC, hRC, %1, %!2)
    #ifdef fontA
      'FW_NORMAL 400
      'BuildFont hWnd, hDC, hRC, 1024,"Arial",FW_NORMAL,0
      BuildFontM 1024 fontA
    #endif
    #ifdef fontB
      'BuildFont hWnd, hDC, hRC ,1280, "Courier New",600,1
      BuildFontM 1280 fontB
    #endif
  #endif
  '
  'SYNC FRAME RATE - 60HZ
  'sys p=wglgetprocaddress "wglSwapIntervalEXT" : call p 1
  SetFun wglSwapIntervalEXT
  if @wglSwapIntervalEXT then wglSwapIntervalEXT 1
  '
  FrameCount=0
  Initialize hWnd
  SetWindowText hwnd,title
  'SET PRECISE CLIENT AREA
  RECT rc
  GetClientRect hwnd,rc
  MoveWindow hWnd,hpos,vpos, width*2-rc.right, height*2-rc.bottom,1
  
  case WM_DESTROY
  '
  if minCreate then exit function
  if not running then exit function 'PREVENT RECURSION
  'final frame      
  act=5
  closing=1
  scene hWnd
  'swapBuffers hdc
  Release hWnd 'cleanup
  #ifndef opengles
    #ifdef fontA
      glDeleteLists 1024, 256
    #endif
    #ifdef fontB
      glDeleteLists 1280, 256
    #endif
  #endif
  wglMakeCurrent hDC, null
  wglDeleteContext hRC
  ReleaseDC hchw,hDC
  running=0
  act=0
  opening=0
  closing=0
  pausing=0
  DestroyWindow hWnd 'SELF DESTRUCT
  return 1

  case else
  '
  return DefWindowProc(hwnd, uMsg, wParam, lParam) 'unprocessed messages 
  '
  end select
  '
  end function

#endif 'CustomWndProc


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


  macro fader(startf,endf,inout,action)
  =====================================
  scope
  if not picking then
    if FrameCount<startf
      '
    elseif FrameCount>=endf
      #ifdef action
        action
      #endif
    else 
      int Opacity,t,d,f,i
      d=endf-startf
      f=FrameCount-startf
      i=inout
      if d<1 then d=1
      t=f*255/d 'SCALE FADER
      if t>255 then t=255
      if i<0 then
        Opacity=255-t 'FADE OUT
      else
        Opacity=t 'FADE IN
      end if
      'Set WS_EX_LAYERED on this window 
      SetWindowLongPtr(hwnd, GWL_EXSTYLE,
      GetWindowLongPtr(hwnd, GWL_EXSTYLE) | WS_EX_LAYERED)
      SetLayeredWindowAttributes(hwnd, 0, Opacity, LWA_ALPHA);
    end if
  end if
  end scope
  end macro


