
  sys ShaderError
  '
  '
  function instrword(string s,k) as sys
  =====================================
  sys a,e
  do
    a=instr a+1,s,k
    if a then
      if a>1
        if asc (s,a-1)>32 then continue do
      end if
      e=a+len k
      if asc(s,e)>32 then continue do
    end if
    exit do
  end do
  return a
  end function


  function replace(string s,f,r) as string
  ========================================
  if not f then return
  if not s then return
  sys ls=len s
  sys lf=len f
  sys lr=len r
  sys b=1,i=1,j=1
  sys lt,d
  string t
  do
    i=instr(b,s,f)
    if i=0 then exit do
    d=i-b+lr
    if lt<j+d-1
      t+=nuls ls*2 : lt=len t
    end if
    mid t,j,mid(s,b,i-b)+r
    j+=d
    b=i+lf
  end do
  return left t,j-1
  end function


  function GetShaderInfoLog(int shader,string *info) as sys
  =========================================================
  sys le,li
  'glGetShaderiv shader, GL_SHADER_SOURCE_LENGTH , le
  'print "Source length" le
  glGetShaderiv shader, GL_INFO_LOG_LENGTH , le
  'print "Log Length " le
  if le>1
    info=nuls le
    glGetShaderInfoLog shader, le, li, Info
    info = replace left(Info,li), chr(10), chr(13)+chr(10)
  end if
  return li 'log length
  end function


  function GetProgramInfoLog(int program,string *info) as sys
  ===========================================================
  sys le,li
  glGetProgramiv program, GL_INFO_LOG_LENGTH , le
  if le>1
    info=nuls le
    glGetProgramInfoLog program, le, li, Info
    info = replace left(Info,li), chr(10), chr(13)+chr(10)
  end if
  return li 'log length
  end function


  sub CompileShader(int typ, string s , int *h,*c)
  ================================================
  sys sa,sl
  h = glCreateShader typ
  sa = strptr s : sl=len s
  glShaderSource h, 1, @sa, @sl
  glCompileShader h
  glGetShaderiv h, GL_COMPILE_STATUS, c
  if c=0
    string vlog
    if GetShaderInfoLog(h,vlog)
      print vlog
    end if
    ShaderError=2
  end if
  end sub


  class ShaderProg
  ================
  '
  internal
    declare CreateShaderProg(ShaderProg*p) as sys
    declare ReleaseShaderProg(ShaderProg*p) as sys
  end internal
  '
  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()
  #ifdef shan
   indexbase 1
   shae+=1
   shan[shae]=@this
  #endif
  CreateShaderProg this
  end method
  '
  method use()
  glUseProgram ph
  end method
  '
  method release()
  ReleaseShaderProg this
  end method

  end class
  

  function CreateShaderProg(ShaderProg*p) as sys
  ==============================================
  'http://www.opengl.org/sdk/docs/tutorials/ClockworkCoders/loading.php
  '
  if p.vsrc="" or p.fsrc="" then
    ShaderError = 1
    jmp fwd done
  end if
  '
  CompileShader GL_VERTEX_SHADER, p.vsrc, p.vh, p.vc
  CompileShader GL_FRAGMENT_SHADER, p.fsrc, p.fh, p.fc
  if p.gsrc then
    CompileShader GL_GEOMETRY_SHADER, p.gsrc, p.gh, p.gc
  end if
  'if ShaderError then jmp fwd done
  '
  'LINKING SHADERS TO PROGRAM
  '
  p.ph = glCreateProgram
  glAttachShader p.ph, p.vh
  if p.gsrc then glAttachShader p.ph, p.gh
  glAttachShader p.ph, p.fh
  glLinkProgram p.ph
  sys linked
  glGetProgramiv p.ph, GL_LINK_STATUS, linked
  if not linked
    string infolog
    if GetProgramInfoLog(p.ph, infolog)
      print infolog
    end if
    ShaderError=3
  end if
  '
  done:
  return p.ph
  end function


  function ReleaseShaderProg(ShaderProg*p) as sys
  ===============================================
  if not p.ph then exit function
  if p.fc then glDetachShader p.ph, p.fh
  if p.gc then glDetachShader p.ph, p.gh
  if p.vc then glDetachShader p.ph, p.vh
  if p.fc then glDeleteShader p.fh
  if p.gc then glDeleteShader p.gh
  if p.vc then glDeleteShader p.vh
  glDeleteProgram p.ph
  p={"","","",0,0,0,0,0,0,0}
  end function
