extra/math/vectors/homogeneous/homogeneous.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: kernel math math.vectors sequences ;
   3 IN: math.vectors.homogeneous
   4
   5 : (homogeneous-xyz) ( h -- xyz )
   6     1 head* ; inline
   7 : (homogeneous-w) ( h -- w )
   8     peek ; inline
   9
  10 : h+ ( a b -- c )
  11     2dup [ (homogeneous-w) ] bi@ over =
  12     [ [ [ (homogeneous-xyz) ] bi@ v+ ] dip suffix ] [
  13         drop
  14         [ [ (homogeneous-xyz) ] [ (homogeneous-w)   ] bi* v*n    ]
  15         [ [ (homogeneous-w)   ] [ (homogeneous-xyz) ] bi* n*v v+ ]
  16         [ [ (homogeneous-w)   ] [ (homogeneous-w)   ] bi* * suffix ] 2tri
  17     ] if ;
  18
  19 : n*h ( n h -- nh )
  20     [ (homogeneous-xyz) n*v ] [ (homogeneous-w) suffix ] bi ;
  21
  22 : h*n ( h n -- nh )
  23     swap n*h ;
  24
  25 : hneg ( h -- -h )
  26     -1.0 swap n*h ;
  27
  28 : h- ( a b -- c )
  29     hneg h+ ;
  30
  31 : v>h ( v -- h )
  32     1.0 suffix ;
  33
  34 : h>v ( h -- v )
  35     [ (homogeneous-xyz) ] [ (homogeneous-w) ] bi v/n ;
  36