jamshred: fix failing unit test
parent
ee2814ae05
commit
866d23ff03
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2007 Alex Chapman
|
! Copyright (C) 2007 Alex Chapman
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
IN: jamshred.tunnel.tests
|
||||||
|
|
||||||
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
|
[ 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 1 0 } ] [ simple-collision-up sideways-heading ] unit-test
|
||||||
[ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] 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
|
||||||
|
|
|
@ -126,10 +126,14 @@ C: <segment> segment
|
||||||
: sideways-relative-location ( oint segment -- loc )
|
: sideways-relative-location ( oint segment -- loc )
|
||||||
[ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
|
[ [ 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 )
|
: collision-vector ( oint segment -- v )
|
||||||
[ sideways-heading ] [ sideways-relative-location ]
|
[ sideways-heading ] [ sideways-relative-location ]
|
||||||
[ radius>> 0.1 - ] ! bounce before we hit so that we can't see through the wall (hack?)
|
[ bounce-radius ] 2tri
|
||||||
2tri
|
|
||||||
swap [ collision-coefficient ] dip forward>> n*v ;
|
swap [ collision-coefficient ] dip forward>> n*v ;
|
||||||
|
|
||||||
: distance-to-collision ( oint segment -- distance )
|
: distance-to-collision ( oint segment -- distance )
|
||||||
|
|
Loading…
Reference in New Issue