  #compact
  includepath "$\inc\"
  % filename "t.exe"
 'uses RTL32
  % Title    "Vessels:    (left-click & right-click)"
  % Animated
  % ScaleUp
 '% PlaceCentral
 '% AnchorCentral

  uses ConsoleG

  %side 8

  indexbase 1

  type SurfacePoint
  =================
  float px,py,pz  'position
  float nx,ny,nz  'normal
  float tx,ty     'texture mapping
  end type

  sub ProfileNormXY(SurfacePoint*p,int n)
  =======================================
  'CREATE SMOOTH NORMALS
  int i,k
  double c,d,f
  for i=1 to n
    k=i+1
    if k>n then
      k=i-1
      p[i].nx=p[k].nx
      p[i].ny=p[k].ny
      exit for
    end if
    p[i].nx=1
    c=p[k].px-p[i].px
    d=p[k].py-p[i].py
    p[i].nx= d
    p[i].ny=-c
  next
  'ADJUST NORMALS: mean of 2 slopes
  for i=n-1 to 2 step-1
    k=i-1
    p[i].nx+=p[k].nx
    p[i].ny+=p[k].ny
    'UNITY ADJUST
    f=1/hypot(p[i].nx,p[i].ny)
    p[i].nx*=f
    p[i].ny*=f
  next
  end sub

  sub ProfileNormXZ(SurfacePoint*p,int n)
  =======================================
  'CREATE SMOOTH NORMALS
  sys i,k
  double c,d,f
  for i=1 to n
    k=i+1
    if k>n then
      k=1
    end if
    c=p[k].px-p[i].px
    d=p[k].pz-p[i].pz
    p[i].nx=-d
    p[i].nz= c
  next
  'ADJUST NORMALS: mean of 2 slopes
  for i=n to 1 step-1
    k=i-1
    if k<1 then k=n
    p[i].nx+=p[k].nx
    p[i].nz+=p[k].nz
    'UNITY ADJUST
    f=1/hypot(p[i].nx,p[i].nz)
    p[i].nx*=f
    p[i].nz*=f
  next
  end sub

  sub Vessel(SurfacePoint *p,*q, int m,n)
  =======================================
  float ps,pc,pr1,pr2,py1,py2,nr1,ny1,nr2,ny2
  int e,i,j,k,nc,ns
  e=m-1
  for j=1 to e
    k=j+1
    pr1=p[j].px : pr2=p[k].px
    py1=p[j].py : py2=p[k].py
    nr1=p[j].nx : nr2=p[k].nx
    ny1=p[j].ny : ny2=p[k].ny
    glBegin GL_TRIANGLE_STRIP
    for i=1 to n
      pc=q[i].px : ps=q[i].pz
      nc=q[i].nx : ns=q[i].nz
      glNormal3f nr2*nc, ny2, nr2*ns
      glVertex3f pr2*pc, py2, pr2*ps
      glNormal3f nr1*nc, ny1, nr1*ns
      glVertex3f pr1*pc, py1, pr1*ps
    next
    glEnd
  next
  end sub

  sub CircVessel(SurfacePoint *p, int n, st)
  ==========================================
  float s,c,r,pr1,pr2,py1,py2,nr1,ny1,nr2,ny2
  int e,i,j,k
  e=n-1
  for j=1 to e
    k=j+1
    pr1=p[j].px : pr2=p[k].px
    py1=p[j].py : py2=p[k].py
    nr1=p[j].nx : nr2=p[k].nx
    ny1=p[j].ny : ny2=p[k].ny
    glBegin GL_QUAD_STRIP
    for i=0 to 360 step st
      r=rad(i) : c=cos(r) : s=-sin(r) 'back first, anticlockwise
      glNormal3f nr2*c, ny2, nr2*s
      glVertex3f pr2*c, py2, pr2*s
      glNormal3f nr1*c, ny1, nr1*s
      glVertex3f pr1*c, py1, pr1*s
    next
    glEnd
  next
  end sub

  type celltype
  =============
  int   a,n
  int   x,y,z
  float px,py,pz
  float tx,ty,tz
  end type

  sys sseed=GetTickCount
  celltype cell[side*side*side]
  sys      vsphere,vess

  sub initcells()
  ===============  
  int r,x,y,z
  'seed=0x2468abcd
  seed=sseed
  celltype *c
  @c=@cell
  for z=1 to side
    for y=1 to side
      for x= 1 to side
        r=irnd(1,5)
        c.x=x
        c.y=y
        c.z=z
        c.a=r
        c.n=z*64+y*side+x-side
        c.px= rnd()*32
        c.py= rnd()*32
        c.pz=-arnd()*100+10
        @c+=sizeof cell
      next
    next
  next
  end sub

  initcells()

  function GameLogic(int i,optional a) as sys
  ===========================================
  '
  if not i then exit sub
  cell[i].a=0
  return 1
  end function

  static float ay

  sub render(int i)
  =================
  sys a
  celltype c at (@cell[i])
  a=c.a
  if a then
    glpushmatrix
    move c.px+c.tx, c.py+c.ty, c.pz+c.tz
    glrotatef ay,0,1,0
    if pick then
      label i
      go vsphere 'crude bounding sphere
    else
      select a
      case 1 : Material RedShiny
      case 2 : Material BlueShiny
      case 3 : Material WhiteShiny
      case 4 : Material Silver
      case 5 : Material Gold
      end select
      'REDUCE TRANSITION DISTANCE
      'if c.tx then c.tx*=.75
      'if c.ty then c.ty*=.75
      'if c.tz then c.tz*=.75
      'go sphere
      'go vsphere
      'go cube
      go vess
    end if
    glpopmatrix
   end if
  end sub

  sub main()
  ==========
  static SurfacePoint p[400]
  static SurfacePoint q[400]
  static sys i,j,m,n
  static float a,b,c
  '
  if not vsphere then
    'CRUDE SPHERE
    vsphere   = CompileList : Spheric 1,1,45 : glEndList
  end if
  '
  if not vess then
    '
    'CREATE VERTICAL SHAPE PROFILE
    m=10
    p[1].px=.99  : p[1].py=-2
    p[2].px=.99  : p[2].py=-1.9
    p[3].px=.2   : p[3].py=-1.8
    p[4].px=.1   : p[4].py=-1.6
    p[5].px=.1   : p[5].py=-1
    p[6].px=.30  : p[6].py=-.5
    p[7].px=.70  : p[7].py=0
    p[8].px=.99  : p[8].py=1
    p[9].px=.99  : p[9].py=1.5
    p[10].px=.80 : p[10].py=2
    ProfileNormXY(p,m)
    '
    'CREATE HORIZONTAL SHAPE PROFILE
    n=121
    j=0
    for i=1 to n
      a=rad(j)
      b=rad(j*12)
      c=1+.03125*sin(b)
      j+=3
      q[i].px=  cos(a)*c
      q[i].pz= -sin(a)*c
    next
    ProfileNormXZ(q,n)
    '
    'vess = CompileList : CircVessel p,m,15 : glEndList
    vess = CompileList : Vessel p,q,m,n : glEndList
  end if
  '
  static float az
  static sys   pki,count
  glClearColor 0,0.1,0.2,0
  if pick then
    PickSetup
  else
    'Fog 0,0.10,0.2,0.025 'FOR SENSE OF DISTANCE
    '
  end if
  '
  move 16,-16,-4
  'rotatez az : az+=.03125
  scale 2
  '
  'DISPLAY
  int a,i,x,y
  static int en=side*side*side
  pushstate
  for i=1 to en
    render i
  next
  ay+=.5
  popstate
  '
  popstate 'whole
  '
  if picked then
    GameLogic(picked)
    'pki=cell[picked].n
    pki=picked
    count++
    picked=0
  end if
  '
  end sub

  EndScript
