extra/jamshred/tunnel/tunnel-tests.factor

   1 ! Copyright (C) 2007 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ;
   4 IN: jamshred.tunnel.tests
   5
   6 [ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
   7         T{ segment f { 1 1 1 } f f f 1 }
   8         T{ oint f { 0 0 0.25 } }
   9         nearer-segment segment-number ] unit-test
  10
  11 [ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
  12 [ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
  13 [ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
  14
  15 [ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test
  16
  17 [ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment oint-location ] unit-test
  18
  19 : test-segment-oint ( -- oint )
  20     { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
  21
  22 [ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
  23 [ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
  24 [ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
  25 [ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
  26 [ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
  27 [ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
  28 [ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
  29 [ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
  30
  31 : simplest-straight-ahead ( -- oint segment )
  32     { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
  33     initial-segment ;
  34
  35 [ { 0 0 0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
  36 [ { 0 0 0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
  37
  38 : simple-collision-up ( -- oint segment )
  39     { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
  40     initial-segment ;
  41
  42 [ { 0 1 0 } ] [ simple-collision-up sideways-heading ] unit-test
  43 [ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] unit-test
  44 [ { 0 1 0 } ]
  45 [ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test