jamshred updates

Jamshred now knows where the player is in the tunnel, and only renders 50
segments ahead and behind. It also turns the tunnel white as the player goes
through it.

extra/jamshred/game/game.factor

@@ -5,7 +5,7 @@ IN: jamshred.game
 TUPLE: jamshred tunnel players running ;
 
 : <jamshred> ( -- jamshred )
-    <random-tunnel> "Player 1" <player> 1array f
+    <random-tunnel> "Player 1" <player> 2dup swap play-in-tunnel 1array f
     jamshred construct-boa ;
 
 : jamshred-player ( jamshred -- player )
@@ -14,7 +14,7 @@ TUPLE: jamshred tunnel players running ;
 
 : jamshred-update ( jamshred -- )
     dup jamshred-running [
-        jamshred-player update-player
+        dup jamshred-tunnel swap jamshred-player update-player
     ] [ drop ] if ;
 
 : toggle-running ( jamshred -- )

extra/jamshred/gl/gl.factor

@@ -6,8 +6,11 @@ IN: jamshred.gl
 : min-vertices 6 ; inline
 : max-vertices 32 ; inline
 
-: n-vertices ( -- n )
-    32 ; inline
+: n-vertices ( -- n ) 32 ; inline
+
+! render enough of the tunnel that it looks continuous
+: n-segments-ahead ( -- n ) 50 ; inline
+: n-segments-behind ( -- n ) 50 ; inline
 
 : draw-segment-vertex ( segment theta -- )
     over segment-color gl-color segment-vertex-and-normal
@@ -25,8 +28,9 @@ IN: jamshred.gl
 : draw-segments ( segments -- )
     1 over length pick subseq swap [ draw-segment ] 2each ;
 
-: draw-tunnel ( tunnel -- )
-    tunnel-segments draw-segments ;
+: draw-tunnel ( player tunnel -- )
+    tuck swap player-nearest-segment segment-number dup n-segments-behind -
+    swap n-segments-ahead + rot sub-tunnel draw-segments ;
 
 : init-graphics ( width height -- )
     GL_DEPTH_TEST glEnable
@@ -57,6 +61,6 @@ IN: jamshred.gl
     oint-up first3 gluLookAt ;
 
 : draw-jamshred ( jamshred width height -- )
-    init-graphics dup jamshred-player player-view
-    jamshred-tunnel draw-tunnel ;
+    init-graphics dup jamshred-player dup player-view
+    swap jamshred-tunnel draw-tunnel ;
 

extra/jamshred/player/player.factor

@@ -1,5 +1,5 @@
-USING: jamshred.game jamshred.oint jamshred.tunnel kernel
-math.constants ;
+USING: colors jamshred.game jamshred.oint jamshred.tunnel kernel
+math.constants sequences ;
 IN: jamshred.player
 
 TUPLE: player name speed last-segment ;
@@ -8,13 +8,18 @@ TUPLE: player name speed last-segment ;
     1 f player construct-boa
     { 0 0 5 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> over set-delegate ;
 
-: update-player ( player -- )
-    0.1 swap go-forward ;
-
 : turn-player ( player x-radians y-radians -- )
     >r over r> left-pivot up-pivot ;
 
+: play-in-tunnel ( player tunnel -- )
+    tunnel-segments first dup oint-location pick set-oint-location
+    swap set-player-last-segment ;
+
 : player-nearest-segment ( tunnel player -- segment )
     [
         dup player-last-segment nearest-segment
     ] keep dupd set-player-last-segment ;
+
+: update-player ( tunnel player -- )
+    0.1 over go-forward player-nearest-segment white swap set-segment-color ;
+

extra/jamshred/tunnel/tunnel.factor

@@ -1,8 +1,8 @@
-USING: arrays kernel jamshred.oint math math.functions math.vectors
+USING: arrays kernel jamshred.oint math math.functions math.ranges math.vectors
 math.constants random sequences vectors ;
 IN: jamshred.tunnel
 
-: n-segments ( -- n ) 100 ; inline
+: n-segments ( -- n ) 5000 ; inline
 
 TUPLE: segment number color radius ;
 
@@ -71,18 +71,31 @@ C: <tunnel> tunnel
 : <straight-tunnel> ( -- tunnel )
     n-segments simple-segments <tunnel> ;
 
+: sub-tunnel ( from to tunnel -- segments )
+    #! return segments between from and to, after clamping from and to to
+    #! valid values
+    tunnel-segments [
+        sequence-index-range [ clamp-to-range ] curry 2apply
+    ] 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 )
-    tuck first swap [ -rot nearer-segment ] curry reduce ;
+    dup first swap 1 tail-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 )
-    1+ 0 swap rot <slice> <reversed> find-nearest-segment ;
+    swapd 1+ 0 swap rot <slice> <reversed> find-nearest-segment ;
 
 : nearest-segment ( tunnel oint start-segment -- segment )
     #! find the segment nearest to 'oint', and return it.