jamshred: fix failing unit test

diff --git a/extra/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor
index c6755318e6f72b48aea63df878171b2f9880229b..903ff947391bbbc6b227696a85d2ef58ca4ab95d 100644 (file)
--- a/extra/jamshred/tunnel/tunnel-tests.factor
+++ b/extra/jamshred/tunnel/tunnel-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: jamshred.oint jamshred.tunnel kernel sequences tools.test ;
+USING: arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ;
 IN: jamshred.tunnel.tests
 
 [ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
@@ -41,4 +41,5 @@ IN: jamshred.tunnel.tests
 
 [ { 0 1 0 } ] [ simple-collision-up sideways-heading ] unit-test
 [ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] unit-test
-[ { 0 1 0 } ] [ simple-collision-up collision-vector ] unit-test
+[ { 0 1 0 } ]
+[ simple-collision-up collision-vector 0 bounce-offset 0 3array v+ ] unit-test

diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor
index f3fa9a0354d148e6f16e61fe4a577632919f934c..5cf1e33e64a8f19f1c32213aa70ea51c74edb54a 100755 (executable)
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@@ -126,10 +126,14 @@ C: <segment> segment
 : sideways-relative-location ( oint segment -- loc )
     [ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
 
+: bounce-offset 0.1 ; inline
+
+: bounce-radius ( segment -- r )
+    radius>> bounce-offset - ; ! bounce before we hit so that we can't see through the wall (hack?)
+
 : collision-vector ( oint segment -- v )
     [ sideways-heading ] [ sideways-relative-location ]
-    [ radius>> 0.1 - ] ! bounce before we hit so that we can't see through the wall (hack?)
-    2tri
+    [ bounce-radius ] 2tri
     swap [ collision-coefficient ] dip forward>> n*v ;
 
 : distance-to-collision ( oint segment -- distance )