  '=============
  'Opengl Window
  '=============

  '13:37 27/04/2026
  '15:38 30/04/2026

  'Charles E V Pegge
  '

  #case capital
  def NULL null

  #fpnprecision single 'no prototype float numbers

  uses ogl

  % TRUE  1
  % FALSE 0

  extern lib "OxygenG.dll"

  % SelectBufSize 1024

  type vector
    float x,y,z
  end type

  type ColorType
    float r,g,b,a
  end type

  type      StateType
    float rf,gf,bf,af 'forground color
    float rb,gb,bb,ab 'background color
    float xs,ys,zs    'scale
    float xd,yd,zd    'distance
  end type
  
  =================
  'GLOBAL VARIABLES
  =================

  % nmax 0x100
  sys    hchw[nmax],gwnd
  dword  SelectBuf[SelectBufSize]
  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
  vector*FrameScale
  '
  def       stkmax   32
  StateType StateStack[stkmax] 'stack for color & positionstates
  sys       gwnd
  int       stko 'stack offset
  int       stke=stkmax*sizeof StateType 'stack offset limit

  string    tab=chr(9)
  string    cr=chr(13,10)

  int       sphere,cylinder,cube

  ColorType bcolor at (@StateStack.rb) 
  ColorType fcolor at (@StateStack.rf)
 
  stke = stkmax*sizeof StateType
  bcolor={.20, .20, .40, 1.}  'background color
  fcolor = {.00, .70, .70, 1.}  'forground and text color



  sys  timer
  sys  timercall
  quad tickcount
  '
  ! sub timetick (sys lpParameter,TimerOrWaitFired) callback

  '
  '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

  '! procedure NoAction(sys h)
  ! procedure SetCallInit(sys p)
  ! procedure SetCallRelease(sys p)
  ! procedure SetCallScene(sys p)

  '% GuiSharedMem "Local\WinGuiState"
  % GuiDllName "OxygenG.dll"
  uses GuiInterface

  'uses winutilHdr
  '===============
  ! function SelectPixelFormat(sys hDC,optional n) as int
  ! function TimeDiff(quad *te,*ts) as double
  ! function AppExePath(int n=0) as string
  ! function GetClientWHXY(sys hWnd, *w,*h,*x,*y)
  ! function GetDropFiles(sys hDropParam) As string
  ! Function MainWindow( int widthp=640, heightp=480, style=WS_OVERLAPPEDWINDOW, place=2)
  ! sub UnregisterMain()

  'uses imgwinHdr
  '==============
  ! function GDIplus(int mode) as sys
  '! function GetEncoderClsid(string MimeType,GUID*clsid) as int
  ! sub SaveImage(string fname,typimg, int quality, LPVOID pBitMap)
  ! function SaveClipBoardImage(sys hwnd=0, string fname="tim50.jpg", typimg="image/jpeg", int quality=50) as int
  ! function SaveClientImage(sys hwnd,string fname="tim50.jpg", typimg="image/jpeg", int quality=50) as int
  ! function TakePixelPhoto(sys hwnd,string fname,typimg, int quality, tr, any*pix, int wi, ht) as int
  ! function TakeSnapShot(sys hwnd,string fname="tim50.jpg", typimg="image/jpeg", int quality=50, tr=0, gl=0, wa=0) as int
  ! sub LoadPixImage(string name, sys size, string*pixels, optional int *owi,*oht, *pflip)

  'uses ChaosHdr
  '=============
  int crc32_table[0x100]
  ! init_crc32_table()
  init_crc32_table
  ! crc32(sys p,le) as int
  ! sub randomize(int i)
  ! function rnd() as float
  ! function arnd() as float
  ! function irnd(int z1, z2) as int
  ! function Interpolation(float a,b,c) as float
  ! function InterpLinear(float a,b,c) as float
  ! function Noise(int v) as float
  ! function NoiseA(int v) as float
  ! sub AddNoiseC(sys pp,wi,ht,st,r,g,b,a,ofs,optional mo)
  ! sub AddNoiseF(sys pp,wi,ht,st,ofs,float sc)




  'uses timeutilHdr
  '================
  type SYSTEMTIME 
    word wYear,
       wMonth,
       wDayOfWeek,
       wDay,
       wHour,
       wMinute,
       wSecond,
       wMilliseconds
  end type
  '
  ! function CalcDay(SYSTEMTIME*ti=null) as int
  ! function CalcDate(SYSTEMTIME*ti,int gday)
  ! function CalcTimeStamp(SYSTEMTIME*ti=null, sys offd=0, quad*tq=0) as sys
  ! function CalcDateTime(SYSTEMTIME*ti, sys offd=0, quad*tq=null)
  ! function CalcUnixTimeStamp(SYSTEMTIME*ti=null, quad*tq) as sys
  ! function CalcUnixDateTime(SYSTEMTIME*ti=null, quad*tq)
  ! function TimeStr(SYSTEMTIME*tt=null) as string
  ! function TimeLapseMs(SYSTEMTIME *t1,*t2) as sys



  #ifndef opengles
  'uses Glo2\OpenglSceneUtilHdr
  '============================
  ! sub setPerspective()
  ! sub Fog(float r,g,b,d)
  ! sub shading()
  ! sub flat()
  '
  % ColorCodedPick

  ! sub Lighting(float*li)
  ! sub Material(float* ma)
  ! sub QuadTex(float x,y,z)
  ! sub QuadNorm(optional float x,y,z, int m=0)
  ! function CompileList(int list=0) as int
  ! sub Sides(int n,float x,y, optional int m)
  ! function CubeForm(optional int m) as int
  ! sub BuildFont (sys hWnd,hDC,hRC, int base=1024, string name="Arial", int weight=FW_NORMAL, charset=DEFAULT_CHARSET)
  ! function GetCharArea(int c, single *x,*y, optional int fnt)
  ! function GetWordArea(string s, single *x,*y, optional int fnt)
  ! function PutBoxArea(single x,y,z=0.0)
  ! function print3D(string s="", float lf=0.0, int fnt=0)
  ! function gprint(optional string s, float lf, int fnt)

  #endif

  'uses glo2\ShaderSupportHdr
  '==========================
  'uses MathUtil
  '-------------
  ! function ShowVec(float *v, sys n=3) as string
  ! function ShowMat(float*m,sys r=4) as string
  ! function Transpose(float *r, *m, int nx=4,ny=0) as float*
  ! function SetIdentity(float *m, int n=4)
  ! function MatMul(float *r,*a,*b, int n=4) 'NxN MATRIX : N=1..
  ! function MatCol float *r,*m, int c=0,n=4)
  ! function MatRow float *r,*m, int rw=0,n=4)
  ! function InverseMat(float *m, sys n=4) 'NxN MATRIX : N=2..16
  ! function det2x2sub(float *m, int i0,i1,i2,i3) as float
  ! function InverseMat3x3(float *r, *m)
  ! function Mat4x4ToMat3x3(float *r,*m)
  ! function mat4x4Mul(float *r,*m1,*m2)
  ! function transformVec4(float *r,*m,*v, sys n=0)
  ! function transformVec3(float *r,*m,*v, sys n=1)
  ! function mat4x4rotateVecX(float *r, *v, a)
  ! function mat4x4rotateVecY(float *r, *v, a)
  ! function mat4x4rotateVecZ(float *r, *v, a)
  ! function det3x3sub(float *m, int i0,i1,i2,i3,i4,i5,i6,i7,i8) as float
  ! function mat4x4Inverse(float *r,*m)
  ! function mat4x4scale(float *r, x, y, z)
  ! function mat4x4Translate(float *r, x, y, z)
  ! function mat4x4rotate(float *r, a, x, y, z)
  ! function Normalize(vec3 *r,*v)
  ! function Normalizef(float *r,*v)
  ! function dot(vec3 *u,*v) as float
  ! function cross(vec3 *r,*u,*v)
  ! function diff(vec3 *r,*u,*v)
  ! function mat4x4Look(float *r, vec3 *eye,*center,*up)
  ! function CopyFloat(float *r,*s, int n=1)
  ! function CopyVec(float *r,*s, int n=1)
  ! function CopyMat(float *r,*s, int n=1)
  ! function SetViewMatrix(float *r, vec3 *vp,*vu,*vv,*vn)
  ! function SetProjectionMatrix(float *r, fov, aspect, near, far, int orth=0, leftHanded=1)
  ! function scalef(float x,y,z)
  ! function translatef(float x,y,z)
  ! function rotatef(float a,x,y,z)
  ! function PushMatrix()
  ! function PopMatrix()
  ! function LoadMatrix(float*m)
  ! function SaveMatrix(float*m)
  ! function LoadIdentity()
  ! function MulMatrix(float *m)
  ! function inversef()
  ! function transformf(float *r,*v, int n=1,st=12,oo=0)
  ! function NormalMatf(float *r,*s)
  ! function TranslationMatf(float *r,*s)
  ! function transnormf(float *r,*v, int n=1,st=12,oo=0)
  ! function translormf(float *r,*v, int n=1,st=12,oo=0)
  ! sub diff2(float *r,*v,*w)
  ! sub diff3(float *r,*v,*w)
  ! sub unify(float *v)
  ! function TanBitanNorm(float *r, *p, *t)
  ! function sortindex(float *v, sys *idx, sys mx)
  'omit mathutilextra
  '------------------

  uses glo2\DynDeclareExport
  '-------------------------

  'uses glo2\ShaderUtilHdr
  '-----------------------
  ! function instrword(string s,k) as sys
  ! function replace(string s,f,r) as string
  ! function GetShaderInfoLog(int shader,string *info) as sys
  ! function GetProgramInfoLog(int program,string *info) as sys
  ! sub CompileShader(int typ, string s , int *h,*c)
  '
  class ShaderProg
  ================
  '
  string vsrc , gsrc , fsrc       'vertex, geometry, fragment shader sources
  int    ph                       'program handle
  int    vh   , gh   , fh         'vertex, geometry, fragment shader handles
  int    vc   , gc   , fc         'vertex, geometry, fragment shader compile status
  int    m0,m1,m2,m3,m4,m5,m6,m7  '4x4 matrix locators
  int    n0,n1,n2,n3,n4,n5,n6,n7  '3x3 matrix locators
  int    t0,t1,t2,t3,t4,t5,t6,t7  'texture or sampler locators
  int    u0,u1,u2,u3,u4,u5,u6,u7  'general locators
  int    v0,v1,v2,v3,v4,v5,v6,v7  'vec4 locators
  method create()
  method use()
  method release()
  end class
  
  ! function CreateShaderProg(ShaderProg*p) as sys
  ! function ReleaseShaderProg(ShaderProg*p) as sys

  'uses glo2\TextureUtilHdr
  '------------------------
  ! function PixelColor(float fr,fg,fb,fa=1.0) as dword
  ! function CreateTexture2D(int width, height, sys pImg, int *texture)
  ! function CreateTextureCubic(int width, height, sys pImg, int *texture)
  ! sub LoadCubicTextures(string left,right,bottom,top,front,back, int *Texture)
  ! sub BuildSkyBox()
  ! sub DrawSkyBox(int SkyTexture, SkyShader)

  'uses glo2\GraphicObjectsHdr
'-----------------------------
  '
  class ShapeObject
  =================
  '
  'e... elements for indexing vertices
  'm... matrices for instances
  'v... vertices including normal coords and texture coords / tan and bitan
  '
  bstring es,ms,vs  'source buffers
  sys    ei,mi,vi   'source buffer length used
  sys    eb,mb,vb   'opengl buffer names
  sys    ec,mc,vc   'count of elements / matrixes / vertexes
  sys    em         'mode (default GL_TRIANGLES)
  '
  method append(bstring *s, sys p, int n,*ee) as sys
  method zSortMatrix(int mf=1)
  method BillboardMatrix()
  method ExpandInstance()
  method putvertex(float*d, int n) as sys
  method putindex(int*d, int n, m=GL_TRIANGLES) as sys
  method putmatrix(float*d, int n) as sys
  method clearVertex()
  method clearIndex()
  method clearMatrix()
  method init
  method SetAttributes(int mo=0)
  method transferVertex()
  method transferElement()
  method transferMatrix()
  method show()
  method transfer()
  method release()
  method render(sys p=0, c=0)
  method renderClient(sys p=0, c=0)
  '
  end class 'ShapeObject
  '
  '
  class RenderObject
  ==================
  'Render To Texture
  'https://learnopengl.com/Advanced-OpenGL/Framebuffers
  'https:/+++/www.khronos.org/registry/OpenGL-Refpages/gl4/
  '
  int  Framebuf
  'int  Depthbuf
  int  DepthStencilbuf
  int  Texturebuf
  int  txWidth
  int  txHeight
  int  texture
  int  ntype
  int  selBuf
  '
  method Setup(int txw=512, txh=512, typ=GL_UNSIGNED_BYTE)
  method Check() as int
  method RenderToTexture()
  method RenderToScreen()
  method ByteCount(int nx=0, ny=0) as int
  method Read(sys pp=0, int px=0, py=0, nx=0, ny=0)
  method Release()
  '
  end class 'RenderObject
  '#recordof renderobject

  '
  uses minmidi 'all
  -----------------
  sys hmo,ermo



  ! function KeyState(int k) as int

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

  ! procedure CloseScene()
  ! procedure WaitForEvent(int n=1)

  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

  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

  ! procedure SurfaceNormal(vector *n,*p1,*p2,*p3)

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


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

  ! procedure MakeTexture(sys pPixelArray, int xSize, ySize, TexNum )
  ! procedure MinTexture(int n,f,h,b)

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



  ! procedure LoadTexture(optional string fi, int n,res,*wi,*ht,*pflip)

  ! procedure texture(int n)

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


  ! function GetTexture(int *n, string fi, int res=0, *wi=null, *ht=null) as int

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

  ! procedure DynSynthTexture(int *n, any*v, int c)

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

  ! procedure snapshots(sys hwnd)
  ! procedure placetop(int n,*ord,c)

  ! procedure color(float r=0.5,g=0.5,b=0.5,a=1.0)
  ! procedure sub PushState()
  ! procedure PopState()

  ! procedure move(optional float x,y,z)
  ! procedure scale(optional float x,y,z)
  ! procedure Rotate(optional float a,x,y,z)
  ! procedure RotateX(optional float a)
  ! procedure RotateY(optional float a)
  ! procedure RotateZ(optional float a)
  ! procedure PointSize(optional float ps)
  ! procedure thickness(float th=1)
  ! procedure sub point(optional float x,y,z)
  ! procedure line(optional float x,y,z)

 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

  macro MoveThisWithMouse
  =======================
  scope
  int bl,bm,br
  if mode and 1
    'SWAP LEFT/RIGHT BUTTON FUNCTIONS
    bl=bRight
    br=bLeft
  else
    bl=bLeft
    br=bRight
  end if
  bm=bMid
  if bR
    'assume scale 1/16
    'float f=(2.4142-z*8)/crect.bottom
    float f=(32-z)/crect.bottom
    if @FrameScale
      f/=FrameScale.y
    endif
    d.x=f*(mposx-sposx)
    d.y=f*(sposy-mposy)
  else
    x+=d.x
    y+=d.y
    z+=d.z
    d.x=0.0
    d.y=0.0
    d.z=0.0
    if snap 'SNAP TO NEAREST
      x=round(x/snap)*snap
      y=round(y/snap)*snap
    end if
  end if
  '
  if bL
    a.y=aa.y+(mposx-sposx)
    a.x=aa.x+(mposy-sposy)
  else
    aa.x=a.x
    aa.y=a.y
  end if
  '
  'if bWheel
  '  if bWheel>0
  '    z-=2.0
  '  else
  '    z+=2.0
  '  end if
  'end if
  '
  if bM
    'Z MOVEMENT 
    float f=(32-z)/crect.bottom
    f=f*(sposy-mposy)*.1
    z-=f
    '
    ''SCALING
    'f=.01
    's.y=sa.y+f*(sposy-mposy)
    'if mode and 16
    '  s.x=sa.x+f*(mposx-sposx)
    '  s.z=s.x
    'else
    '  s.x=s.y
    '  s.z=s.y
    'end if
  else
    sa.x=s.x
    sa.y=s.y
    sa.z=s.z
  end if
  end scope
  end macro

  macro MoveThisWithKeys(mv,an,k)
  ===============================
  if key[VK_CONTROL]
    if key[37] then a.y-=an : k=2  ' left
    if key[39] then a.y+=an : k=2  ' right
    if key[38] then a.x-=an : k=2  ' up
    if key[40] then a.x+=an : k=2  ' down
    if key[33] then a.z+=an : k=2  ' PgUp
    if key[34] then a.z-=an : k=2  ' PgDn
    if key[36] 
      a.x=0. : a.y=0. : a.z=0. : k=3 'HOME'
    end if
    static float m
    m=1.0+m*.01
    if key[0xbd] then s.x/=m : s.y/=m : s.z/=m : k=1  ' -
    if key[0xbb] then s.x*=m : s.y*=m : s.z*=m : k=1  ' =
  else
    scope
    static float m
    if key[VK_SHIFT] then m=mv*3 else m=mv
    if key[37] then x-=m : k=1  ' left
    if key[39] then x+=m : k=1  ' right
    if key[38] then y+=m : k=1  ' up
    if key[40] then y-=m : k=1  ' down
    if key[33] then z-=m : k=1  ' PgUp
    if key[34] then z+=m : k=1  ' PgDn
    end scope
  end if
  end macro


  class MoveableObject
  ====================
  float  x,y,z    'position
  sys    render   'rendering call
  vector s        'scale
  vector a        'angle
  vector aa       'angle anchor
  vector sa       'scale anchor
  vector d        'mouse drag
  int    id       'identity for picking
  char   name[32] 'name
  float  snap     'snap to grid resolution
  int    mode     'keyboard and mouse movement modes
  int    locked   'movement & scaling locked
  int    n        'count of pp indexes   
  word   pp[32]   'indexes to other objects
  '
  method set(sys ii,rr,float xx,yy,zz)
  method act()
  '
  end class 'moveable object

  class moveableObjects
  =====================
  moveableObject*mo
  int qo
  '
  method constructor(int n)
  method destructor()
  method index(int n) as MoveableObject*
  '
  end class 'moveable objects

  ! sub TouchZone(optional float v)

  macro Usermovement(a,c,n,nm,  i,k)
  ==================================
  if opening
    #ifndef n
      %n=1 'default single object
    #endif
    #ifndef nm
      %nm=""
    #endif
    static MoveableObject a[n] 'n moveable objects
    '#recordof a
    '#recordof moveableobject
    scope
      int k=c
      int i
      for i=1 to n             'number of objects
        a[i].mode=0x101        'key and mouse mode
        a[i].s={1.0,1.0,1.0} 'default scales
        a[i].id=k              'id of object
        a[i].name=nm
        k+=100 'addition to base ID
      next
    end scope
  endif
  #if n=1
    a.act()
  #endif
  end macro

  '#recordof usermovement



  'CONDITIONAL/DEFAULT EQUATES
  '
  %% title  "OpenGl Scene"
  '
  '#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

  
#ifndef CustomWndProc 'default

  ! function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback

#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


