// Arrows
// Last edited on 2013-01-22 01:49:59 by stolfilocal

#include "transforms.inc"

#macro arrow(va,ra,sh,rh,rt)
  // An arrow from origin to given point.
  // {va} Coords of tip of arrow.
  // {ra} Radius of shaft (must be positive).
  // {sh} Length of head before fattening (must be positive).
  // {rh} Radius of base of head before fattening (must be at least {ra-rt}).
  // {rt} fattening of head (must be non-negative).
  
  // The arrow's skeleton will be the union of a line segment and a cone,
  // together spanning from the origin ro {va}.
  // The cone will usually have height {sh} and base radius {rh}, but will 
  // be clipped at the base so that its height does not exceed {|va|}.
  // The skeleton shaft is then fattened by {ra} in all directions except forward.
  // The skeleton head is fattened by {rt} in all directions.
  // Therefore the arrow will actually extend by distance {ra} backwards
  // and {rt} forwards beypnd the segment from origin to {va}.
  
  #if (ra <= 0)     #error concat("arrow shaft radius ",   str(ra,1,8), " should be positive\n") #end
  #if (sh <= 0)     #error concat("arrow head length ",    str(sh,1,8), " should be positive\n") #end
  #if (rh+rt <= ra) #error concat("arrow head radius ",    str(rh,1,8), " too small\n") #end
  #if (rt <  0)     #error concat("arrow head fattening ", str(rt,1,8), " should be non-negative\n") #end
  
  #local da = vlength(va); // Total length of arrow.
  #local rm = max(ra,rt);
  #if (da <= 0.001*rm)
    // The arrow is just a ball:
    sphere{ 0, rm }
  #else
    #if (sh > da)
      // Truncate the head maintaining the shape:
      #local rh = rh*da/sh;
      #local sh = da;
    #end
    #if (max(rh,sh)+rt <= 1.001*ra)
      // The head is indistinguishable from the shaft:
      union{
        sphere{ 0, ra }
        cylinder{ 0,va, ra }
        sphere{ va, ra }
      }
    #else
      #local ua = va/da;
      #if (da-sh+ra <= 1.001*rt)
        // The shaft is practically invisible:
        object{ arrow_head(ua,da,sh,rh,rt) }
      #else
        // The shaft and head are visible
        #if (da-sh <= 0.001*ra)
          // The shaft is just a ball:
          #local shaft = sphere{ 0, ra }
        #else
          // The shaft is a fat cylinder
          #local vm = va*(da - sh)/da; // Coords of end of shaft.
          #local shaft = 
            union{
              sphere{ 0, ra }
              cylinder{ 0,vm, ra }
              #if (rh+rt < ra)
                // The head does not cover the tip of the fat shaft
                sphere{ vm, ra }
              #end
            }
        #end
        union{
          object{ shaft }
          object{ arrow_head(ua,da,sh,rh,rt) }
        }
      #end
    #end
  #end
#end

#macro arrow_head(ua,da,sh,rh,rt)
  // Head of arrowhead.
  // {ua} Unit direction vector of arrow.
  // {da} Distance from origin to tip of arrow (before fattening, must be positive).
  // {rt} Fattening radius (must be positive).
  // {sh} Length of head before fattening.
  // {rh} Radius of base of head before fattening (must be positive).
  #if (sh <= 0.001*rt)
    // The head is practially a fattened disk:
    #local head = object{ arrow_fat_disk(ua,da,rt,rh) }
  #else
    // Assume {rh} is significant.
    #local head = object{ arrow_fat_cone(ua,da,sh,rh,rt) }
  #end
  head
#end

#macro arrow_fat_disk(ua,da,rt,rh)
  // Degenerate (flat-disk) arrowhead.
  // {ua} Unit direction normal to disk.
  // {da} Distance from origin to center of disk (before fattening, must be positive).
  // {rt} Fattening radius (must be positive).
  // {rh} Radius of base of head before fattening (must be positive).
  
  union{
    cylinder{ -rt*ua, +rt*ua, rh }
    torus{ rh, rt Point_At_Trans(ua) } 
    translate da*ua
  }
#end

#macro arrow_fat_cone(ua,da,sh,rh,rt)
  // Typical arrowhead.
  // {ua} Unit direction vector of arrow.
  // {da} Distance from origin to tip of arrow (before fattening, must be positive).
  // {rt} Fattening radius (must be positive).
  // {sh} Length of head before fattening (must be positive).
  // {rh} Radius of base of head before fattening (must be positive).
  
  #local th = sqrt(sh*sh + rh*rh); // Generatrix of cone.
  #local fh = rh*rt/th;  
  #local gh = sh*rt/th;  
  
  #local vm = (da-sh-rt)*ua; // Center of base of fattened head.
  #local rm = rh;            // Bot radius of first cone.

  #local vn = (da-sh+fh)*ua; // Center of shared cone base.
  #local rn = rh + gh;       // Radius of shared cone base.
  
  #local vo = (da+fh)*ua;    // Center of top of second cone.
  #local ro = gh;            // Radius of top of second cone.
  
  union{
    sphere{ da*ua,rt }
    cone{ vm,rm, vn,rn }
    cone{ vn,rn, vo,ro }
    torus{ rh, rt Point_At_Trans(ua) translate (da-sh)*ua } 
  }
#end