extra/jamshred/tunnel/tunnel-tests.factor

   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
   5 alien.c-types ;
   6 SPECIALIZED-ARRAY: float
   7 IN: jamshred.tunnel.tests
   8
   9 : test-segment-oint ( -- oint )
  10     { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
  11
  12 { { -1 0 0 } } [ test-segment-oint { 1 0 0 } vector-to-center ] unit-test
  13 { { 1 0 0 } } [ test-segment-oint { -1 0 0 } vector-to-center ] unit-test
  14 { { 0 -1 0 } } [ test-segment-oint { 0 1 0 } vector-to-center ] unit-test
  15 { { 0 1 0 } } [ test-segment-oint { 0 -1 0 } vector-to-center ] unit-test
  16 { { -1 0 0 } } [ test-segment-oint { 1 0 -1 } vector-to-center ] unit-test
  17 { { 1 0 0 } } [ test-segment-oint { -1 0 -1 } vector-to-center ] unit-test
  18 { { 0 -1 0 } } [ test-segment-oint { 0 1 -1 } vector-to-center ] unit-test
  19 { { 0 1 0 } } [ test-segment-oint { 0 -1 -1 } vector-to-center ] unit-test
  20
  21 : simplest-straight-ahead ( -- oint segment )
  22     { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
  23     initial-segment ;
  24
  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
  27
  28 : simple-collision-up ( -- oint segment )
  29     { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
  30     initial-segment ;
  31
  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
  34 { { 0.0 1.0 0.0 } }
  35 [ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test