jamshred playable (just)
Alex Chapman
parent
80f6cb9e4f
commit
e818a7c71f
|
|
@ -14,7 +14,7 @@ TUPLE: jamshred tunnel players running ;
|
|||
|
||||
: jamshred-update ( jamshred -- )
|
||||
dup jamshred-running [
|
||||
dup jamshred-tunnel swap jamshred-player update-player
|
||||
jamshred-player update-player
|
||||
] [ drop ] if ;
|
||||
|
||||
: toggle-running ( jamshred -- )
|
||||
|
|
|
|||
|
|
@ -9,8 +9,8 @@ IN: jamshred.gl
|
|||
: 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
|
||||
: n-segments-ahead ( -- n ) 60 ; inline
|
||||
: n-segments-behind ( -- n ) 40 ; inline
|
||||
|
||||
: draw-segment-vertex ( segment theta -- )
|
||||
over segment-color gl-color segment-vertex-and-normal
|
||||
|
|
@ -22,15 +22,22 @@ IN: jamshred.gl
|
|||
: draw-segment ( next-segment segment -- )
|
||||
GL_QUAD_STRIP [
|
||||
[ draw-vertex-pair ] 2curry
|
||||
n-vertices equally-spaced-radians { 0.0 } append swap each
|
||||
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 ;
|
||||
|
||||
: draw-tunnel ( player tunnel -- )
|
||||
tuck swap player-nearest-segment segment-number dup n-segments-behind -
|
||||
swap n-segments-ahead + rot sub-tunnel draw-segments ;
|
||||
: segments-to-render ( player -- segments )
|
||||
dup player-nearest-segment segment-number dup n-segments-behind -
|
||||
swap n-segments-ahead + rot player-tunnel sub-tunnel ;
|
||||
|
||||
: draw-tunnel ( player -- )
|
||||
segments-to-render 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
|
||||
|
|
@ -39,21 +46,19 @@ IN: jamshred.gl
|
|||
0.0 0.0 0.0 0.0 glClearColor
|
||||
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
|
||||
GL_PROJECTION glMatrixMode glLoadIdentity
|
||||
! / >float 45.0 swap 0.1 100.0 gluPerspective
|
||||
2drop 45.0 1024 768 / >float 0.1 100.0 gluPerspective
|
||||
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.06 glFogf
|
||||
GL_FOG_DENSITY 0.09 glFogf
|
||||
GL_COLOR_MATERIAL glEnable
|
||||
GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glColorMaterial
|
||||
GL_LIGHT0 GL_POSITION { 0.0 0.0 -3.0 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_AMBIENT { 0.2 0.2 0.2 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_DIFFUSE { 1.0 1.0 1.0 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_SPECULAR { 1.0 1.0 1.0 1.0 } >c-float-array glLightfv
|
||||
;
|
||||
GL_LIGHT0 GL_POSITION F{ 0.0 0.0 -3.0 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_AMBIENT F{ 0.2 0.2 0.2 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_DIFFUSE F{ 1.0 1.0 1.0 1.0 } >c-float-array glLightfv
|
||||
GL_LIGHT0 GL_SPECULAR F{ 1.0 1.0 1.0 1.0 } >c-float-array glLightfv ;
|
||||
|
||||
: player-view ( player -- )
|
||||
[ oint-location first3 ] keep
|
||||
|
|
@ -61,6 +66,5 @@ IN: jamshred.gl
|
|||
oint-up first3 gluLookAt ;
|
||||
|
||||
: draw-jamshred ( jamshred width height -- )
|
||||
init-graphics dup jamshred-player dup player-view
|
||||
swap jamshred-tunnel draw-tunnel ;
|
||||
init-graphics jamshred-player dup player-view draw-tunnel ;
|
||||
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ M: jamshred-gadget ungraft* ( gadget -- ) remove-timer ;
|
|||
<jamshred> swap set-jamshred-gadget-jamshred ;
|
||||
|
||||
: pix>radians ( n m -- theta )
|
||||
2 / / pi * ;
|
||||
2 / / pi 2 * * ;
|
||||
|
||||
: x>radians ( x gadget -- theta )
|
||||
#! translate motion of x pixels to an angle
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: arrays kernel math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
|
||||
USING: arrays float-arrays kernel 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
|
||||
|
|
@ -16,9 +16,9 @@ TUPLE: oint location forward up left ;
|
|||
! #! { { 1 0 0 }
|
||||
! #! { 0 cos(theta) sin(theta) }
|
||||
! #! { 0 -sin(theta) cos(theta) } }
|
||||
! dup sin neg swap cos 2dup 0 -rot 3array >r
|
||||
! swap neg 0 -rot 3array >r
|
||||
! { 1 0 0 } r> r> 3array ;
|
||||
! dup sin neg swap cos 2dup 0 -rot 3float-array >r
|
||||
! swap neg 0 -rot 3float-array >r
|
||||
! { 1 0 0 } r> r> 3float-array ;
|
||||
!
|
||||
! : y-rotation ( theta -- matrix )
|
||||
! #! costruct this matrix:
|
||||
|
|
@ -26,9 +26,9 @@ TUPLE: oint location forward up left ;
|
|||
! #! { 0 1 0 }
|
||||
! #! { sin(theta) 0 cos(theta) } }
|
||||
! dup sin swap cos 2dup
|
||||
! 0 swap 3array >r
|
||||
! 0 swap 3float-array >r
|
||||
! { 0 1 0 } >r
|
||||
! 0 rot neg 3array r> r> 3array ;
|
||||
! 0 rot neg 3float-array r> r> 3float-array ;
|
||||
|
||||
: apply-to-oint ( oint quot -- )
|
||||
#! apply quot to each of forward, up, and left, storing the results
|
||||
|
|
@ -59,5 +59,16 @@ TUPLE: oint location forward up left ;
|
|||
: go-forward ( distance oint -- )
|
||||
tuck oint-forward n*v over oint-location v+ swap set-oint-location ;
|
||||
|
||||
: distance-vector ( oint oint -- vector )
|
||||
oint-location swap oint-location v- ;
|
||||
|
||||
: distance ( oint oint -- distance )
|
||||
oint-location swap oint-location v- norm ;
|
||||
distance-vector norm ;
|
||||
|
||||
: scalar-projection ( v1 v2 -- n )
|
||||
#! the scalar projection of v1 onto v2
|
||||
tuck v. swap norm / ;
|
||||
|
||||
: perpendicular-distance ( oint oint -- distance )
|
||||
tuck distance-vector swap 2dup oint-left scalar-projection abs
|
||||
-rot oint-up scalar-projection abs + ;
|
||||
|
|
|
|||
|
|
@ -1,25 +1,36 @@
|
|||
USING: colors jamshred.game jamshred.oint jamshred.tunnel kernel
|
||||
math.constants sequences ;
|
||||
math math.constants sequences ;
|
||||
IN: jamshred.player
|
||||
|
||||
TUPLE: player name speed last-segment ;
|
||||
TUPLE: player name tunnel nearest-segment ;
|
||||
|
||||
: <player> ( name -- player )
|
||||
1 f player construct-boa
|
||||
{ 0 0 5 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> over set-delegate ;
|
||||
f f player construct-boa
|
||||
F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <oint> over set-delegate ;
|
||||
|
||||
: 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 ;
|
||||
: to-tunnel-start ( player -- )
|
||||
dup player-tunnel first dup oint-location pick set-oint-location
|
||||
swap set-player-nearest-segment ;
|
||||
|
||||
: player-nearest-segment ( tunnel player -- segment )
|
||||
[
|
||||
dup player-last-segment nearest-segment
|
||||
] keep dupd set-player-last-segment ;
|
||||
: play-in-tunnel ( player segments -- )
|
||||
over set-player-tunnel to-tunnel-start ;
|
||||
|
||||
: update-player ( tunnel player -- )
|
||||
0.1 over go-forward player-nearest-segment white swap set-segment-color ;
|
||||
: update-nearest-segment ( player -- )
|
||||
dup player-tunnel over dup player-nearest-segment nearest-segment
|
||||
swap set-player-nearest-segment ;
|
||||
|
||||
: max-speed ( -- speed )
|
||||
0.3 ;
|
||||
|
||||
: player-speed ( player -- speed )
|
||||
dup player-nearest-segment fraction-from-wall sq max-speed * ;
|
||||
|
||||
: move-player ( player -- )
|
||||
dup player-speed over go-forward update-nearest-segment ;
|
||||
|
||||
: update-player ( player -- )
|
||||
dup move-player player-nearest-segment
|
||||
white swap set-segment-color ;
|
||||
|
|
|
|||
|
|
@ -6,10 +6,10 @@ IN: temporary
|
|||
T{ oint f { 0 0 0.25 } }
|
||||
nearer-segment segment-number ] unit-test
|
||||
|
||||
[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> tunnel-segments find-nearest-segment segment-number ] unit-test
|
||||
[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> tunnel-segments find-nearest-segment segment-number ] unit-test
|
||||
[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> tunnel-segments find-nearest-segment segment-number ] unit-test
|
||||
[ 0 ] [ T{ oint f { 0 0 0 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
|
||||
[ 1 ] [ T{ oint f { 0 0 -1 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
|
||||
[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } <straight-tunnel> find-nearest-segment segment-number ] unit-test
|
||||
|
||||
[ 3 ] [ <straight-tunnel> tunnel-segments T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test
|
||||
[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test
|
||||
|
||||
[ { 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over tunnel-segments first nearest-segment oint-location ] unit-test
|
||||
[ { 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment oint-location ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: arrays kernel jamshred.oint math math.functions math.ranges math.vectors
|
||||
math.constants random sequences vectors ;
|
||||
USING: arrays float-arrays kernel jamshred.oint math math.functions
|
||||
math.ranges math.vectors math.constants random sequences vectors ;
|
||||
IN: jamshred.tunnel
|
||||
|
||||
: n-segments ( -- n ) 5000 ; inline
|
||||
|
|
@ -30,8 +30,8 @@ TUPLE: segment number color radius ;
|
|||
: random-color ( -- color )
|
||||
{ 100 100 100 } [ random 100 / >float ] map { 1.0 } append ;
|
||||
|
||||
: tunnel-segment-distance ( -- n ) 0.5 ;
|
||||
: random-rotation-angle ( -- theta ) pi 6 / ;
|
||||
: tunnel-segment-distance ( -- n ) 0.4 ;
|
||||
: random-rotation-angle ( -- theta ) pi 20 / ;
|
||||
|
||||
: random-segment ( previous-segment -- segment )
|
||||
clone dup random-rotation-angle random-turn
|
||||
|
|
@ -49,34 +49,28 @@ TUPLE: segment number color radius ;
|
|||
|
||||
: initial-segment ( -- segment )
|
||||
0 random-color default-segment-radius
|
||||
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <segment> ;
|
||||
F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <segment> ;
|
||||
|
||||
: random-segments ( n -- segments )
|
||||
initial-segment 1vector swap (random-segments) ;
|
||||
|
||||
: simple-segment ( n -- segment )
|
||||
random-color default-segment-radius pick { 0 0 -1 } n*v
|
||||
{ 0 0 -1 } { 0 1 0 } { -1 0 0 } <segment> ;
|
||||
random-color default-segment-radius pick F{ 0 0 -1 } n*v
|
||||
F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <segment> ;
|
||||
|
||||
: simple-segments ( n -- segments )
|
||||
[ simple-segment ] map ;
|
||||
|
||||
TUPLE: tunnel segments ;
|
||||
: <random-tunnel> ( -- segments )
|
||||
n-segments random-segments ;
|
||||
|
||||
C: <tunnel> tunnel
|
||||
: <straight-tunnel> ( -- segments )
|
||||
n-segments simple-segments ;
|
||||
|
||||
: <random-tunnel> ( -- tunnel )
|
||||
n-segments random-segments <tunnel> ;
|
||||
|
||||
: <straight-tunnel> ( -- tunnel )
|
||||
n-segments simple-segments <tunnel> ;
|
||||
|
||||
: sub-tunnel ( from to tunnel -- segments )
|
||||
: sub-tunnel ( from to sements -- 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> ;
|
||||
[ 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
|
||||
|
|
@ -97,10 +91,21 @@ C: <tunnel> tunnel
|
|||
: nearest-segment-backward ( segments oint start -- segment )
|
||||
swapd 1+ 0 swap rot <slice> <reversed> find-nearest-segment ;
|
||||
|
||||
: nearest-segment ( tunnel oint start-segment -- segment )
|
||||
: nearest-segment ( segments oint start-segment -- segment )
|
||||
#! find the segment nearest to 'oint', and return it.
|
||||
#! start looking at segment 'start-segment'
|
||||
segment-number over >r
|
||||
>r >r tunnel-segments r> r>
|
||||
[ nearest-segment-forward ] 3keep
|
||||
nearest-segment-backward r> nearer-segment ;
|
||||
|
||||
: distance-from-centre ( oint segment -- distance )
|
||||
perpendicular-distance ;
|
||||
|
||||
: distance-from-wall ( oint segment -- distance )
|
||||
tuck distance-from-centre swap segment-radius swap - ;
|
||||
|
||||
: fraction-from-centre ( oint segment -- fraction )
|
||||
tuck distance-from-centre swap segment-radius / ;
|
||||
|
||||
: fraction-from-wall ( oint segment -- fraction )
|
||||
fraction-from-centre 1 swap - ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue