remove clamp-to-range and associated words, update jamshred

db4
Doug Coleman 2009-05-25 21:24:12 -05:00
parent 0d5ed7e982
commit 0cb7b408b4
4 changed files with 12 additions and 38 deletions

View File

@ -22,17 +22,6 @@ IN: math.ranges.tests
[ { 0 1/3 2/3 1 } ] [ 0 1 1/3 <range> >array ] unit-test
[ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 <range> >array reverse ] unit-test
[ t ] [ 5 [0,b] range-increasing? ] unit-test
[ f ] [ 5 [0,b] range-decreasing? ] unit-test
[ f ] [ -5 [0,b] range-increasing? ] unit-test
[ t ] [ -5 [0,b] range-decreasing? ] unit-test
[ 0 ] [ 5 [0,b] range-min ] unit-test
[ 5 ] [ 5 [0,b] range-max ] unit-test
[ 3 ] [ 3 5 [0,b] clamp-to-range ] unit-test
[ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
[ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test
[ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test
[ 100 ] [
1 100 [a,b] [ 2^ [1,b] ] map prune length
] unit-test
] unit-test

View File

@ -49,24 +49,3 @@ PRIVATE>
: [1,b] ( b -- range ) 1 swap [a,b] ; inline
: [0,b) ( b -- range ) 0 swap [a,b) ; inline
: range-increasing? ( range -- ? )
step>> 0 > ;
: range-decreasing? ( range -- ? )
step>> 0 < ;
: first-or-last ( seq head? -- elt )
[ first ] [ last ] if ;
: range-min ( range -- min )
dup range-increasing? first-or-last ;
: range-max ( range -- max )
dup range-decreasing? first-or-last ;
: clamp-to-range ( n range -- n )
[ range-min ] [ range-max ] bi clamp ;
: sequence-index-range ( seq -- range )
length [0,b) ;

View File

@ -45,10 +45,10 @@ CONSTANT: max-speed 30.0
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>> * ;

View File

@ -1,6 +1,9 @@
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays colors combinators kernel literals locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
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.float vectors ;
FROM: jamshred.oint => distance ;
IN: jamshred.tunnel
@ -12,6 +15,9 @@ C: <segment> segment
: segment-number++ ( segment -- )
[ number>> 1+ ] keep (>>number) ;
: clamp-length ( n seq -- n' )
0 swap length clamp ;
: random-color ( -- color )
{ 100 100 100 } [ random 100 / >float ] map first3 1.0 <rgba> ;
@ -53,7 +59,7 @@ CONSTANT: default-segment-radius 1
: sub-tunnel ( from to segments -- segments )
#! return segments between from and to, after clamping from and to to
#! valid values
[ sequence-index-range [ clamp-to-range ] curry bi@ ] keep <slice> ;
[ '[ _ clamp-length ] bi@ ] keep <slice> ;
: nearer-segment ( segment segment oint -- segment )
#! return whichever of the two segments is nearer to the oint
@ -82,7 +88,7 @@ CONSTANT: default-segment-radius 1
] dip nearer-segment ;
: get-segment ( segments n -- segment )
over sequence-index-range clamp-to-range swap nth ;
over clamp-length swap nth ;
: next-segment ( segments current-segment -- segment )
number>> 1+ get-segment ;