Harmonize spelling

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

diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
index d33b78f29c8ad1608a84c7e1cac58040d9ef45fc..1c691bcb705972f3cbe2bb7fb22a8de43ae5e478 100644 (file)
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@@ -1,6 +1,12 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
+
+USING: accessors colors combinators jamshred.oint
+jamshred.sound jamshred.tunnel kernel math math.order
+math.vectors ranges sequences specialized-arrays
+strings system ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
 IN: jamshred.player
 
 TUPLE: player < oint
@@ -12,43 +18,40 @@ TUPLE: player < oint
     { speed float } ;
 
 ! speeds are in GL units / second
-: default-speed ( -- speed ) 1.0 ;
-: max-speed ( -- speed ) 30.0 ;
+CONSTANT: default-speed 1.0
+CONSTANT: max-speed 30.0
 
 : <player> ( name sounds -- player )
     [ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip
     f f 0 default-speed player boa ;
 
 : turn-player ( player x-radians y-radians -- )
-    [ over ] dip left-pivot up-pivot ;
+    overd left-pivot up-pivot ;
 
 : roll-player ( player z-radians -- )
     forward-pivot ;
 
 : to-tunnel-start ( player -- )
-    [ tunnel>> first dup location>> ]
-    [ tuck (>>location) (>>nearest-segment) ] bi ;
+    dup tunnel>> first
+    [ >>nearest-segment ]
+    [ location>> >>location ] bi drop ;
 
 : play-in-tunnel ( player segments -- )
     >>tunnel to-tunnel-start ;
 
-: update-nearest-segment ( player -- )
-    [ tunnel>> ] [ dup nearest-segment>> nearest-segment ]
-    [ (>>nearest-segment) ] tri ;
-
 : update-time ( player -- seconds-passed )
-    millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
+    nano-count swap [ last-move>> - 1,000,000,000 / ] [ last-move<< ] 2bi ;
 
-: moved ( player -- ) millis swap (>>last-move) ;
+: moved ( player -- ) nano-count swap last-move<< ;
 
 : speed-range ( -- range )
-    max-speed [0,b] ;
+    max-speed [0..b] ;
 
 : change-player-speed ( inc player -- )
-    [ + speed-range clamp-to-range ] change-speed drop ;
+    [ + 0 max-speed clamp ] change-speed drop ;
 
 : multiply-player-speed ( n player -- )
-    [ * speed-range clamp-to-range ] change-speed drop ; 
+    [ * 0 max-speed clamp ] change-speed drop ;
 
 : distance-to-move ( seconds-passed player -- distance )
     speed>> * ;
@@ -78,29 +81,30 @@ TUPLE: player < oint
 : almost-to-collision ( player -- distance )
     distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ;
 
-: from ( player -- radius distance-from-centre )
+: from ( player -- radius distance-from-center )
     [ nearest-segment>> dup radius>> swap ] [ location>> ] bi
-    distance-from-centre ;
+    distance-from-center ;
 
 : distance-from-wall ( player -- distance ) from - ;
-: fraction-from-centre ( player -- fraction ) from swap / ;
+: fraction-from-center ( player -- fraction ) from swap / ;
 : fraction-from-wall ( player -- fraction )
-    fraction-from-centre 1 swap - ;
+    fraction-from-center 1 swap - ;
 
 : update-nearest-segment2 ( heading player -- )
     2dup distance-to-heading-segment-area 0 <= [
         [ tunnel>> ] [ nearest-segment>> rot heading-segment ]
-        [ (>>nearest-segment) ] tri
+        [ nearest-segment<< ] tri
     ] [
         2drop
     ] if ;
 
 :: move-player-on-heading ( d-left player distance heading -- d-left' player )
-    [let* | d-to-move [ d-left distance min ]
-            move-v [ d-to-move heading n*v ] |
-        move-v player location+
-        heading player update-nearest-segment2
-        d-left d-to-move - player ] ;
+    d-left distance min :> d-to-move
+    d-to-move heading n*v :> move-v
+
+    move-v player location+
+    heading player update-nearest-segment2
+    d-left d-to-move - player ;
 
 : distance-to-move-freely ( player -- distance )
     [ almost-to-collision ]
@@ -127,11 +131,10 @@ TUPLE: player < oint
     ?move-player-freely over 0 > [
         ! bounce
         drag-player
-        (move-player)
     ] when ;
 
 : move-player ( player -- )
     [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
 
 : update-player ( player -- )
-    [ move-player ] [ nearest-segment>> "white" named-color swap (>>color) ] bi ;
+    [ move-player ] [ nearest-segment>> COLOR: white swap color<< ] bi ;