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

diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
index 938605ce9f3347a0c29675f037761bdf0c1c7a6b..9cb5bc7c3aab29866a841242c9f4e7502306ada9 100644 (file)
--- 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 69af7ab9869fadfb446b685e1caf57ab9140c886..6c553147a12a3d8419b0fc3caac154f151c38c41 100644 (file)
--- 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 aa9c164b8f73855245c02b97f01003c7d9ac1297..2357742fdeb75d0c27253039e2a10490400739e6 100755 (executable)
--- 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 418847673b09821243455c4d029225e8d81433e6..72f26a2c7921054208003044e15b759ba3a85dc1 100644 (file)
--- 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 ;
 
 : <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 ;
 

diff --git a/extra/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor
index fd1b1127bd255e6b61829e330c8cd1fb2914a7ec..c19c67671f13f1634f95035cbf848cce1327b8ab 100644 (file)
--- 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 8d2cc8e766afa392eb71d62bafa2107ba3b01ce5..7082acec47dd4a49f04fe4a13640b9c91f62b237 100755 (executable)
--- 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> 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 / ;