Jamshred is working again, hopefully even less buggy than ever!

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

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

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

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 ;
 
 : <player> ( 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 ;
 

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
 

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> 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 <rgba> ;
 
 : tunnel-segment-distance ( -- n ) 0.4 ;
 : random-rotation-angle ( -- theta ) pi 20 / ;