Harmonize spelling

[factor.git] / extra / jamshred / tunnel / tunnel.factor

diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor
index f94fc979ce630961f78d8272d383763473d777f2..f9b353b85f278f4a62c384e696d8cb38eef470fe 100644 (file)
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@@ -1,9 +1,8 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors combinators fry jamshred.oint
-kernel literals locals math math.constants math.matrices
-math.order math.quadratic math.ranges math.vectors random
-sequences specialized-arrays vectors ;
+USING: accessors alien.c-types colors combinators jamshred.oint
+kernel literals math math.constants math.order math.quadratic
+math.vectors random sequences specialized-arrays vectors ;
 FROM: jamshred.oint => distance ;
 FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
@@ -15,7 +14,7 @@ TUPLE: segment < oint number color radius ;
 C: <segment> segment
 
 : segment-number++ ( segment -- )
-    [ number>> 1 + ] keep (>>number) ;
+    [ number>> 1 + ] keep number<< ;
 
 : clamp-length ( n seq -- n' )
     0 swap length clamp ;
@@ -32,9 +31,7 @@ CONSTANT: random-rotation-angle $[ pi 20 / ]
     random-color >>color dup segment-number++ ;
 
 : (random-segments) ( segments n -- segments )
-    dup 0 > [
-        [ dup last random-segment over push ] dip 1 - (random-segments)
-    ] [ drop ] if ;
+    [ dup last random-segment suffix! ] times ;
 
 CONSTANT: default-segment-radius 1
 
@@ -59,8 +56,8 @@ CONSTANT: default-segment-radius 1
     n-segments simple-segments ;
 
 : sub-tunnel ( from to segments -- segments )
-    #! return segments between from and to, after clamping from and to to
-    #! valid values
+    ! return segments between from and to, after clamping from and to to
+    ! valid values
     [ '[ _ clamp-length ] bi@ ] keep <slice> ;
 
 : get-segment ( segments n -- segment )
@@ -73,8 +70,8 @@ CONSTANT: default-segment-radius 1
     number>> 1 - get-segment ;
 
 : heading-segment ( segments current-segment heading -- segment )
-    #! the next segment on the given heading
-    over forward>> v. 0 <=> {
+    ! the next segment on the given heading
+    over forward>> vdot 0 <=> {
         { +gt+ [ next-segment ] }
         { +lt+ [ previous-segment ] }
         { +eq+ [ nip ] } ! current segment
@@ -82,26 +79,26 @@ CONSTANT: default-segment-radius 1
 
 :: distance-to-next-segment ( current next location heading -- distance )
     current forward>> :> cf
-    cf next location>> v. cf location v. - cf heading v. / ;
+    cf next location>> vdot cf location vdot - cf heading vdot / ;
 
 :: distance-to-next-segment-area ( current next location heading -- distance )
     current forward>> :> cf
     next current half-way-between-oints :> h
-    cf h v. cf location v. - cf heading v. / ;
+    cf h vdot cf location vdot - cf heading vdot / ;
 
-: vector-to-centre ( seg loc -- v )
+: vector-to-center ( seg loc -- v )
     over location>> swap v- swap forward>> proj-perp ;
 
-: distance-from-centre ( seg loc -- distance )
-    vector-to-centre norm ;
+: distance-from-center ( seg loc -- distance )
+    vector-to-center norm ;
 
 : wall-normal ( seg oint -- n )
-    location>> vector-to-centre normalize ;
+    location>> vector-to-center normalize ;
 
 CONSTANT: distant 1000
 
 : max-real ( a b -- c )
-    #! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
+    ! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
     dup real? [
         over real? [ max ] [ nip ] if
     ] [
@@ -112,9 +109,9 @@ CONSTANT: distant 1000
     v norm 0 = [
         distant
     ] [
-        v dup v. :> a
-        v w v. 2 * :> b
-        w dup v. r sq - :> c
+        v dup vdot :> a
+        v w vdot 2 * :> b
+        w dup vdot r sq - :> c
         c b a quadratic max-real
     ] if ;
 
@@ -132,17 +129,16 @@ CONSTANT: distant 1000
     dupd (distance-to-collision) swap forward>> n*v ;
 
 : bounce-forward ( segment oint -- )
-    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
+    [ wall-normal ] [ forward>> swap reflect ] [ forward<< ] tri ;
 
 : bounce-left ( segment oint -- )
-    #! must be done after forward
+    ! must be done after forward
     [ forward>> vneg ] dip [ left>> swap reflect ]
-    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
+    [ forward>> proj-perp normalize ] [ left<< ] tri ;
 
 : bounce-up ( segment oint -- )
-    #! must be done after forward and left!
-    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
+    ! must be done after forward and left!
+    nip [ forward>> ] [ left>> cross ] [ up<< ] tri ;
 
 : bounce-off-wall ( oint segment -- )
     swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;
-