1 ! Copyright (C) 2007, 2008 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays jamshred.oint jamshred.tunnel kernel
4 math.vectors sequences specialized-arrays tools.test
6 SPECIALIZED-ARRAY: float
7 IN: jamshred.tunnel.tests
9 : test-segment-oint ( -- oint )
10 { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
12 [ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
13 [ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
14 [ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
15 [ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
16 [ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
17 [ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
18 [ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
19 [ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
21 : simplest-straight-ahead ( -- oint segment )
22 { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
25 [ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
26 [ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
28 : simple-collision-up ( -- oint segment )
29 { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
32 [ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test
33 [ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test
35 [ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test