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     but-last ; inline
   7
   8 : (homogeneous-w) ( h -- w )
   9     last ; inline
  10
  11 : h+ ( a b -- c )
  12     2dup [ (homogeneous-w) ] bi@ over =
  13     [ [ [ (homogeneous-xyz) ] bi@ v+ ] dip suffix ] [
  14         drop
  15         [ [ (homogeneous-xyz) ] [ (homogeneous-w)   ] bi* v*n    ]
  16         [ [ (homogeneous-w)   ] [ (homogeneous-xyz) ] bi* n*v v+ ]
  17         [ [ (homogeneous-w)   ] [ (homogeneous-w)   ] bi* * suffix ] 2tri
  18     ] if ;
  19
  20 : n*h ( n h -- nh )
  21     [ (homogeneous-xyz) n*v ] [ (homogeneous-w) suffix ] bi ;
  22
  23 : h*n ( h n -- nh )
  24     swap n*h ;
  25
  26 : hneg ( h -- -h )
  27     -1.0 swap n*h ;
  28
  29 : h- ( a b -- c )
  30     hneg h+ ;
  31
  32 : v>h ( v -- h )
  33     1.0 suffix ;
  34
  35 : h>v ( h -- v )
  36     [ (homogeneous-xyz) ] [ (homogeneous-w) ] bi v/n ;