/unmaintained/jamshred/oint/oint.factor

 1! Copyright (C) 2007, 2008 Alex Chapman
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
 4IN: 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
11TUPLE: oint location forward up left ;
12C: <oint> oint
13
14: rotation-quaternion ( theta axis -- quaternion )
15    swap 2 / dup cos swap sin rot n*v first3 rect> [ rect> ] dip 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 * >integer random 10000 / swap 2 / - ;
38
39: random-turn ( oint theta -- )
40    2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
41
42: location+ ( v oint -- )
43    [ location>> v+ ] [ (>>location) ] bi ;
44
45: go-forward ( distance oint -- )
46    [ forward>> n*v ] [ location+ ] bi ;
47
48: distance-vector ( oint oint -- vector )
49    [ location>> ] bi@ swap v- ;
50
51: distance ( oint oint -- distance )
52    distance-vector norm ;
53
54: scalar-projection ( v1 v2 -- n )
55    #! the scalar projection of v1 onto v2
56    [ v. ] [ norm ] bi / ;
57
58: proj-perp ( u v -- w )
59    dupd proj v- ;
60
61: perpendicular-distance ( oint oint -- distance )
62    [ distance-vector ] keep 2dup left>> scalar-projection abs
63    -rot up>> scalar-projection abs + ;
64
65:: reflect ( v n -- v' )
66    #! bounce v on a surface with normal n
67    v v n v. n n v. / 2 * n n*v v- ;
68
69: half-way ( p1 p2 -- p3 )
70    over v- 2 v/n v+ ;
71
72: half-way-between-oints ( o1 o2 -- p )
73    [ location>> ] bi@ half-way ;