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.
release
Alex Chapman 2007-10-01 15:10:59 +10:00
parent 5cd4054ec7
commit 80f6cb9e4f
4 changed files with 39 additions and 17 deletions

View File

@ -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 -- )

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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.