diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index 938605ce9f..9cb5bc7c3a 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Alex Chapman +! 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 diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 69af7ab986..6c553147a1 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -41,8 +41,9 @@ IN: jamshred.gl : 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 + over color>> set-color segment-vertex-and-normal gl-normal gl-vertex ; : draw-vertex-pair ( theta next-segment segment -- ) diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index aa9c164b8f..2357742fde 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) ] [ [ jamshred>> jamshred-update ] [ relayout-1 ] - [ yield jamshred-loop ] tri + [ 10 sleep yield jamshred-loop ] tri ] if ; : fullscreen ( gadget -- ) @@ -36,7 +36,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) [ fullscreen? not ] keep set-fullscreen* ; M: jamshred-gadget graft* ( gadget -- ) - [ jamshred-loop ] in-thread drop ; + [ jamshred-loop ] curry in-thread ; M: jamshred-gadget ungraft* ( gadget -- ) jamshred>> t swap (>>quit) ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 418847673b..72f26a2c79 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,9 +1,15 @@ ! 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 system ; +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 sounds tunnel nearest-segment last-move speed ; +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 ; @@ -11,7 +17,7 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; : ( name sounds -- player ) [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip - f f f default-speed player boa ; + f f 0 default-speed player boa ; : turn-player ( player x-radians y-radians -- ) >r over r> left-pivot up-pivot ; @@ -69,6 +75,9 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; : 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 ; @@ -93,14 +102,17 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; heading player update-nearest-segment2 d-left d-to-move - player ] ; -: move-toward-wall ( d-left player d-to-wall -- d-left' player ) - over [ forward>> ] keep distance-to-heading-segment-area min - over forward>> move-player-on-heading ; +: 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 > [ - dup distance-to-collision dup 0.2 > [ ! bug! should be 0, not 0.2 - move-toward-wall ?move-player-freely + ! 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 ; diff --git a/extra/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor index fd1b1127bd..c19c67671f 100644 --- a/extra/jamshred/sound/sound.factor +++ b/extra/jamshred/sound/sound.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. USING: accessors io.files kernel openal sequences ; IN: jamshred.sound diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 8d2cc8e766..7082acec47 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ; +USING: accessors arrays colors combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ; USE: tools.walker IN: jamshred.tunnel @@ -13,7 +13,7 @@ C: segment [ number>> 1+ ] keep (>>number) ; : random-color ( -- color ) - { 100 100 100 } [ random 100 / >float ] map { 1.0 } append ; + { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; : tunnel-segment-distance ( -- n ) 0.4 ; : random-rotation-angle ( -- theta ) pi 20 / ;