steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of github.com:Blei/factor into fixes

db4
Philipp Brüschweiler 2009-11-07 00:09:37 +01:00
parent 6df4722518 b4e77169e9
commit a5863320cf
2 changed files with 0 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/jamshred/tunnel/tunnel-tests.factor
View File

@ -6,19 +6,6 @@ alien.c-types ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
IN: jamshred.tunnel.tests IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
T{ segment f { 1 1 1 } f f f 1 }
T{ oint f { 0 0 0.25 } }
nearer-segment number>> ] unit-test
[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
[ float-array{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
: test-segment-oint ( -- oint ) : test-segment-oint ( -- oint )
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ; { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;

27
extra/jamshred/tunnel/tunnel.factor
View File

@ -63,33 +63,6 @@ CONSTANT: default-segment-radius 1
#! valid values #! valid values
[ '[ _ clamp-length ] bi@ ] keep <slice> ; [ '[ _ clamp-length ] bi@ ] keep <slice> ;
:: nearer-segment ( seg-a seg-b oint -- segment )
seg-a oint distance
seg-b oint distance <
seg-a seg-b ? ;
: (find-nearest-segment) ( nearest next oint -- nearest ? )
#! find the nearest of 'next' and 'nearest' to 'oint', and return
#! t if the nearest hasn't changed
pick [ nearer-segment dup ] dip = ;
: find-nearest-segment ( oint segments -- segment )
dup first swap rest-slice rot [ (find-nearest-segment) ] curry
find 2drop ;
: nearest-segment-forward ( segments oint start -- segment )
rot tail-slice find-nearest-segment ;
: nearest-segment-backward ( segments oint start -- segment )
1 + rot head-slice <reversed> find-nearest-segment ;
: nearest-segment ( segments oint start-segment -- segment )
#! find the segment nearest to 'oint', and return it.
#! start looking at segment 'start-segment'
number>> over [
[ nearest-segment-forward ] 3keep nearest-segment-backward
] dip nearer-segment ;
: get-segment ( segments n -- segment ) : get-segment ( segments n -- segment )
over clamp-length swap nth ; over clamp-length swap nth ;