
  sub partno(sys n)
  =================
  if picklevel then glLoadName n
  end sub

  sub orthopersp(sys p)
  =====================
  '
  double m,n
  n=orthosize
  m=n*aspect
  '
  if p then
    glOrtho  -m, m, -n, n, 1.0, 100.0 'left right bottom top near far
  else
    'if using glu
    'gluPerspective 45.0, aspect, 1, 100.0 'viewAngle,aspect,near,far
    'otherwise:
    single xmin, xmax, ymin, ymax
    single znear=1,zfar=100.0,fovy=45.0
    ymax = zNear * tan(fovy *pi /360.0)
    ymin = -ymax
    xmin = ymin * aspect
    xmax = ymax * aspect
    glFrustum xmin, xmax, ymin, ymax, zNear, zFar
  end if
  end sub
  '
  sub SetProjection(sys p)
  ========================
  '
  glMatrixMode GL_PROJECTION
  glLoadIdentity
  orthopersp(p)
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  end sub

  '
  sub StandardMaterial()
  ======================
  '
  glColor4fv surface_diffuse
  glMaterialfv GL_FRONT, GL_DIFFUSE,   surface_diffuse
  glMaterialfv GL_FRONT, GL_AMBIENT,   surface_ambient
  glMaterialfv GL_FRONT, GL_SPECULAR,  surface_specular
  glMaterialf  GL_FRONT, GL_SHININESS, surface_shininess
  end sub


  sub Lighting()
  ==============
  '
  glPolygonMode GL_FRONT_AND_BACK, GL_FILL
  '
  glLightfv GL_LIGHT1, GL_POSITION, light_position
  glLightfv GL_LIGHT1, GL_DIFFUSE,  light_diffuse
  glLightfv GL_LIGHT1, GL_AMBIENT,  light_ambient
  glLightfv GL_LIGHT1, GL_SPECULAR, light_specular
  '
  glEnable GL_LIGHT1
  '
  end sub
  '
  sub SetMaterial(single* ma)
  ===========================
  glMaterialfv GL_FRONT, GL_DIFFUSE,   ma[1]
  glMaterialfv GL_FRONT, GL_AMBIENT,   ma[5]
  glMaterialfv GL_FRONT, GL_SPECULAR,  ma[9]
  glMaterialf  GL_FRONT, GL_SHININESS, ma[13]
  end sub


  sub PickPrep() as sys
  =====================
  '
  glInitNames()
  glSelectBuffer (SelectBufSize, selectBuf)
  '
  glRenderMode(GL_SELECT)
  '
  glPushName(-1) 'an arbitrary value
  '
  glMatrixMode(GL_PROJECTION)
  glLoadIdentity()
  gluPickMatrix( mposx, mposy, 2.0, 2.0, @viewport) 'pixel selection zone
  orthopersp projmode
  glMatrixMode(GL_MODELVIEW)
  glpushmatrix
  end sub



  function PickResult() as sys
  ============================
  '
  SelObject=0
  glPopName()
  hits=glRenderMode(GL_RENDER)
  '
  '--------------------
  'nearest named object
  '--------------------
  '
  sys v=0x7fffffff, w=-1, i=1, c=hits*4
  '
  while i<c
   '
   if nearest then
     if SelectBuf(i+1)<=v then
       v=SelectBuf(i+1)
       w=SelectBuf(i+3) 'resolve by depth order
     end if
   else
     if SelectBuf(i+3)>w then
       w=SelectBuf(i+3) 'resolve by name order
     end if
   end if
   '
   i+=SelectBuf(i)+3
   '
  wend
  '
  if w>=0 then SelObject=w
  '
  SetProjection projmode
  glPopMatrix
  '
  return w
  '
  end function


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

  function GetWordArea(string s, single *x,*y)
  ============================================
  /*
  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
  x=0 : y=gmf[77].gmfCellIncY
  sys a,b,e=len s
  for b=1 to e
    a=asc(s,b)
    x+=gmf[a].gmfCellIncX
    'x-=gmf[a].gmfptGlyphOrigin.x
    'x+=gmf[a].gmfBlackBoxX
  next
  end function


  function RenderText(string s, single x, y, w)
  =============================================
  '
  if not len s then exit sub
  glPushAttrib GL_LIST_BIT
  glPushMatrix
  glLoadIdentity
  glListBase 1000
  glTranslatef x, y, -1
  glscalef w, w*.75, 0.01
  glpushMatrix
  glCallLists len(s), GL_UNSIGNED_BYTE, strptr s
  glPopMatrix
  glPopMatrix
  glPopAttrib
  end function


  function PutBoxArea(single x,y,w,h)
  ===================================
  '
  glPushMatrix
  glLoadIdentity
  gltranslatef x,y-h*.25,-1.0
  glbegin GL_QUADS
  'clockwise
  glvertex3f 0, 0, 0
  glvertex3f 0, h, 0
  glvertex3f w, h, 0
  glvertex3f w, 0, 0
  glend
  glpopmatrix
  end function


  sub SetClipPlanes(single vpr)
  =============================
  '
  static double clip_plane1[4],clip_plane2[4],clip_plane3[4],clip_plane4[4]
  '
  clip_plane1<=  1.0,  0.0,  0.0, vpr  'clip left
  clip_plane2<= -1.0,  0.0,  0.0, vpr  'clip right
  clip_plane3<=  0.0,  1.0,  0.0, vpr  'clip below
  clip_plane4<=  0.0, -1.0,  0.0, vpr  'clip above
  '0..5 AVAILABLE
  glClipPlane GL_CLIP_PLANE1,clip_plane1
  glClipPlane GL_CLIP_PLANE2,clip_plane2     
  glClipPlane GL_CLIP_PLANE3,clip_plane3
  glClipPlane GL_CLIP_PLANE4,clip_plane4
  '
  glEnable GL_CLIP_PLANE1
  glEnable GL_CLIP_PLANE2
  glEnable GL_CLIP_PLANE3
  glEnable GL_CLIP_PLANE4
  end sub

  sub DisClipPlanes()
  ===================
  glDisable GL_CLIP_PLANE1
  glDisable GL_CLIP_PLANE2
  glDisable GL_CLIP_PLANE3
  glDisable GL_CLIP_PLANE4
  end sub

  Sub SetBackGround(single x,y,z)
  ===============================
  glbegin GL_QUADS
  glvertex3f -x, -y, z
  glvertex3f  x, -y, z
  glvertex3f  x,  y, z
  glvertex3f -x,  y, z
  glend
  end sub

  sub SetBorder(single x,y,z)
  ===========================
  glbegin GL_LINE_STRIP
  glvertex3f -x, -y, z
  glvertex3f  x, -y, z
  glvertex3f  x,  y, z
  glvertex3f -x,  y, z
  glvertex3f -x, -y, z
  glend
  end sub


  sub DrawBar(single x,y,z)
  =========================
  single w=x-.02
  glbegin GL_QUADS
  glvertex3f -x, -y, z
  glvertex3f -w, -y, z
  glvertex3f -w,  y, z
  glvertex3f -x,  y, z
  glend
  end sub    


  '--------------------------------
  sub ViewFromHere(double *x,*y,*z)
  =================================
  ppx=mposx
  ppy=mposy
  '
  'glMatrixMode GL_MODELVIEW
  glGetIntegerv(GL_VIEWPORT, viewport)
  glLoadIdentity
  gluLookAt (
  x,    y,   z,    'Eye Position
  0.0,  0.0, 0.0,  'Target View-point
  0.0,  1.0, 0.0   'Up-vector
  )
  'gltranslatef 0,0,-z

  '
  if objectr then
    if picklevel then
      PickPrep
      RenderView
      PickResult
    end if
    RenderView
  end if
  '
  end sub


  ' DrawBorder() - Draw a 2D border (used for orthogonal views)
  '
  sub DrawBorder( byval gscale as single, st as long )
  ====================================================
  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 long
  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( single gscale, long gsteps)
  =========================================

  dim as long 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

  sys g,h
  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


  function TakeSnapShot(sys hwnd,string fname,typimg, sys quality, optional tr,gl) as sys
  '======================================================================================
  '
  'itr problem with resize
  '
  'typimg: image/jpeg image/png image/gif image/tiff image/bmp
  'quality: 1..100
  '
  sys hstatus,width,height,pBitmap,hDC
  RECT r
  hDC=GetDC hwnd
  GetClientRect hwnd, @r
  width   = r.right - r.left
  height  = r.bottom - r.top
  'http://www.jose.it-berater.org/gdiplus/reference/constants/gdipimagepixelformatconstants.htm
  % PixelFormat24bppRGB  137224
  % PixelFormat32bppARGB 2498570
  'http://forums.purebasic.com/english/viewtopic.php?p=205981
  'GpStatus WINGDIPAPI GdipCreateBitmapFromScan0(int width, height, stride, pixelformat, BYTE* scan0, GpBitmap** bitmap)
  if tr
    pf=PixelFormat32bppARGB
  else
    pf=PixelFormat24bppRGB
  end if
  a=@GdipCreateBitmapFromScan0
  call a width,height,0,pf,0,@pBitmap
  sys b,c,p,q,x,y
  #define GL_BGRA                           0x80E1
  p=getmemory width*sizeof glint
  if tr
    if gl
      glReadPixels 0,0,1,1,GL_BGRA,GL_UNSIGNED_BYTE,p
      b=*p and 0xffffff 'assume uniform background
    else
      b=0xffffff and GetPixel hDC,1,1
    end if
  end if
  for y=0 to <height
    if gl
      glReadPixels 0,y,width,1,GL_BGRA,GL_UNSIGNED_BYTE,p
    end if
    q=p
    for x=0 to <width
      if gl
        c=*q
      else
        c=GetPixel hDC x,y
      end if
      if tr
        if b=(c and 0xffffff)
          c and =0xffffff 'make pixel transparent
        end if
      end if
      if gl
        GdipBitmapSetPixel pBitMap,x,height-y-1,c 'REVERSE Y
        q+=4
      else
        GdipBitmapSetPixel pBitMap,x,y,c
      end if
    next   
  next
  freememory p
  if pBitMap then
    SaveImage fname,typimg,quality,pBitMap
    GdipDisposeImage pBitMap
  end if
  ReleaseDC hDC
  end function
  '


