extra/jamshred/oint/oint.factor

   1 ! Copyright (C) 2007 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
   4 IN: jamshred.oint
   5
   6 ! An oint is a point with three linearly independent unit vectors
   7 ! given relative to that point. In jamshred a player's location and
   8 ! direction are given by the player's oint. Similarly, a tunnel
   9 ! segment's location and orientation are given by an oint.
  10
  11 TUPLE: oint location forward up left ;
  12 C: <oint> oint
  13
  14 : rotation-quaternion ( theta axis -- quaternion )
  15     swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ;
  16
  17 : rotate-vector ( q qrecip v -- v )
  18     v>q swap q* q* q>v ;
  19
  20 : rotate-oint ( oint theta axis -- )
  21     rotation-quaternion dup qrecip pick
  22     [ forward>> rotate-vector >>forward ]
  23     [ up>> rotate-vector >>up ]
  24     [ left>> rotate-vector >>left ] 3tri drop ;
  25
  26 : left-pivot ( oint theta -- )
  27     over left>> rotate-oint ;
  28
  29 : up-pivot ( oint theta -- )
  30     over up>> rotate-oint ;
  31
  32 : forward-pivot ( oint theta -- )
  33     over forward>> rotate-oint ;
  34
  35 : random-float+- ( n -- m )
  36     #! find a random float between -n/2 and n/2
  37     dup 10000 * >fixnum random 10000 / swap 2 / - ;
  38
  39 : random-turn ( oint theta -- )
  40     2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
  41
  42 : go-forward ( distance oint -- )
  43     [ forward>> n*v ] [ location>> v+ ] [ (>>location) ] tri ;
  44
  45 : distance-vector ( oint oint -- vector )
  46     [ location>> ] bi@ swap v- ;
  47
  48 : distance ( oint oint -- distance )
  49     distance-vector norm ;
  50
  51 : scalar-projection ( v1 v2 -- n )
  52     #! the scalar projection of v1 onto v2
  53     tuck v. swap norm / ;
  54
  55 : proj-perp ( u v -- w )
  56     dupd proj v- ;
  57
  58 : perpendicular-distance ( oint oint -- distance )
  59     tuck distance-vector swap 2dup left>> scalar-projection abs
  60     -rot up>> scalar-projection abs + ;
  61
  62 :: reflect ( v n -- v' )
  63     #! bounce v on a surface with normal n
  64     v v n v. n n v. / 2 * n n*v v- ;