jamshred: it lives again, now you can jam and shred!

extra/jamshred/jamshred.factor

@@ -1,6 +1,9 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.rectangles math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
+USING: accessors arrays calendar jamshred.game jamshred.gl
+jamshred.player jamshred.log kernel math math.constants
+math.rectangles math.vectors namespaces sequences threads ui
+ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
 IN: jamshred
 
 TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
@@ -31,7 +34,7 @@ M: jamshred-gadget graft* ( gadget -- )
     [ [ jamshred-loop ] curry in-thread ] bi ;
 
 M: jamshred-gadget ungraft* ( gadget -- )
-    dup find-gl-context cleanup-graphics jamshred>> t swap (>>quit) ;
+    dup find-gl-context cleanup-graphics jamshred>> t swap quit<< ;
 
 : jamshred-restart ( jamshred-gadget -- )
     <jamshred> >>jamshred drop ;

extra/jamshred/oint/oint.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
+USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors random sequences ;
 IN: jamshred.oint
 
 ! An oint is a point with three linearly independent unit vectors
@@ -14,6 +14,35 @@ C: <oint> oint
 : rotation-quaternion ( theta axis -- quaternion )
     swap 2 / dup cos swap sin rot n*v first3 rect> [ rect> ] dip 2array ;
 
+<PRIVATE
+
+! inline old math.quaternions to get this to work, eww.
+
+: ** ( x y -- z ) conjugate * ; inline
+
+: 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline
+
+: q*a ( u v -- a ) 2q swapd ** [ * ] dip - ; inline
+
+: q*b ( u v -- b ) 2q [ ** swap ] dip * + ; inline
+
+: q* ( u v -- u*v )
+    [ q*a ] [ q*b ] 2bi 2array ;
+
+: v>q ( v -- q )
+    first3 rect> [ 0 swap rect> ] dip 2array ;
+
+: q>v ( q -- v )
+    first2 [ imaginary-part ] dip >rect 3array ;
+
+: qconjugate ( u -- u' )
+    first2 [ conjugate ] [ neg  ] bi* 2array ;
+
+: qrecip ( u -- 1/u )
+    qconjugate dup norm-sq v/n ;
+
+PRIVATE>
+
 : rotate-vector ( q qrecip v -- v )
     v>q swap q* q* q>v ;
 
@@ -40,7 +69,7 @@ C: <oint> oint
     2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
 
 : location+ ( v oint -- )
-    [ location>> v+ ] [ (>>location) ] bi ;
+    [ location>> v+ ] [ location<< ] bi ;
 
 : go-forward ( distance oint -- )
     [ forward>> n*v ] [ location+ ] bi ;

extra/jamshred/player/player.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors.constants combinators jamshred.log
+USING: accessors calendar.unix colors.constants combinators jamshred.log
 jamshred.oint jamshred.sound jamshred.tunnel kernel locals math
 math.constants math.order math.ranges math.vectors math.matrices
 sequences shuffle specialized-arrays strings system ;
@@ -39,9 +39,9 @@ CONSTANT: max-speed 30.0
     >>tunnel to-tunnel-start ;
 
 : update-time ( player -- seconds-passed )
-    system-micros swap [ last-move>> - 1000000 / ] [ (>>last-move) ] 2bi ;
+    system-micros swap [ last-move>> - 1000000 / ] [ last-move<< ] 2bi ;
 
-: moved ( player -- ) system-micros swap (>>last-move) ;
+: moved ( player -- ) system-micros swap last-move<< ;
 
 : speed-range ( -- range )
     max-speed [0,b] ;
@@ -92,7 +92,7 @@ CONSTANT: max-speed 30.0
 : update-nearest-segment2 ( heading player -- )
     2dup distance-to-heading-segment-area 0 <= [
         [ tunnel>> ] [ nearest-segment>> rot heading-segment ]
-        [ (>>nearest-segment) ] tri
+        [ nearest-segment<< ] tri
     ] [
         2drop
     ] if ;
@@ -137,4 +137,4 @@ CONSTANT: max-speed 30.0
     [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
 
 : update-player ( player -- )
-    [ move-player ] [ nearest-segment>> "white" named-color swap (>>color) ] bi ;
+    [ move-player ] [ nearest-segment>> "white" named-color swap color<< ] bi ;

extra/jamshred/sound/sound.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors io.pathnames kernel openal sequences ;
+USING: accessors io.pathnames kernel openal openal.alut sequences ;
 IN: jamshred.sound
 
 TUPLE: sounds bang ;

extra/jamshred/tags.txt

@@ -1,2 +1,3 @@
 applications
 games
+demos

extra/jamshred/tunnel/tunnel.factor

@@ -15,7 +15,7 @@ TUPLE: segment < oint number color radius ;
 C: <segment> segment
 
 : segment-number++ ( segment -- )
-    [ number>> 1 + ] keep (>>number) ;
+    [ number>> 1 + ] keep number<< ;
 
 : clamp-length ( n seq -- n' )
     0 swap length clamp ;
@@ -132,16 +132,16 @@ CONSTANT: distant 1000
     dupd (distance-to-collision) swap forward>> n*v ;
 
 : bounce-forward ( segment oint -- )
-    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
+    [ wall-normal ] [ forward>> swap reflect ] [ forward<< ] tri ;
 
 : bounce-left ( segment oint -- )
     #! must be done after forward
     [ forward>> vneg ] dip [ left>> swap reflect ]
-    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
+    [ forward>> proj-perp normalize ] [ left<< ] tri ;
 
 : bounce-up ( segment oint -- )
     #! must be done after forward and left!
-    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
+    nip [ forward>> ] [ left>> cross ] [ up<< ] tri ;
 
 : bounce-off-wall ( oint segment -- )
     swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;