From: Alex Chapman <chapman.alex@gmail.com>
Date: Wed, 15 Apr 2009 10:01:18 +0000 (+1000)
Subject: Moving jamshred from unmaintained to extra
X-Git-Tag: 0.94~2132^2~9^2~4
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=601f8fdd29e8cab8d9306bbe386bae25829c25c6

Moving jamshred from unmaintained to extra
---

diff --git a/extra/jamshred/authors.txt b/extra/jamshred/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/deploy.factor b/extra/jamshred/deploy.factor
new file mode 100644
index 0000000000..9a18cf1f9b
--- /dev/null
+++ b/extra/jamshred/deploy.factor
@@ -0,0 +1,12 @@
+USING: tools.deploy.config ;
+V{
+    { deploy-ui? t }
+    { deploy-io 1 }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
+    { "stop-after-last-window?" t }
+    { deploy-name "Jamshred" }
+}
diff --git a/extra/jamshred/game/authors.txt b/extra/jamshred/game/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/game/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
new file mode 100644
index 0000000000..9cb5bc7c3a
--- /dev/null
+++ b/extra/jamshred/game/game.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ;
+IN: jamshred.game
+
+TUPLE: jamshred sounds tunnel players running quit ;
+
+: <jamshred> ( -- jamshred )
+    <sounds> <random-tunnel> "Player 1" pick <player>
+    2dup swap play-in-tunnel 1array f f jamshred boa ;
+
+: jamshred-player ( jamshred -- player )
+    ! TODO: support more than one player
+    players>> first ;
+
+: jamshred-update ( jamshred -- )
+    dup running>> [
+        jamshred-player update-player
+    ] [ drop ] if ;
+
+: toggle-running ( jamshred -- )
+    dup running>> [
+        f >>running drop
+    ] [
+        [ jamshred-player moved ]
+        [ t >>running drop ] bi
+    ] if ;
+
+: mouse-moved ( x-radians y-radians jamshred -- )
+    jamshred-player -rot turn-player ;
+
+: units-per-full-roll ( -- n ) 50 ;
+
+: jamshred-roll ( jamshred n -- )
+    [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ;
+        
+: mouse-scroll-x ( jamshred x -- ) jamshred-roll ;
+
+: mouse-scroll-y ( jamshred y -- )
+    neg swap jamshred-player change-player-speed ;
diff --git a/extra/jamshred/gl/authors.txt b/extra/jamshred/gl/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/gl/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor
new file mode 100644
index 0000000000..b78e7de88e
--- /dev/null
+++ b/extra/jamshred/gl/gl.factor
@@ -0,0 +1,99 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types jamshred.game jamshred.oint
+jamshred.player jamshred.tunnel kernel math math.constants
+math.functions math.vectors opengl opengl.gl opengl.glu
+opengl.demo-support sequences specialized-arrays.float ;
+IN: jamshred.gl
+
+: min-vertices 6 ; inline
+: max-vertices 32 ; inline
+
+: n-vertices ( -- n ) 32 ; inline
+
+! render enough of the tunnel that it looks continuous
+: n-segments-ahead ( -- n ) 60 ; inline
+: n-segments-behind ( -- n ) 40 ; inline
+
+: wall-drawing-offset ( -- n )
+    #! so that we can't see through the wall, we draw it a bit further away
+    0.15 ;
+
+: wall-drawing-radius ( segment -- r )
+    radius>> wall-drawing-offset + ;
+
+: wall-up ( segment -- v )
+    [ wall-drawing-radius ] [ up>> ] bi n*v ;
+
+: wall-left ( segment -- v )
+    [ wall-drawing-radius ] [ left>> ] bi n*v ;
+
+: segment-vertex ( theta segment -- vertex )
+    [
+        [ wall-up swap sin v*n ] [ wall-left swap cos v*n ] 2bi v+
+    ] [
+        location>> v+
+    ] bi ;
+
+: segment-vertex-normal ( vertex segment -- normal )
+    location>> swap v- normalize ;
+
+: segment-vertex-and-normal ( segment theta -- vertex normal )
+    swap [ segment-vertex ] keep dupd segment-vertex-normal ;
+
+: equally-spaced-radians ( n -- seq )
+    #! return a sequence of n numbers between 0 and 2pi
+    dup [ / pi 2 * * ] curry map ;
+
+: draw-segment-vertex ( segment theta -- )
+    over color>> gl-color segment-vertex-and-normal
+    gl-normal gl-vertex ;
+
+: draw-vertex-pair ( theta next-segment segment -- )
+    rot tuck draw-segment-vertex draw-segment-vertex ;
+
+: draw-segment ( next-segment segment -- )
+    GL_QUAD_STRIP [
+        [ draw-vertex-pair ] 2curry
+        n-vertices equally-spaced-radians F{ 0.0 } append swap each
+    ] do-state ;
+
+: draw-segments ( segments -- )
+    1 over length pick subseq swap [ draw-segment ] 2each ;
+
+: segments-to-render ( player -- segments )
+    dup nearest-segment>> number>> dup n-segments-behind -
+    swap n-segments-ahead + rot tunnel>> sub-tunnel ;
+
+: draw-tunnel ( player -- )
+    segments-to-render draw-segments ;
+
+: init-graphics ( width height -- )
+    GL_DEPTH_TEST glEnable
+    GL_SCISSOR_TEST glDisable
+    1.0 glClearDepth
+    0.0 0.0 0.0 0.0 glClearColor
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    GL_PROJECTION glMatrixMode glLoadIdentity
+    dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
+    GL_MODELVIEW glMatrixMode glLoadIdentity
+    GL_LEQUAL glDepthFunc
+    GL_LIGHTING glEnable
+    GL_LIGHT0 glEnable
+    GL_FOG glEnable
+    GL_FOG_DENSITY 0.09 glFogf
+    GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
+    GL_COLOR_MATERIAL glEnable
+    GL_LIGHT0 GL_POSITION float-array{ 0.0 0.0 0.0 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_AMBIENT float-array{ 0.2 0.2 0.2 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
+    GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
+
+: player-view ( player -- )
+    [ location>> ]
+    [ [ location>> ] [ forward>> ] bi v+ ]
+    [ up>> ] tri gl-look-at ;
+
+: draw-jamshred ( jamshred width height -- )
+    init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ;
+
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
new file mode 100644
index 0000000000..d0b74417d1
--- /dev/null
+++ b/extra/jamshred/jamshred.factor
@@ -0,0 +1,94 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
+IN: jamshred
+
+TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
+
+: <jamshred-gadget> ( jamshred -- gadget )
+    jamshred-gadget new-gadget swap >>jamshred ;
+
+: default-width ( -- x ) 800 ;
+: default-height ( -- y ) 600 ;
+
+M: jamshred-gadget pref-dim*
+    drop default-width default-height 2array ;
+
+M: jamshred-gadget draw-gadget* ( gadget -- )
+    [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ;
+
+: jamshred-loop ( gadget -- )
+    dup jamshred>> quit>> [
+        drop
+    ] [
+        [ jamshred>> jamshred-update ]
+        [ relayout-1 ]
+        [ 10 milliseconds sleep yield jamshred-loop ] tri
+    ] if ;
+
+: fullscreen ( gadget -- )
+    find-world t swap set-fullscreen* ;
+
+: no-fullscreen ( gadget -- )
+    find-world f swap set-fullscreen* ;
+
+: toggle-fullscreen ( world -- )
+    [ fullscreen? not ] keep set-fullscreen* ;
+
+M: jamshred-gadget graft* ( gadget -- )
+    [ jamshred-loop ] curry in-thread ;
+
+M: jamshred-gadget ungraft* ( gadget -- )
+    jamshred>> t swap (>>quit) ;
+
+: jamshred-restart ( jamshred-gadget -- )
+    <jamshred> >>jamshred drop ;
+
+: pix>radians ( n m -- theta )
+    / pi 4 * * ; ! 2 / / pi 2 * * ;
+
+: x>radians ( x gadget -- theta )
+    #! translate motion of x pixels to an angle
+    rect-dim first pix>radians neg ;
+
+: y>radians ( y gadget -- theta )
+    #! translate motion of y pixels to an angle
+    rect-dim second pix>radians ;
+
+: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
+    over jamshred>> >r
+    [ first swap x>radians ] 2keep second swap y>radians
+    r> mouse-moved ;
+    
+: handle-mouse-motion ( jamshred-gadget -- )
+    hand-loc get [
+        over last-hand-loc>> [
+            v- (handle-mouse-motion) 
+        ] [ 2drop ] if* 
+    ] 2keep >>last-hand-loc drop ;
+
+: handle-mouse-scroll ( jamshred-gadget -- )
+    jamshred>> scroll-direction get
+    [ first mouse-scroll-x ]
+    [ second mouse-scroll-y ] 2bi ;
+
+: quit ( gadget -- )
+    [ no-fullscreen ] [ close-window ] bi ;
+
+jamshred-gadget H{
+    { T{ key-down f f "r" } [ jamshred-restart ] }
+    { T{ key-down f f " " } [ jamshred>> toggle-running ] }
+    { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
+    { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
+    { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
+    { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
+    { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
+    { T{ key-down f f "q" } [ quit ] }
+    { T{ motion } [ handle-mouse-motion ] }
+    { T{ mouse-scroll } [ handle-mouse-scroll ] }
+} set-gestures
+
+: jamshred-window ( -- gadget )
+    [ <jamshred> <jamshred-gadget> dup "Jamshred" open-window ] with-ui ;
+
+MAIN: jamshred-window
diff --git a/extra/jamshred/log/log.factor b/extra/jamshred/log/log.factor
new file mode 100644
index 0000000000..33498d8a2e
--- /dev/null
+++ b/extra/jamshred/log/log.factor
@@ -0,0 +1,10 @@
+USING: kernel logging ;
+IN: jamshred.log
+
+LOG: (jamshred-log) DEBUG
+
+: with-jamshred-log ( quot -- )
+    "jamshred" swap with-logging ;
+
+: jamshred-log ( message -- )
+    [ (jamshred-log) ] with-jamshred-log ; ! ugly...
diff --git a/extra/jamshred/oint/authors.txt b/extra/jamshred/oint/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/oint/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/oint/oint-tests.factor b/extra/jamshred/oint/oint-tests.factor
new file mode 100644
index 0000000000..401935fd01
--- /dev/null
+++ b/extra/jamshred/oint/oint-tests.factor
@@ -0,0 +1,8 @@
+USING: jamshred.oint tools.test ;
+IN: jamshred.oint-tests
+
+[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test
+[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test
+[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test
+[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test
+[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test
diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor
new file mode 100644
index 0000000000..808e92a1f9
--- /dev/null
+++ b/extra/jamshred/oint/oint.factor
@@ -0,0 +1,73 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
+IN: jamshred.oint
+
+! An oint is a point with three linearly independent unit vectors
+! given relative to that point. In jamshred a player's location and
+! direction are given by the player's oint. Similarly, a tunnel
+! segment's location and orientation are given by an oint.
+
+TUPLE: oint location forward up left ;
+C: <oint> oint
+
+: rotation-quaternion ( theta axis -- quaternion )
+    swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ;
+
+: rotate-vector ( q qrecip v -- v )
+    v>q swap q* q* q>v ;
+
+: rotate-oint ( oint theta axis -- )
+    rotation-quaternion dup qrecip pick
+    [ forward>> rotate-vector >>forward ]
+    [ up>> rotate-vector >>up ]
+    [ left>> rotate-vector >>left ] 3tri drop ;
+
+: left-pivot ( oint theta -- )
+    over left>> rotate-oint ;
+
+: up-pivot ( oint theta -- )
+    over up>> rotate-oint ;
+
+: forward-pivot ( oint theta -- )
+    over forward>> rotate-oint ;
+
+: random-float+- ( n -- m )
+    #! find a random float between -n/2 and n/2
+    dup 10000 * >fixnum random 10000 / swap 2 / - ;
+
+: random-turn ( oint theta -- )
+    2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
+
+: location+ ( v oint -- )
+    [ location>> v+ ] [ (>>location) ] bi ;
+
+: go-forward ( distance oint -- )
+    [ forward>> n*v ] [ location+ ] bi ;
+
+: distance-vector ( oint oint -- vector )
+    [ location>> ] bi@ swap v- ;
+
+: distance ( oint oint -- distance )
+    distance-vector norm ;
+
+: scalar-projection ( v1 v2 -- n )
+    #! the scalar projection of v1 onto v2
+    tuck v. swap norm / ;
+
+: proj-perp ( u v -- w )
+    dupd proj v- ;
+
+: perpendicular-distance ( oint oint -- distance )
+    tuck distance-vector swap 2dup left>> scalar-projection abs
+    -rot up>> scalar-projection abs + ;
+
+:: reflect ( v n -- v' )
+    #! bounce v on a surface with normal n
+    v v n v. n n v. / 2 * n n*v v- ;
+
+: half-way ( p1 p2 -- p3 )
+    over v- 2 v/n v+ ;
+
+: half-way-between-oints ( o1 o2 -- p )
+    [ location>> ] bi@ half-way ;
diff --git a/extra/jamshred/player/authors.txt b/extra/jamshred/player/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/player/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
new file mode 100644
index 0000000000..72f26a2c79
--- /dev/null
+++ b/extra/jamshred/player/player.factor
@@ -0,0 +1,137 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ;
+IN: jamshred.player
+
+TUPLE: player < oint
+    { name string }
+    { sounds sounds }
+    tunnel
+    nearest-segment
+    { last-move integer }
+    { speed float } ;
+
+! speeds are in GL units / second
+: default-speed ( -- speed ) 1.0 ;
+: max-speed ( -- speed ) 30.0 ;
+
+: <player> ( name sounds -- player )
+    [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip
+    f f 0 default-speed player boa ;
+
+: turn-player ( player x-radians y-radians -- )
+    >r over r> left-pivot up-pivot ;
+
+: roll-player ( player z-radians -- )
+    forward-pivot ;
+
+: to-tunnel-start ( player -- )
+    [ tunnel>> first dup location>> ]
+    [ tuck (>>location) (>>nearest-segment) ] bi ;
+
+: play-in-tunnel ( player segments -- )
+    >>tunnel to-tunnel-start ;
+
+: update-nearest-segment ( player -- )
+    [ tunnel>> ] [ dup nearest-segment>> nearest-segment ]
+    [ (>>nearest-segment) ] tri ;
+
+: update-time ( player -- seconds-passed )
+    millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
+
+: moved ( player -- ) millis swap (>>last-move) ;
+
+: speed-range ( -- range )
+    max-speed [0,b] ;
+
+: change-player-speed ( inc player -- )
+    [ + speed-range clamp-to-range ] change-speed drop ;
+
+: multiply-player-speed ( n player -- )
+    [ * speed-range clamp-to-range ] change-speed drop ; 
+
+: distance-to-move ( seconds-passed player -- distance )
+    speed>> * ;
+
+: bounce ( d-left player -- d-left' player )
+    {
+        [ dup nearest-segment>> bounce-off-wall ]
+        [ sounds>> bang ]
+        [ 3/4 swap multiply-player-speed ]
+        [ ]
+    } cleave ;
+
+:: (distance) ( heading player -- current next location heading )
+    player nearest-segment>>
+    player [ tunnel>> ] [ nearest-segment>> ] bi heading heading-segment
+    player location>> heading ;
+
+: distance-to-heading-segment ( heading player -- distance )
+    (distance) distance-to-next-segment ;
+
+: distance-to-heading-segment-area ( heading player -- distance )
+    (distance) distance-to-next-segment-area ;
+
+: distance-to-collision ( player -- distance )
+    dup nearest-segment>> (distance-to-collision) ;
+
+: almost-to-collision ( player -- distance )
+    distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ;
+
+: from ( player -- radius distance-from-centre )
+    [ nearest-segment>> dup radius>> swap ] [ location>> ] bi
+    distance-from-centre ;
+
+: distance-from-wall ( player -- distance ) from - ;
+: fraction-from-centre ( player -- fraction ) from swap / ;
+: fraction-from-wall ( player -- fraction )
+    fraction-from-centre 1 swap - ;
+
+: update-nearest-segment2 ( heading player -- )
+    2dup distance-to-heading-segment-area 0 <= [
+        [ tunnel>> ] [ nearest-segment>> rot heading-segment ]
+        [ (>>nearest-segment) ] tri
+    ] [
+        2drop
+    ] if ;
+
+:: move-player-on-heading ( d-left player distance heading -- d-left' player )
+    [let* | d-to-move [ d-left distance min ]
+            move-v [ d-to-move heading n*v ] |
+        move-v player location+
+        heading player update-nearest-segment2
+        d-left d-to-move - player ] ;
+
+: distance-to-move-freely ( player -- distance )
+    [ almost-to-collision ]
+    [ [ forward>> ] keep distance-to-heading-segment-area ] bi min ;
+
+: ?move-player-freely ( d-left player -- d-left' player )
+    over 0 > [
+        ! must make sure we are moving a significant distance, otherwise
+        ! we can recurse endlessly due to floating-point imprecision.
+        ! (at least I /think/ that's what causes it...)
+        dup distance-to-move-freely dup 0.1 > [
+            over forward>> move-player-on-heading ?move-player-freely
+        ] [ drop ] if
+    ] when ;
+
+: drag-heading ( player -- heading )
+    [ forward>> ] [ nearest-segment>> forward>> proj ] bi ;
+
+: drag-player ( d-left player -- d-left' player )
+    dup [ [ drag-heading ] keep distance-to-heading-segment-area ]
+    [ drag-heading move-player-on-heading ] bi ;
+
+: (move-player) ( d-left player -- d-left' player )
+    ?move-player-freely over 0 > [
+        ! bounce
+        drag-player
+        (move-player)
+    ] when ;
+
+: move-player ( player -- )
+    [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
+
+: update-player ( player -- )
+    [ move-player ] [ nearest-segment>> white swap (>>color) ] bi ;
diff --git a/extra/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor
new file mode 100644
index 0000000000..c19c67671f
--- /dev/null
+++ b/extra/jamshred/sound/sound.factor
@@ -0,0 +1,15 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors io.files kernel openal sequences ;
+IN: jamshred.sound
+
+TUPLE: sounds bang ;
+
+: assign-sound ( source wav-path -- )
+    resource-path create-buffer-from-wav AL_BUFFER swap set-source-param ;
+
+: <sounds> ( -- sounds )
+    init-openal 1 gen-sources first sounds boa
+    dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ;
+
+: bang ( sounds -- ) bang>> source-play check-error ;
diff --git a/extra/jamshred/summary.txt b/extra/jamshred/summary.txt
new file mode 100644
index 0000000000..e26fc1cf8b
--- /dev/null
+++ b/extra/jamshred/summary.txt
@@ -0,0 +1 @@
+A simple 3d tunnel racing game
diff --git a/extra/jamshred/tags.txt b/extra/jamshred/tags.txt
new file mode 100644
index 0000000000..8ae5957a4b
--- /dev/null
+++ b/extra/jamshred/tags.txt
@@ -0,0 +1,2 @@
+applications
+games
diff --git a/extra/jamshred/tunnel/authors.txt b/extra/jamshred/tunnel/authors.txt
new file mode 100644
index 0000000000..e9c193bac7
--- /dev/null
+++ b/extra/jamshred/tunnel/authors.txt
@@ -0,0 +1 @@
+Alex Chapman
diff --git a/extra/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor
new file mode 100644
index 0000000000..9486713f55
--- /dev/null
+++ b/extra/jamshred/tunnel/tunnel-tests.factor
@@ -0,0 +1,45 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays float-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 }
+        T{ segment f { 1 1 1 } f f f 1 }
+        T{ oint f { 0 0 0.25 } }
+        nearer-segment number>> ] unit-test
+
+[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
+
+[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
+
+[ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
+
+: test-segment-oint ( -- oint )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
+
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
+
+: simplest-straight-ahead ( -- oint segment )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
+[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
+
+: simple-collision-up ( -- oint segment )
+    { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test
+[ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test
+[ { 0.0 1.0 0.0 } ]
+[ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test
diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor
new file mode 100644
index 0000000000..52f2d38dd1
--- /dev/null
+++ b/extra/jamshred/tunnel/tunnel.factor
@@ -0,0 +1,167 @@
+! Copyright (C) 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays colors combinators float-arrays kernel
+locals math math.constants math.matrices math.order math.ranges
+math.vectors math.quadratic random sequences vectors jamshred.oint ;
+IN: jamshred.tunnel
+
+: n-segments ( -- n ) 5000 ; inline
+
+TUPLE: segment < oint number color radius ;
+C: <segment> segment
+
+: segment-number++ ( segment -- )
+    [ number>> 1+ ] keep (>>number) ;
+
+: random-color ( -- color )
+    { 100 100 100 } [ random 100 / >float ] map first3 1.0 <rgba> ;
+
+: tunnel-segment-distance ( -- n ) 0.4 ;
+: random-rotation-angle ( -- theta ) pi 20 / ;
+
+: random-segment ( previous-segment -- segment )
+    clone dup random-rotation-angle random-turn
+    tunnel-segment-distance over go-forward
+    random-color >>color dup segment-number++ ;
+
+: (random-segments) ( segments n -- segments )
+    dup 0 > [
+        >r dup peek random-segment over push r> 1- (random-segments)
+    ] [ drop ] if ;
+
+: default-segment-radius ( -- r ) 1 ;
+
+: initial-segment ( -- segment )
+    F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 }
+    0 random-color default-segment-radius <segment> ;
+
+: random-segments ( n -- segments )
+    initial-segment 1vector swap (random-segments) ;
+
+: simple-segment ( n -- segment )
+    [ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep
+    random-color default-segment-radius <segment> ;
+
+: simple-segments ( n -- segments )
+    [ simple-segment ] map ;
+
+: <random-tunnel> ( -- segments )
+    n-segments random-segments ;
+
+: <straight-tunnel> ( -- segments )
+    n-segments simple-segments ;
+
+: sub-tunnel ( from to segments -- segments )
+    #! return segments between from and to, after clamping from and to to
+    #! valid values
+    [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep <slice> ;
+
+: nearer-segment ( segment segment oint -- segment )
+    #! return whichever of the two segments is nearer to the oint
+    >r 2dup r> tuck distance >r distance r> < -rot ? ;
+
+: (find-nearest-segment) ( nearest next oint -- nearest ? )
+    #! find the nearest of 'next' and 'nearest' to 'oint', and return
+    #! t if the nearest hasn't changed
+    pick >r nearer-segment dup r> = ;
+
+: find-nearest-segment ( oint segments -- segment )
+    dup first swap rest-slice rot [ (find-nearest-segment) ] curry
+    find 2drop ;
+    
+: nearest-segment-forward ( segments oint start -- segment )
+    rot dup length swap <slice> find-nearest-segment ;
+
+: nearest-segment-backward ( segments oint start -- segment )
+    swapd 1+ 0 spin <slice> <reversed> find-nearest-segment ;
+
+: nearest-segment ( segments oint start-segment -- segment )
+    #! find the segment nearest to 'oint', and return it.
+    #! start looking at segment 'start-segment'
+    number>> over >r
+    [ nearest-segment-forward ] 3keep
+    nearest-segment-backward r> nearer-segment ;
+
+: get-segment ( segments n -- segment )
+    over sequence-index-range clamp-to-range swap nth ;
+
+: next-segment ( segments current-segment -- segment )
+    number>> 1+ get-segment ;
+
+: previous-segment ( segments current-segment -- segment )
+    number>> 1- get-segment ;
+
+: heading-segment ( segments current-segment heading -- segment )
+    #! the next segment on the given heading
+    over forward>> v. 0 <=> {
+        { +gt+ [ next-segment ] }
+        { +lt+ [ previous-segment ] }
+        { +eq+ [ nip ] } ! current segment
+    } case ;
+
+:: distance-to-next-segment ( current next location heading -- distance )
+    [let | cf [ current forward>> ] |
+        cf next location>> v. cf location v. - cf heading v. / ] ;
+
+:: distance-to-next-segment-area ( current next location heading -- distance )
+    [let | cf [ current forward>> ]
+           h [ next current half-way-between-oints ] |
+        cf h v. cf location v. - cf heading v. / ] ;
+
+: vector-to-centre ( seg loc -- v )
+    over location>> swap v- swap forward>> proj-perp ;
+
+: distance-from-centre ( seg loc -- distance )
+    vector-to-centre norm ;
+
+: wall-normal ( seg oint -- n )
+    location>> vector-to-centre normalize ;
+
+: distant ( -- n ) 1000 ;
+
+: max-real ( a b -- c )
+    #! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
+    dup real? [
+        over real? [ max ] [ nip ] if
+    ] [
+        drop dup real? [ drop distant ] unless
+    ] if ;
+
+:: collision-coefficient ( v w r -- c )
+    v norm 0 = [
+        distant
+    ] [
+        [let* | a [ v dup v. ]
+                b [ v w v. 2 * ]
+                c [ w dup v. r sq - ] |
+            c b a quadratic max-real ]
+    ] if ;
+
+: sideways-heading ( oint segment -- v )
+    [ forward>> ] bi@ proj-perp ;
+
+: sideways-relative-location ( oint segment -- loc )
+    [ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
+
+: (distance-to-collision) ( oint segment -- distance )
+    [ sideways-heading ] [ sideways-relative-location ]
+    [ nip radius>> ] 2tri collision-coefficient ;
+
+: collision-vector ( oint segment -- v )
+    dupd (distance-to-collision) swap forward>> n*v ;
+
+: bounce-forward ( segment oint -- )
+    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
+
+: bounce-left ( segment oint -- )
+    #! must be done after forward
+    [ forward>> vneg ] dip [ left>> swap reflect ]
+    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
+
+: bounce-up ( segment oint -- )
+    #! must be done after forward and left!
+    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
+
+: bounce-off-wall ( oint segment -- )
+    swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;
+
diff --git a/unmaintained/jamshred/authors.txt b/unmaintained/jamshred/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/deploy.factor b/unmaintained/jamshred/deploy.factor
deleted file mode 100644
index 9a18cf1f9b..0000000000
--- a/unmaintained/jamshred/deploy.factor
+++ /dev/null
@@ -1,12 +0,0 @@
-USING: tools.deploy.config ;
-V{
-    { deploy-ui? t }
-    { deploy-io 1 }
-    { deploy-reflection 1 }
-    { deploy-compiler? t }
-    { deploy-math? t }
-    { deploy-word-props? f }
-    { deploy-c-types? f }
-    { "stop-after-last-window?" t }
-    { deploy-name "Jamshred" }
-}
diff --git a/unmaintained/jamshred/game/authors.txt b/unmaintained/jamshred/game/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/game/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/game/game.factor b/unmaintained/jamshred/game/game.factor
deleted file mode 100644
index 9cb5bc7c3a..0000000000
--- a/unmaintained/jamshred/game/game.factor
+++ /dev/null
@@ -1,40 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ;
-IN: jamshred.game
-
-TUPLE: jamshred sounds tunnel players running quit ;
-
-: <jamshred> ( -- jamshred )
-    <sounds> <random-tunnel> "Player 1" pick <player>
-    2dup swap play-in-tunnel 1array f f jamshred boa ;
-
-: jamshred-player ( jamshred -- player )
-    ! TODO: support more than one player
-    players>> first ;
-
-: jamshred-update ( jamshred -- )
-    dup running>> [
-        jamshred-player update-player
-    ] [ drop ] if ;
-
-: toggle-running ( jamshred -- )
-    dup running>> [
-        f >>running drop
-    ] [
-        [ jamshred-player moved ]
-        [ t >>running drop ] bi
-    ] if ;
-
-: mouse-moved ( x-radians y-radians jamshred -- )
-    jamshred-player -rot turn-player ;
-
-: units-per-full-roll ( -- n ) 50 ;
-
-: jamshred-roll ( jamshred n -- )
-    [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ;
-        
-: mouse-scroll-x ( jamshred x -- ) jamshred-roll ;
-
-: mouse-scroll-y ( jamshred y -- )
-    neg swap jamshred-player change-player-speed ;
diff --git a/unmaintained/jamshred/gl/authors.txt b/unmaintained/jamshred/gl/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/gl/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/gl/gl.factor b/unmaintained/jamshred/gl/gl.factor
deleted file mode 100644
index b78e7de88e..0000000000
--- a/unmaintained/jamshred/gl/gl.factor
+++ /dev/null
@@ -1,99 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types jamshred.game jamshred.oint
-jamshred.player jamshred.tunnel kernel math math.constants
-math.functions math.vectors opengl opengl.gl opengl.glu
-opengl.demo-support sequences specialized-arrays.float ;
-IN: jamshred.gl
-
-: min-vertices 6 ; inline
-: max-vertices 32 ; inline
-
-: n-vertices ( -- n ) 32 ; inline
-
-! render enough of the tunnel that it looks continuous
-: n-segments-ahead ( -- n ) 60 ; inline
-: n-segments-behind ( -- n ) 40 ; inline
-
-: wall-drawing-offset ( -- n )
-    #! so that we can't see through the wall, we draw it a bit further away
-    0.15 ;
-
-: wall-drawing-radius ( segment -- r )
-    radius>> wall-drawing-offset + ;
-
-: wall-up ( segment -- v )
-    [ wall-drawing-radius ] [ up>> ] bi n*v ;
-
-: wall-left ( segment -- v )
-    [ wall-drawing-radius ] [ left>> ] bi n*v ;
-
-: segment-vertex ( theta segment -- vertex )
-    [
-        [ wall-up swap sin v*n ] [ wall-left swap cos v*n ] 2bi v+
-    ] [
-        location>> v+
-    ] bi ;
-
-: segment-vertex-normal ( vertex segment -- normal )
-    location>> swap v- normalize ;
-
-: segment-vertex-and-normal ( segment theta -- vertex normal )
-    swap [ segment-vertex ] keep dupd segment-vertex-normal ;
-
-: equally-spaced-radians ( n -- seq )
-    #! return a sequence of n numbers between 0 and 2pi
-    dup [ / pi 2 * * ] curry map ;
-
-: draw-segment-vertex ( segment theta -- )
-    over color>> gl-color segment-vertex-and-normal
-    gl-normal gl-vertex ;
-
-: draw-vertex-pair ( theta next-segment segment -- )
-    rot tuck draw-segment-vertex draw-segment-vertex ;
-
-: draw-segment ( next-segment segment -- )
-    GL_QUAD_STRIP [
-        [ draw-vertex-pair ] 2curry
-        n-vertices equally-spaced-radians F{ 0.0 } append swap each
-    ] do-state ;
-
-: draw-segments ( segments -- )
-    1 over length pick subseq swap [ draw-segment ] 2each ;
-
-: segments-to-render ( player -- segments )
-    dup nearest-segment>> number>> dup n-segments-behind -
-    swap n-segments-ahead + rot tunnel>> sub-tunnel ;
-
-: draw-tunnel ( player -- )
-    segments-to-render draw-segments ;
-
-: init-graphics ( width height -- )
-    GL_DEPTH_TEST glEnable
-    GL_SCISSOR_TEST glDisable
-    1.0 glClearDepth
-    0.0 0.0 0.0 0.0 glClearColor
-    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
-    GL_PROJECTION glMatrixMode glLoadIdentity
-    dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
-    GL_MODELVIEW glMatrixMode glLoadIdentity
-    GL_LEQUAL glDepthFunc
-    GL_LIGHTING glEnable
-    GL_LIGHT0 glEnable
-    GL_FOG glEnable
-    GL_FOG_DENSITY 0.09 glFogf
-    GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
-    GL_COLOR_MATERIAL glEnable
-    GL_LIGHT0 GL_POSITION float-array{ 0.0 0.0 0.0 1.0 } underlying>> glLightfv
-    GL_LIGHT0 GL_AMBIENT float-array{ 0.2 0.2 0.2 1.0 } underlying>> glLightfv
-    GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
-    GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
-
-: player-view ( player -- )
-    [ location>> ]
-    [ [ location>> ] [ forward>> ] bi v+ ]
-    [ up>> ] tri gl-look-at ;
-
-: draw-jamshred ( jamshred width height -- )
-    init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ;
-
diff --git a/unmaintained/jamshred/jamshred.factor b/unmaintained/jamshred/jamshred.factor
deleted file mode 100644
index d0b74417d1..0000000000
--- a/unmaintained/jamshred/jamshred.factor
+++ /dev/null
@@ -1,94 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
-IN: jamshred
-
-TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
-
-: <jamshred-gadget> ( jamshred -- gadget )
-    jamshred-gadget new-gadget swap >>jamshred ;
-
-: default-width ( -- x ) 800 ;
-: default-height ( -- y ) 600 ;
-
-M: jamshred-gadget pref-dim*
-    drop default-width default-height 2array ;
-
-M: jamshred-gadget draw-gadget* ( gadget -- )
-    [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ;
-
-: jamshred-loop ( gadget -- )
-    dup jamshred>> quit>> [
-        drop
-    ] [
-        [ jamshred>> jamshred-update ]
-        [ relayout-1 ]
-        [ 10 milliseconds sleep yield jamshred-loop ] tri
-    ] if ;
-
-: fullscreen ( gadget -- )
-    find-world t swap set-fullscreen* ;
-
-: no-fullscreen ( gadget -- )
-    find-world f swap set-fullscreen* ;
-
-: toggle-fullscreen ( world -- )
-    [ fullscreen? not ] keep set-fullscreen* ;
-
-M: jamshred-gadget graft* ( gadget -- )
-    [ jamshred-loop ] curry in-thread ;
-
-M: jamshred-gadget ungraft* ( gadget -- )
-    jamshred>> t swap (>>quit) ;
-
-: jamshred-restart ( jamshred-gadget -- )
-    <jamshred> >>jamshred drop ;
-
-: pix>radians ( n m -- theta )
-    / pi 4 * * ; ! 2 / / pi 2 * * ;
-
-: x>radians ( x gadget -- theta )
-    #! translate motion of x pixels to an angle
-    rect-dim first pix>radians neg ;
-
-: y>radians ( y gadget -- theta )
-    #! translate motion of y pixels to an angle
-    rect-dim second pix>radians ;
-
-: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
-    over jamshred>> >r
-    [ first swap x>radians ] 2keep second swap y>radians
-    r> mouse-moved ;
-    
-: handle-mouse-motion ( jamshred-gadget -- )
-    hand-loc get [
-        over last-hand-loc>> [
-            v- (handle-mouse-motion) 
-        ] [ 2drop ] if* 
-    ] 2keep >>last-hand-loc drop ;
-
-: handle-mouse-scroll ( jamshred-gadget -- )
-    jamshred>> scroll-direction get
-    [ first mouse-scroll-x ]
-    [ second mouse-scroll-y ] 2bi ;
-
-: quit ( gadget -- )
-    [ no-fullscreen ] [ close-window ] bi ;
-
-jamshred-gadget H{
-    { T{ key-down f f "r" } [ jamshred-restart ] }
-    { T{ key-down f f " " } [ jamshred>> toggle-running ] }
-    { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
-    { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
-    { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
-    { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
-    { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
-    { T{ key-down f f "q" } [ quit ] }
-    { T{ motion } [ handle-mouse-motion ] }
-    { T{ mouse-scroll } [ handle-mouse-scroll ] }
-} set-gestures
-
-: jamshred-window ( -- gadget )
-    [ <jamshred> <jamshred-gadget> dup "Jamshred" open-window ] with-ui ;
-
-MAIN: jamshred-window
diff --git a/unmaintained/jamshred/log/log.factor b/unmaintained/jamshred/log/log.factor
deleted file mode 100644
index 33498d8a2e..0000000000
--- a/unmaintained/jamshred/log/log.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-USING: kernel logging ;
-IN: jamshred.log
-
-LOG: (jamshred-log) DEBUG
-
-: with-jamshred-log ( quot -- )
-    "jamshred" swap with-logging ;
-
-: jamshred-log ( message -- )
-    [ (jamshred-log) ] with-jamshred-log ; ! ugly...
diff --git a/unmaintained/jamshred/oint/authors.txt b/unmaintained/jamshred/oint/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/oint/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/oint/oint-tests.factor b/unmaintained/jamshred/oint/oint-tests.factor
deleted file mode 100644
index 401935fd01..0000000000
--- a/unmaintained/jamshred/oint/oint-tests.factor
+++ /dev/null
@@ -1,8 +0,0 @@
-USING: jamshred.oint tools.test ;
-IN: jamshred.oint-tests
-
-[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test
-[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test
-[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test
-[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test
-[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test
diff --git a/unmaintained/jamshred/oint/oint.factor b/unmaintained/jamshred/oint/oint.factor
deleted file mode 100644
index 808e92a1f9..0000000000
--- a/unmaintained/jamshred/oint/oint.factor
+++ /dev/null
@@ -1,73 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
-IN: jamshred.oint
-
-! An oint is a point with three linearly independent unit vectors
-! given relative to that point. In jamshred a player's location and
-! direction are given by the player's oint. Similarly, a tunnel
-! segment's location and orientation are given by an oint.
-
-TUPLE: oint location forward up left ;
-C: <oint> oint
-
-: rotation-quaternion ( theta axis -- quaternion )
-    swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ;
-
-: rotate-vector ( q qrecip v -- v )
-    v>q swap q* q* q>v ;
-
-: rotate-oint ( oint theta axis -- )
-    rotation-quaternion dup qrecip pick
-    [ forward>> rotate-vector >>forward ]
-    [ up>> rotate-vector >>up ]
-    [ left>> rotate-vector >>left ] 3tri drop ;
-
-: left-pivot ( oint theta -- )
-    over left>> rotate-oint ;
-
-: up-pivot ( oint theta -- )
-    over up>> rotate-oint ;
-
-: forward-pivot ( oint theta -- )
-    over forward>> rotate-oint ;
-
-: random-float+- ( n -- m )
-    #! find a random float between -n/2 and n/2
-    dup 10000 * >fixnum random 10000 / swap 2 / - ;
-
-: random-turn ( oint theta -- )
-    2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
-
-: location+ ( v oint -- )
-    [ location>> v+ ] [ (>>location) ] bi ;
-
-: go-forward ( distance oint -- )
-    [ forward>> n*v ] [ location+ ] bi ;
-
-: distance-vector ( oint oint -- vector )
-    [ location>> ] bi@ swap v- ;
-
-: distance ( oint oint -- distance )
-    distance-vector norm ;
-
-: scalar-projection ( v1 v2 -- n )
-    #! the scalar projection of v1 onto v2
-    tuck v. swap norm / ;
-
-: proj-perp ( u v -- w )
-    dupd proj v- ;
-
-: perpendicular-distance ( oint oint -- distance )
-    tuck distance-vector swap 2dup left>> scalar-projection abs
-    -rot up>> scalar-projection abs + ;
-
-:: reflect ( v n -- v' )
-    #! bounce v on a surface with normal n
-    v v n v. n n v. / 2 * n n*v v- ;
-
-: half-way ( p1 p2 -- p3 )
-    over v- 2 v/n v+ ;
-
-: half-way-between-oints ( o1 o2 -- p )
-    [ location>> ] bi@ half-way ;
diff --git a/unmaintained/jamshred/player/authors.txt b/unmaintained/jamshred/player/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/player/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/player/player.factor b/unmaintained/jamshred/player/player.factor
deleted file mode 100644
index 72f26a2c79..0000000000
--- a/unmaintained/jamshred/player/player.factor
+++ /dev/null
@@ -1,137 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ;
-IN: jamshred.player
-
-TUPLE: player < oint
-    { name string }
-    { sounds sounds }
-    tunnel
-    nearest-segment
-    { last-move integer }
-    { speed float } ;
-
-! speeds are in GL units / second
-: default-speed ( -- speed ) 1.0 ;
-: max-speed ( -- speed ) 30.0 ;
-
-: <player> ( name sounds -- player )
-    [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip
-    f f 0 default-speed player boa ;
-
-: turn-player ( player x-radians y-radians -- )
-    >r over r> left-pivot up-pivot ;
-
-: roll-player ( player z-radians -- )
-    forward-pivot ;
-
-: to-tunnel-start ( player -- )
-    [ tunnel>> first dup location>> ]
-    [ tuck (>>location) (>>nearest-segment) ] bi ;
-
-: play-in-tunnel ( player segments -- )
-    >>tunnel to-tunnel-start ;
-
-: update-nearest-segment ( player -- )
-    [ tunnel>> ] [ dup nearest-segment>> nearest-segment ]
-    [ (>>nearest-segment) ] tri ;
-
-: update-time ( player -- seconds-passed )
-    millis swap [ last-move>> - 1000 / ] [ (>>last-move) ] 2bi ;
-
-: moved ( player -- ) millis swap (>>last-move) ;
-
-: speed-range ( -- range )
-    max-speed [0,b] ;
-
-: change-player-speed ( inc player -- )
-    [ + speed-range clamp-to-range ] change-speed drop ;
-
-: multiply-player-speed ( n player -- )
-    [ * speed-range clamp-to-range ] change-speed drop ; 
-
-: distance-to-move ( seconds-passed player -- distance )
-    speed>> * ;
-
-: bounce ( d-left player -- d-left' player )
-    {
-        [ dup nearest-segment>> bounce-off-wall ]
-        [ sounds>> bang ]
-        [ 3/4 swap multiply-player-speed ]
-        [ ]
-    } cleave ;
-
-:: (distance) ( heading player -- current next location heading )
-    player nearest-segment>>
-    player [ tunnel>> ] [ nearest-segment>> ] bi heading heading-segment
-    player location>> heading ;
-
-: distance-to-heading-segment ( heading player -- distance )
-    (distance) distance-to-next-segment ;
-
-: distance-to-heading-segment-area ( heading player -- distance )
-    (distance) distance-to-next-segment-area ;
-
-: distance-to-collision ( player -- distance )
-    dup nearest-segment>> (distance-to-collision) ;
-
-: almost-to-collision ( player -- distance )
-    distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ;
-
-: from ( player -- radius distance-from-centre )
-    [ nearest-segment>> dup radius>> swap ] [ location>> ] bi
-    distance-from-centre ;
-
-: distance-from-wall ( player -- distance ) from - ;
-: fraction-from-centre ( player -- fraction ) from swap / ;
-: fraction-from-wall ( player -- fraction )
-    fraction-from-centre 1 swap - ;
-
-: update-nearest-segment2 ( heading player -- )
-    2dup distance-to-heading-segment-area 0 <= [
-        [ tunnel>> ] [ nearest-segment>> rot heading-segment ]
-        [ (>>nearest-segment) ] tri
-    ] [
-        2drop
-    ] if ;
-
-:: move-player-on-heading ( d-left player distance heading -- d-left' player )
-    [let* | d-to-move [ d-left distance min ]
-            move-v [ d-to-move heading n*v ] |
-        move-v player location+
-        heading player update-nearest-segment2
-        d-left d-to-move - player ] ;
-
-: distance-to-move-freely ( player -- distance )
-    [ almost-to-collision ]
-    [ [ forward>> ] keep distance-to-heading-segment-area ] bi min ;
-
-: ?move-player-freely ( d-left player -- d-left' player )
-    over 0 > [
-        ! must make sure we are moving a significant distance, otherwise
-        ! we can recurse endlessly due to floating-point imprecision.
-        ! (at least I /think/ that's what causes it...)
-        dup distance-to-move-freely dup 0.1 > [
-            over forward>> move-player-on-heading ?move-player-freely
-        ] [ drop ] if
-    ] when ;
-
-: drag-heading ( player -- heading )
-    [ forward>> ] [ nearest-segment>> forward>> proj ] bi ;
-
-: drag-player ( d-left player -- d-left' player )
-    dup [ [ drag-heading ] keep distance-to-heading-segment-area ]
-    [ drag-heading move-player-on-heading ] bi ;
-
-: (move-player) ( d-left player -- d-left' player )
-    ?move-player-freely over 0 > [
-        ! bounce
-        drag-player
-        (move-player)
-    ] when ;
-
-: move-player ( player -- )
-    [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
-
-: update-player ( player -- )
-    [ move-player ] [ nearest-segment>> white swap (>>color) ] bi ;
diff --git a/unmaintained/jamshred/sound/sound.factor b/unmaintained/jamshred/sound/sound.factor
deleted file mode 100644
index c19c67671f..0000000000
--- a/unmaintained/jamshred/sound/sound.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-! Copyright (C) 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors io.files kernel openal sequences ;
-IN: jamshred.sound
-
-TUPLE: sounds bang ;
-
-: assign-sound ( source wav-path -- )
-    resource-path create-buffer-from-wav AL_BUFFER swap set-source-param ;
-
-: <sounds> ( -- sounds )
-    init-openal 1 gen-sources first sounds boa
-    dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ;
-
-: bang ( sounds -- ) bang>> source-play check-error ;
diff --git a/unmaintained/jamshred/summary.txt b/unmaintained/jamshred/summary.txt
deleted file mode 100644
index e26fc1cf8b..0000000000
--- a/unmaintained/jamshred/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-A simple 3d tunnel racing game
diff --git a/unmaintained/jamshred/tags.txt b/unmaintained/jamshred/tags.txt
deleted file mode 100644
index 8ae5957a4b..0000000000
--- a/unmaintained/jamshred/tags.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-applications
-games
diff --git a/unmaintained/jamshred/tunnel/authors.txt b/unmaintained/jamshred/tunnel/authors.txt
deleted file mode 100644
index e9c193bac7..0000000000
--- a/unmaintained/jamshred/tunnel/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Alex Chapman
diff --git a/unmaintained/jamshred/tunnel/tunnel-tests.factor b/unmaintained/jamshred/tunnel/tunnel-tests.factor
deleted file mode 100644
index 9486713f55..0000000000
--- a/unmaintained/jamshred/tunnel/tunnel-tests.factor
+++ /dev/null
@@ -1,45 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays float-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 }
-        T{ segment f { 1 1 1 } f f f 1 }
-        T{ oint f { 0 0 0.25 } }
-        nearer-segment number>> ] unit-test
-
-[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
-[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
-[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment number>> ] unit-test
-
-[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
-
-[ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
-
-: test-segment-oint ( -- oint )
-    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
-
-[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
-[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
-[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
-[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
-[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
-[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
-[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
-[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
-
-: simplest-straight-ahead ( -- oint segment )
-    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
-    initial-segment ;
-
-[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
-[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
-
-: simple-collision-up ( -- oint segment )
-    { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
-    initial-segment ;
-
-[ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test
-[ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test
-[ { 0.0 1.0 0.0 } ]
-[ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test
diff --git a/unmaintained/jamshred/tunnel/tunnel.factor b/unmaintained/jamshred/tunnel/tunnel.factor
deleted file mode 100644
index 52f2d38dd1..0000000000
--- a/unmaintained/jamshred/tunnel/tunnel.factor
+++ /dev/null
@@ -1,167 +0,0 @@
-! Copyright (C) 2007, 2008 Alex Chapman
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors combinators float-arrays kernel
-locals math math.constants math.matrices math.order math.ranges
-math.vectors math.quadratic random sequences vectors jamshred.oint ;
-IN: jamshred.tunnel
-
-: n-segments ( -- n ) 5000 ; inline
-
-TUPLE: segment < oint number color radius ;
-C: <segment> segment
-
-: segment-number++ ( segment -- )
-    [ number>> 1+ ] keep (>>number) ;
-
-: random-color ( -- color )
-    { 100 100 100 } [ random 100 / >float ] map first3 1.0 <rgba> ;
-
-: tunnel-segment-distance ( -- n ) 0.4 ;
-: random-rotation-angle ( -- theta ) pi 20 / ;
-
-: random-segment ( previous-segment -- segment )
-    clone dup random-rotation-angle random-turn
-    tunnel-segment-distance over go-forward
-    random-color >>color dup segment-number++ ;
-
-: (random-segments) ( segments n -- segments )
-    dup 0 > [
-        >r dup peek random-segment over push r> 1- (random-segments)
-    ] [ drop ] if ;
-
-: default-segment-radius ( -- r ) 1 ;
-
-: initial-segment ( -- segment )
-    F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 }
-    0 random-color default-segment-radius <segment> ;
-
-: random-segments ( n -- segments )
-    initial-segment 1vector swap (random-segments) ;
-
-: simple-segment ( n -- segment )
-    [ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep
-    random-color default-segment-radius <segment> ;
-
-: simple-segments ( n -- segments )
-    [ simple-segment ] map ;
-
-: <random-tunnel> ( -- segments )
-    n-segments random-segments ;
-
-: <straight-tunnel> ( -- segments )
-    n-segments simple-segments ;
-
-: sub-tunnel ( from to segments -- segments )
-    #! return segments between from and to, after clamping from and to to
-    #! valid values
-    [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep <slice> ;
-
-: nearer-segment ( segment segment oint -- segment )
-    #! return whichever of the two segments is nearer to the oint
-    >r 2dup r> tuck distance >r distance r> < -rot ? ;
-
-: (find-nearest-segment) ( nearest next oint -- nearest ? )
-    #! find the nearest of 'next' and 'nearest' to 'oint', and return
-    #! t if the nearest hasn't changed
-    pick >r nearer-segment dup r> = ;
-
-: find-nearest-segment ( oint segments -- segment )
-    dup first swap rest-slice rot [ (find-nearest-segment) ] curry
-    find 2drop ;
-    
-: nearest-segment-forward ( segments oint start -- segment )
-    rot dup length swap <slice> find-nearest-segment ;
-
-: nearest-segment-backward ( segments oint start -- segment )
-    swapd 1+ 0 spin <slice> <reversed> find-nearest-segment ;
-
-: nearest-segment ( segments oint start-segment -- segment )
-    #! find the segment nearest to 'oint', and return it.
-    #! start looking at segment 'start-segment'
-    number>> over >r
-    [ nearest-segment-forward ] 3keep
-    nearest-segment-backward r> nearer-segment ;
-
-: get-segment ( segments n -- segment )
-    over sequence-index-range clamp-to-range swap nth ;
-
-: next-segment ( segments current-segment -- segment )
-    number>> 1+ get-segment ;
-
-: previous-segment ( segments current-segment -- segment )
-    number>> 1- get-segment ;
-
-: heading-segment ( segments current-segment heading -- segment )
-    #! the next segment on the given heading
-    over forward>> v. 0 <=> {
-        { +gt+ [ next-segment ] }
-        { +lt+ [ previous-segment ] }
-        { +eq+ [ nip ] } ! current segment
-    } case ;
-
-:: distance-to-next-segment ( current next location heading -- distance )
-    [let | cf [ current forward>> ] |
-        cf next location>> v. cf location v. - cf heading v. / ] ;
-
-:: distance-to-next-segment-area ( current next location heading -- distance )
-    [let | cf [ current forward>> ]
-           h [ next current half-way-between-oints ] |
-        cf h v. cf location v. - cf heading v. / ] ;
-
-: vector-to-centre ( seg loc -- v )
-    over location>> swap v- swap forward>> proj-perp ;
-
-: distance-from-centre ( seg loc -- distance )
-    vector-to-centre norm ;
-
-: wall-normal ( seg oint -- n )
-    location>> vector-to-centre normalize ;
-
-: distant ( -- n ) 1000 ;
-
-: max-real ( a b -- c )
-    #! sometimes collision-coefficient yields complex roots, so we ignore these (hack)
-    dup real? [
-        over real? [ max ] [ nip ] if
-    ] [
-        drop dup real? [ drop distant ] unless
-    ] if ;
-
-:: collision-coefficient ( v w r -- c )
-    v norm 0 = [
-        distant
-    ] [
-        [let* | a [ v dup v. ]
-                b [ v w v. 2 * ]
-                c [ w dup v. r sq - ] |
-            c b a quadratic max-real ]
-    ] if ;
-
-: sideways-heading ( oint segment -- v )
-    [ forward>> ] bi@ proj-perp ;
-
-: sideways-relative-location ( oint segment -- loc )
-    [ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
-
-: (distance-to-collision) ( oint segment -- distance )
-    [ sideways-heading ] [ sideways-relative-location ]
-    [ nip radius>> ] 2tri collision-coefficient ;
-
-: collision-vector ( oint segment -- v )
-    dupd (distance-to-collision) swap forward>> n*v ;
-
-: bounce-forward ( segment oint -- )
-    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
-
-: bounce-left ( segment oint -- )
-    #! must be done after forward
-    [ forward>> vneg ] dip [ left>> swap reflect ]
-    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
-
-: bounce-up ( segment oint -- )
-    #! must be done after forward and left!
-    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
-
-: bounce-off-wall ( oint segment -- )
-    swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;
-