! 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 strings system ;
+
+USING: accessors colors combinators jamshred.oint
+jamshred.sound jamshred.tunnel kernel math math.order
+math.vectors ranges sequences specialized-arrays
+specialized-arrays.instances.alien.c-types.float strings system ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
IN: jamshred.player
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 -- )
[ + 0 max-speed clamp ] change-speed drop ;
: multiply-player-speed ( n player -- )
- [ * 0 max-speed clamp ] change-speed drop ;
+ [ * 0 max-speed clamp ] change-speed drop ;
: distance-to-move ( seconds-passed player -- distance )
speed>> * ;
: 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-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 ;