  'SHAPES.INC

  sub ConeFaces(int n,float rr,ry,sm,optional int wr)
  ===================================================
  'N FACETS  R2/R1  RY RX=1  Y=1
  float nx,ny,nz,rx,a,b
  a=360/n
  rx=tan(pi/n)
  'SQUARES
  nx=rx*sm
  nz= sqr(1-nx*nx)
  'CALC NORMALS
  if rr=0 then 'CYLINDER
    ny=0
  elseif ry>=1.0 then 'STEEPER CONICS
    ny=rr/ry 'reduced y normal
  else 'rr>0 'FLATTER CONICS
    ny=1 : b=ry/rr : nx*=b : nz*=b 'reduced x z normals
  end if
  '
  int i, h,k
  if wr=0 then wr=4
  h=n/wr 'wrap=2 wrap texture twice
  float xt1,xt2,sx
  float j=0, m=wr/n, sg=1
  sx=rx*rr 'taper
  for i=1 to n
    'ConeNorm nx,ny,nz,rx,rx*rr,ry,rr
    xt1=j*m
    xt2=(j*m)+(m*sg)
    k++
    if k=h then
      sg=-sg
      k=0
    else
      j+=sg 'flip texture mapping
    end if
    glBegin GL_TRIANGLE_STRIP
      glTexCoord2f xt1, 0  : glNormal3f -nx,ny,nz : glVertex3f -rx , 0  , 1 
      glTexCoord2f xt2, 0  : glNormal3f  nx,ny,nz : glVertex3f  rx , 0  , 1
      glTexCoord2f xt1, ry : glNormal3f -nx,ny,nz : glVertex3f -sx , ry , rr
      glTexCoord2f xt2, ry : glNormal3f  nx,ny,nz : glVertex3f  sx , ry , rr 
     glEnd
    glRotatef a,0,1,0
  next
  end sub

  sub HemiSpheric(float rw, rh, m)
  ================================
  float s,c,r,r1,r2,x1,x2,y1,y2,z1,z2
  int e,i,j,st=m
  e=90-st
  for j=0 to e step st
    r=rad(j)    : r1=rw*cos(r) : y1=rh*sin(r)
    r=rad(j+st) : r2=rw*cos(r) : y2=rh*sin(r)
    glBegin GL_TRIANGLE_STRIP
    for i=0 to 360 step st
      r=rad(i)
      c=cos(r) : s=-sin(r)
      x1=r1*c  : z1=r1*s
      x2=r2*c  : z2=r2*s
      glNormal3f x2, y2, z2
      glVertex3f x2, y2, z2
      glNormal3f x1, y1, z1
      glVertex3f x1, y1, z1
    next
    glEnd
  next
  end sub

  sub spheric(float rw,rh,m)
  ==========================
  glPushMatrix
  hemispheric   rw, rh, m
  glRotatef     180,1,0,0
  hemispheric   rw, rh, m
  glPopMatrix
  end sub

  sub CubicSectMap(vector *v,int n)
  =================================
  'requires (n*3+3)^2 * 4 bytes
  'if n=4 then bytes 15*15*4 = 225*4 = 900 bytes
  int   i,j
  float st=1/n
  float w,x,y,z
  int m=n+1
  for j=1 to m
    x=0
    for i=1 to m
      w=1/sqr(x*x+y*y+1.0) '1/(distance to centre of cube)
      'unity radius adjustment
      v={x*w,y*w,w}
      @v+=sizeof vector
      x+=st
    next
    y+=st
  next
  end sub


  function pointdist(float x1,y1,z1,x2,y2,z2) as float
  ====================================================
  float x,y,z
  x=x2-x1 : y=y2-y1 : z=z2-z1
  return sqrt(x*x+y*y+z*z)
  end function


  function NoiseB(float fv) as float
  ==================================
  static double d=1/0xffffffff
  int v=abs(fv)*1000
  mov eax,v
  rol eax,5
  mul v
  xor eax,0x9595adad
  mul v
  rol eax,3
  mov v,eax
  return d*v 'range +1 to -1
  end function
  '
  sub CubicFace(int n, float ns=0, int mo=0,st=0,en=0)
  ====================================================
  int   i,j
  float u,v,w,x,ya,yb,z,sc,su,sv
  if st=0 and en=0
    st=-n : en=n
  end if
  sc=pi/(n*4)
  su=.5*(en-st)/(n*n)
  'su=1./n
  sv=su
  float w1,w2,x1,y1,z1,x2,y2,z2,u1,u2,v1,v2
  v=st/(n*n)
  v1=v
  for j=st to <en
    u= st/(n*n)
    u1=u
    if v1+sv<0 or v1+sv>1.0 then sv=-sv
    v2=v1+sv
    if not mo
      glBegin GL_TRIANGLE_STRIP
    else
      glBegin GL_LINE_STRIP
    end if
    ya=tan(j*sc)
    yb=tan(j*sc+sc)
    for i=st to en
      x=tan(i*sc)
      w1=sqr(x*x+ya*ya+1.0) '(distance to centre of cube)
      w1=1/(w1+ns*noiseB w1)
      w2=sqr(x*x+yb*yb+1.0) '(distance to centre of cube)
      w2=1/(w2+ns*noiseB w2)
      'radius adjustment
      x1=x*w1
      x2=x*w2
      y1=ya*w1
      y2=yb*w2
      z1=w1
      z2=w2
      glTexCoord2f u1,v2 : glNormal3f x2,y2,z2 : glVertex3f x2,y2,z2
      glTexCoord2f u1,v1 : glNormal3f x1,y1,z1 : glVertex3f x1,y1,z1
      if mo
        glTexCoord2f u1,v2 : glNormal3f x2,y2,z2 : glVertex3f x2,y2,z2
      end if
      if u1+su<0 or u1+su>1.0 then su=-su
      u1+=su
    next
    glEnd
    v1=v2
  next
  end sub


  sub rotatexy(float *x,*y,a)
  ===========================
  double r
  r=hypot(x,y)
  if r=0 then exit sub
  a+=atan(y,x)
  x=r*cos(a)
  y=r*sin(a)
  end sub

  sub Toroid(single major1 , minor1, major2 , minor2, ro, yd)
  ===========================================================
  '   start size       end size         roations displacement
  '
  static as double
  twopi=pi()*2,MajorRes=32,MinorRes=32,iMajorRes=1/32,iMinorRes=1/32,ij
  '
  static as single
  a, b, s, t, x, y, z, nx, ny, nz, gscale,tmc,tmd,tme,major,minor,ja
  '
  static as int
  i,j,k,ie,je
  '
  ie=MajorRes-1
  je=ro*MajorRes
  ij=1/je
  for i = 0 to ie
    glBegin GL_TRIANGLE_STRIP
    for j = 0 to je
      ja=j*ij
      for k = 1 to 0 step -1
        '
        'SIZE TRANSITION
        major=major1*(1-ja)+major2*ja
        minor=minor1*(1-ja)+minor2*ja
        '
        s = mod( i+k,MajorRes + 0.5)
        t = mod(j,MinorRes)
        '
        'CALCULATE POINT ON SURFACE
        tmd=s*twopi*iMinorRes
        tme=t*twopi*iMajorRes
        tmc=major+minor * cos(tmd)
        x = tmc   * cos(tme)
        y = minor * sin(tmd)
        z = tmc   * sin(tme)
        '
        'CALCULATE SURFACE NORMAL
        nx=x-(major * cos(tme)) 'anchor to minor centre
        nz=z-(major * sin(tme)) '
        ny = y
        glNormal3f nx,ny,nz
        y+=yd*ja 'y helical vertical displacement
        glVertex3f x,y,z
      next
    next
    glend
  next
  end sub


  sub Torus(single major, minor)
  ==============================
  toroid major,minor,major,minor,1,0
  end sub



