  '#compact
  $ FileName  "t.exe"
  'uses rtl32
  'uses rtl64
  '
  % ExplicitMain
  % title        "Fresnel B"
  % fontA        "Arial",FW_SEMIBOLD

  macro keydown
  case 27 : 'ESC   no action / default close program
  case 32 : 'SPACE no action / default pause (toggle)
  end macro
  '
  uses OpenglSceneFrame
  uses glo2\shapes
  uses glo2\materials

=============================================================

  class FresnelClass
  ==================
  '
  sys     nr_coor
  sys     i
  double  valA, valB 
  double  x ,y ,z ,m, n, mz, nz
  vector  *cov
  static double  pi2,pi4
  '
  'internal
  '
  macro theta()
  'n=mod(n+pi2*vala,pi2)
  'n=mod(n+vala,1.0)
  n=frac(n+vala)
  end macro

  macro thetaz()
  'nz=mod(nz+pi2*valb,pi2)
  'nz=mod(nz+valb,1.0)
  nz=frac(nz+valb)
  end macro
  
  macro phi ()
  '
  'm = Mod(n+m,pi2)
  'm=mod(m+n,1.0)
  m=frac(m+n)
  x+=Cos(m*pi4)
  y+=Sin(m*pi4)
  'mz= Mod(nz+mz,pi2) 
  'z=z+(Sin(mz)*pi2/4)
  mz=frac(nz+mz)
  z=z+Sin(mz*pi4)
  end macro 
  '
  'end internal
  '
  method comp()
  x=0 : y=0 : z=0 : n=0 
  m=0 : nz = 0 : mz=0
  Vector c at (@cov)
  for i=1 To nr_coor
    theta()
    thetaz()
    phi()
    c = {x,y,z}
    @c+=sizeof cov
  next 
  end method
 
      
  method SetCenter(sys member) 'x:0   y:1  z:2
  double mini , maxi , center
  mini=100000
  maxi=-100000
  float c at @cov+member*4
  for i=1 To nr_coor
    if c > maxi Then maxi = c
    if c < mini Then mini = c
    @c+=sizeof cov
  next
  @c=@cov+member*4   
  center= (maxi+mini)/2
  for i=1 To nr_coor
    c=c-center
    @c+=sizeof cov
  next
  end method 

  method Build(vector*c,long *n, optional double *va,*vb, sys centre)
  '
  pi2=pi*2
  pi4=pi*4
  '
  @cov=@c
  nr_coor=n
  valA=va
  valB=vb
  comp()
  if centre then
   setCenter 0 'x
   setCenter 1 'y
   setCenter 2 'z
  end if
  
  vector c at (@cov)
  for i=1 to Nr_Coor
    'glVertex3fv cast(float) c 'pass whole vector byref
    glVertex3fv c 'pass whole vector byref
    @c+=sizeof c
  next
  end method

  end class


  '#recordof fresnelclass

  vector Frvec[500000]
  sys Fresnel    'Compiled List
  sys frn        'Number of points
  double frA,frB 'coefficients
  FresnelClass fr'computing object

  frA=sqrt(333)
  frB=exp(1)
  frn=12000
  '  
  sub fresgen()
  =============
  '
  static sys    plot=0x46
  static sys    centre=0, nc, np
  static double fri=2.0e-10
  '
  'CUSTOMISED KEYBOARD ACTIONS
  '
  if not key[VK_CONTROL] then
    if key[0x50] then plot=0x50 'P points
    if key[0x4c] then plot=0x4c 'L line
    if key[0x46] then plot=0x46 'F face
    if key[0x43]                'C toggle Centralise
      if nc=0 then centre=1-centre : nc=1
    else
      nc=0
    end if 
  end if
  if key[32] then
    if not np then pause=1-pause : np=1 'SPACEBAR TOGGLE PAUSE
  else
    np=0
  end if
  if not pause then
    if key[0xBB] then fri*=1.005
    if key[0xBD] then fri/=1.005
    frA=frA+fri
  end if
  '
  'GENERATE OPENGL SHAPE
  '
  select plot
  case 0x50 : glBegin GL_POINTS
  case 0x4c : glBegin GL_LINE_STRIP
  case 0x46 : glBegin GL_QUAD_STRIP
  end select
  FresnelClass fr
  fr.Build FrVec,frn,frA,frB,centre
  glEnd
  end sub

=============================================================

'DISPLAYED INFO

  sub DisplayInfo()
  =================
  glColor3f    .99,.99,.00
  gprint       "Shape: "
  glColor3f    .99,.99,.99
  gprint       picked 
  if picked=4 then gprint "  A: " frA
  end sub

  sub DisplayHelp() 'F1
  =====================
  if not key[VK_F1] then return
  glLoadIdentity
  gltranslatef -.5,.35,-1.0
  glscalef     .04,.04,.01
  glColor3f    .99,.99,.00
  gprint "",1
  gprint       "Help: ",1
  glscalef .70,.70,1
  gprint "Alt F4   quit",1
  gprint "Space   pause",1
  gprint "+   increase step size",1
  gprint "-   reduce step size",1
  gprint "P   points",1
  gprint "L   lines",1
  gprint "F   faces",1
  gprint "C   Centralise form (toggle)",1
  gprint "Ctrl-P   Snapshot jpeg",1
  gprint "Arrow keys Pg keys move",1
  gprint "Ctrl-Arrow keys Pg keys   rotate",1
  gprint "Ctrl-Home   zero rotation",1
  gprint "Shift   faster movement",1
  gprint "",1
  gprint "Mouse (left button) to drag or rotate (with ctrl key)",1
  end sub

=============================================================


  'SCENE GLOBALS
  ==============

  indexbase 1
  sys    texn[16]     'ARRAY OF TEXTURE NUMBERS
  sys    GdiplusToken '
  float  ang1         'ANIMATION ANGLE
  sys    cmd          'COMMAND MESSAGE WPARAM
  sys   cube,sphere,tors,helix 'SHAPES
  sys   picknext

  %cone -1



'SCENE OBJECTS

  type ColorType float red,green,blue,alpha

  =================
  class SceneObject
  =================
  '
  float  x,y,z          'POSITION
  float  sc,rz,ry       'PROPORTIONS
  float  sm             'SMOOTHING
  sys    n              'FACETS
  sys    shape          'COMPILED LIST
  sys    shapeproc      'PROCEDURE
  '
  float  a.x,a.y,a.z    'ORIENTATION
  float  ax,ay,az       'ANCHOR ROTATION
  float  bx,by,bz       'ANCHOR POSITION
  '
  ColorType c
  float*ma 'materials
  '
  method setdi(float px,py,pz,psc,prz,pry,psm,pn)
  x=px : y=py : z=pz : sc=psc : rz=prz : ry=pry
  sm=psm 
  n=pn
  end method
  '
  method setma(float*m)
  @ma=@m
  end method
  '
  method setco(float r,g,b,a)
  c.red=r : c.green=g : c.blue=b : c.alpha=a
  end method
  '
  method setsh(sys s1, s2)
  shape=s1
  shapeProc=s2
  end method
  '
  method Render()
  if @ma 
    glEnable GL_LIGHTING
    material byval @ma
  else
    if c.alpha
     glDisable GL_LIGHTING
     'glcolor4fv cast(float) c
     glcolor4fv c
    end if
  end if
  glPushMatrix
  gltranslatef  x,y,z
  glrotatef     a.x,1,0,0 'rotate yz  : PITCH
  glrotatef     a.y,0,1,0 'rotate xz  : YAW
  glrotatef     a.z,0,0,1 'rotate xy  : ROLL
  glscalef      sc,sc,sc
  if shape=-1
    ConeFaces     n,rz,ry,sm
  elseif shape>0
    glCallList shape
  elseif shapeproc
    call shapeproc
  end if
  'a.y+=1 : if a.y=360 then a.y=0 'SPIN ANIMATION
  glPopMatrix
  end method
  '
  method anchor()
  ax=a.x : ay=a.y : az=a.z
  bx=x : by=y : bz=z
  end method
  '
  method move(single mx,my,mz)
  '
  x=bx+mx : y=by+my : z=bz+mz
  limit
  end method
  '
  method rotate(single mx,my,mz)
  '
  a.x=ax+mx : a.y=ay+my : a.z=az+mz
  end method
  '
  method limit()
  '
  float d=-z,id=-1/z
  if  x*id<-0.5 then x=-.5*d
  if  y*id<-0.4 then y=-.4*d
  if z>-1.0 then z=-1.0
  if x*id>.5  then x=.5*d
  if y*id>.4 then y=.4*d
  end method
  '
  method drag()
  '
  float dx,dy,dz
  dx=mposx-sposx
  dy=sposy-mposy
  if key[VK_CONTROL]
    'a.z=-dx : a.x=-dy
    'rotate(-0.5*dy,0.0,-0.5*dx)
    rotate(-0.5*dy,0.0,0.0)
  elseif key[VK_SHIFT]
    dx=mposx-sposx
    dz=(mposy-sposy)/crect.right   
    move 0,0,20*dz
  else
    dx=mposx-sposx
    dy=sposy-mposy
    dz=-z/crect.right
    move dx*dz,dy*dz,0
  end if
  end method
  '
  end class

=============================================================

'SCENE

  ========================
  sub initialize(sys hWnd)
  ========================
  '
  GDIplus 1
  '
  end sub


  =====================
  sub Release(sys hwnd)
  =====================
  '
  DeleteAllGlCompiled
  Gdiplus 0
  end sub

  ===================
  sub scene(sys hWnd)
  ===================
  '
  static single ra,ri,angi1=.5
  '
  '
  ActiveFrame
  glClearColor .05,.05,.20,.00
  'glClearColor 0.5, 0.5, 0.7, 0.0
  'Fog          0.5, 0.5, 0.7, 0.035 'rgb and density
  'BeginPick
  '
  StandardLighting li
  StandardMaterial ma
  'glEnable GL_TEXTURE_2D
  '
  sys   t1=texn[1] 'texture
  '
  '
  static SceneObject c[100]
  '
  'INITIAL DATA

  if not picknext
    '
    cube=CompileList    : CubeForm      : glEndList
    sphere=CompileList  : Spheric 1,1,6 : glEndList
    tors=CompileList    : torus 1.,.20  : glEndList
    helix=CompileList   : toroid 1.,.25,.8,.16,5.,6. : glEndList
    Fresnel=CompileList : Fresgen : glEndList

    'shape      x     y     z     sc   rz ry   sm n
    '
    c[6].setdi  6.5, -0.9, -16.0, 0.5, 0, 4. , 0, 4
    c[5].setdi  2.5, -0.9, -8.0 , 0.5, 0, 2. , 0, 10
    c[4].setdi  0.5, -0.9,-30.0 , 0.1, 0, 3. , 0, 15
    c[3].setdi -0.5, -0.6, -2.0 , 0.5,.5, 1. , 1, 30
    c[2].setdi -0.5, -0.1, -2.0 , .25,1., 2. , 1, 30
    c[1].setdi -0.5,  0.4, -2.0 , .25,0., 2. , 1, 30
    '
    'c[6].setsh cube,0
    'c[5].setsh helix,0
    'c[4].setsh fresnel,0 'precompiled list
    c[4].setsh 0,@fresgen 'build for each frame
    c[4].setco .00,.80,.80,.99 'color
    'c[3].setsh tors,0
    'c[2].setsh sphere,0
    'c[1].setsh cone,0
    '
    c[6].setma RedShiny
    c[5].setma BlackShiny
    'c[4].setma White
    c[3].setma Bronze
    c[2].setma Silver
    c[1].setma Gold
    picknext=7
    picked=4 'OBJECT 4 INITIALLY SELECTED
  end if 'INIT DATA
  '
  'PICK OR RENDER MODE
  '
  int a=lastkey-48
  select a
  case 1 to 6 : picked=a 'number keys 1..6
  end select
  '
  MoveObjectWithKeys c[picked], 0.01, 1.0
  '
  '
  'RESPOND TO MENU SELECTION
  '
  scope
  if cmd
    if picked
      if cmd=12
        if bleft or bright
          c[picked].anchor
          sposx=mposx : sposy=mposy
        end if
        goto ncmd
      end if
      float *m 'materials
      select cmd
      case 4021 : @m=@RedShiny
      case 4022 : @m=@BlackShiny
      case 4023 : @m=@Steel
      case 4024 : @m=@Bronze
      case 4025 : @m=@Silver
      case 4026 : @m=@Gold
      end select
      if @m
        c[picked].setma m
        goto ncmd
      end if
    end if
    '
    sys shape
    '
    select cmd
    case 4041 : shape=cube
    case 4042 : shape=cone
    case 4043 : shape=sphere
    case 4044 : shape=tors
    case 4045 : shape=helix
    end select
    if shape then
      if picked=0 then
        if picknext<=100 then
          picked=picknext
          c[picked].setdi -0.0, -0.0, -5.0 , 0.5,.5, 1. , 1, 30
          c[picked].setma Silver
          picknext++
        end if
      end if
      if picked then c[picked].setsh shape,0
    end if
  end if
  end scope
  ncmd:
  cmd=0 'FINISHED WITH COMMAND
  '
  'RENDER OBJECTS
  '
  sys i
  SceneObject *cc
  for i=1 to i<picknext
    PickLabel i
    @cc=@c[i]
    if bleft
      if picked=i
        cc.drag
      end if
    else
      cc.anchor
    end if
    cc.render 
  next 
  '
  'PRINTING INFO / LABELS
  '
  'glDisable GL_TEXTURE_2D
  glDisable GL_LIGHTING
  glPushMatrix
  glLoadIdentity
  gltranslatef -.5,.35,-1.0
  glscalef     .04,.05,.01
  scope
  float w,h
  if picked
    GetWordArea  "Shape:",w,h
    if pick
      'PickLabel ??
      'PutBoxArea   w,h
    else
      glLoadIdentity
      gltranslatef -.5,.35,-1.0
      glscalef     .04,.05,.01
      DisplayInfo
    end if
  end if
  end scope
  DisplayHelp
  glPopMatrix
  '
  'EndPick
  '
  end sub

  MainWindow width,height,WS_OVERLAPPEDWINDOW
