From b9c4e65347bdaae70d5013080e5a90d9b7da5b2e Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 15 May 2008 16:41:44 +1000
Subject: [PATCH 1/6] jamshred: adding roll on sideways scroll

---
 extra/jamshred/game/game.factor     | 9 ++++++++-
 extra/jamshred/jamshred.factor      | 5 +++--
 extra/jamshred/oint/oint.factor     | 3 +++
 extra/jamshred/player/player.factor | 3 +++
 4 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
index dcb82d1de0..1d5a9e461e 100644
--- a/extra/jamshred/game/game.factor
+++ b/extra/jamshred/game/game.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 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.vectors ;
+USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ;
 IN: jamshred.game
 
 TUPLE: jamshred sounds tunnel players running quit ;
@@ -29,3 +29,10 @@ TUPLE: jamshred sounds tunnel players running quit ;
 : mouse-moved ( x-radians y-radians jamshred -- )
     jamshred-player -rot turn-player ;
 
+: mouse-units-per-full-roll ( -- n ) 50 ;
+
+: mouse-scroll-x ( jamshred x -- )
+    [ jamshred-player ] dip 2 pi * * mouse-units-per-full-roll / roll-player ;
+
+: mouse-scroll-y ( jamshred y -- )
+    neg swap jamshred-player change-player-speed ;
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
index 3fb7113fde..13b5bea1c1 100755
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -68,8 +68,9 @@ M: jamshred-gadget ungraft* ( gadget -- )
     ] 2keep >>last-hand-loc drop ;
 
 : handle-mouse-scroll ( jamshred-gadget -- )
-    jamshred>> jamshred-player scroll-direction get
-    second neg swap change-player-speed ;
+    jamshred>> scroll-direction get
+    [ first mouse-scroll-x ]
+    [ second mouse-scroll-y ] 2bi ;
 
 : quit ( gadget -- )
     [ no-fullscreen ] [ close-window ] bi ;
diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor
index e2104b6f41..d50a93a3d2 100644
--- a/extra/jamshred/oint/oint.factor
+++ b/extra/jamshred/oint/oint.factor
@@ -29,6 +29,9 @@ C: <oint> oint
 : up-pivot ( oint theta -- )
     over up>> rotate-oint ;
 
+: forward-pivot ( oint theta -- )
+    over forward>> rotate-oint ;
+
 : random-float+- ( n -- m )
     #! find a random float between -n/2 and n/2
     dup 10000 * >fixnum random 10000 / swap 2 / - ;
diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
index bea4ab4836..3d912e0085 100644
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@@ -16,6 +16,9 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ;
 : turn-player ( player x-radians y-radians -- )
     >r over r> left-pivot up-pivot ;
 
+: roll-player ( player z-radians -- )
+    forward-pivot ;
+
 : to-tunnel-start ( player -- )
     [ tunnel>> first dup location>> ]
     [ tuck (>>location) (>>nearest-segment) ] bi ;

From 0a44f2be8ba11363be0d484ddd4aa3ae43bea2e5 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 15 May 2008 16:52:44 +1000
Subject: [PATCH 2/6] jamshred: added arrow keys for acc/decelerate, and roll
 left/right

---
 extra/jamshred/game/game.factor | 8 +++++---
 extra/jamshred/jamshred.factor  | 4 ++++
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
index 1d5a9e461e..938605ce9f 100644
--- a/extra/jamshred/game/game.factor
+++ b/extra/jamshred/game/game.factor
@@ -29,10 +29,12 @@ TUPLE: jamshred sounds tunnel players running quit ;
 : mouse-moved ( x-radians y-radians jamshred -- )
     jamshred-player -rot turn-player ;
 
-: mouse-units-per-full-roll ( -- n ) 50 ;
+: units-per-full-roll ( -- n ) 50 ;
 
-: mouse-scroll-x ( jamshred x -- )
-    [ jamshred-player ] dip 2 pi * * mouse-units-per-full-roll / roll-player ;
+: jamshred-roll ( jamshred n -- )
+    [ jamshred-player ] dip 2 pi * * units-per-full-roll / roll-player ;
+        
+: mouse-scroll-x ( jamshred x -- ) jamshred-roll ;
 
 : mouse-scroll-y ( jamshred y -- )
     neg swap jamshred-player change-player-speed ;
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
index 13b5bea1c1..dd83efe824 100755
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -79,6 +79,10 @@ jamshred-gadget H{
     { T{ key-down f f "r" } [ jamshred-restart ] }
     { T{ key-down f f " " } [ jamshred>> toggle-running ] }
     { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
+    { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
+    { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
+    { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
+    { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
     { T{ key-down f f "q" } [ quit ] }
     { T{ motion } [ handle-mouse-motion ] }
     { T{ mouse-scroll } [ handle-mouse-scroll ] }

From 12be2d1b9c824d66cb2399357c632432053ad347 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Thu, 15 May 2008 17:00:19 +1000
Subject: [PATCH 3/6] jamshred: slow the player down when they hit a wall

---
 extra/jamshred/player/player.factor | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
index 3d912e0085..8dc5125143 100644
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel math math.constants math.order math.ranges shuffle sequences system ;
+USING: accessors colors combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel math math.constants math.order math.ranges shuffle sequences system ;
 IN: jamshred.player
 
 TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ;
@@ -38,6 +38,9 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ;
 : change-player-speed ( inc player -- )
     [ + speed-range clamp-to-range ] change-speed drop ;
 
+: multiply-player-speed ( n player -- )
+    [ * speed-range clamp-to-range ] change-speed drop ; 
+
 : distance-to-move ( player -- distance )
     [ speed>> ] [ last-move>> millis dup >r swap - 1000 / * r> ]
     [ (>>last-move) ] tri ;
@@ -46,8 +49,12 @@ DEFER: (move-player)
 
 : ?bounce ( distance-remaining player -- )
     over 0 > [
-        [ dup nearest-segment>> bounce ] [ sounds>> bang ]
-        [ (move-player) ] tri
+        {
+            [ dup nearest-segment>> bounce ]
+            [ sounds>> bang ]
+            [ 3/4 swap multiply-player-speed ]
+            [ (move-player) ]
+        } cleave
     ] [
         2drop
     ] if ;

From 817019678dc69350701eb63366b45add1d5841d9 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Sat, 17 May 2008 00:57:27 +1000
Subject: [PATCH 4/6] sync gl refresh with monitor refresh in macosx

---
 extra/cocoa/views/views.factor    | 14 ++++++++++++++
 extra/ui/cocoa/views/views.factor | 15 ++++++++++-----
 2 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/extra/cocoa/views/views.factor b/extra/cocoa/views/views.factor
index 7b8de9067c..ca631d5dea 100644
--- a/extra/cocoa/views/views.factor
+++ b/extra/cocoa/views/views.factor
@@ -74,3 +74,17 @@ PRIVATE>
     -> locationInWindow f -> convertPoint:fromView:
     dup NSPoint-x swap NSPoint-y
     r> -> frame NSRect-h swap - 2array ;
+
+USE: opengl.gl
+USE: alien.syntax
+
+: NSOpenGLCPSwapInterval 222 ;
+
+LIBRARY: OpenGL
+
+TYPEDEF: int CGLError
+TYPEDEF: void* CGLContextObj
+TYPEDEF: int CGLContextParameter
+
+FUNCTION: CGLError CGLSetParameter ( CGLContextObj ctx, CGLContextParameter pname, GLint* params ) ;
+
diff --git a/extra/ui/cocoa/views/views.factor b/extra/ui/cocoa/views/views.factor
index 83890788e3..20e6e19de5 100755
--- a/extra/ui/cocoa/views/views.factor
+++ b/extra/ui/cocoa/views/views.factor
@@ -1,10 +1,9 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays assocs cocoa kernel math cocoa.messages
+USING: alien alien.c-types arrays assocs cocoa kernel math cocoa.messages
 cocoa.subclassing cocoa.classes cocoa.views cocoa.application
-cocoa.pasteboard cocoa.types cocoa.windows sequences ui
-ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
-threads combinators ;
+cocoa.pasteboard cocoa.types cocoa.windows sequences ui ui.gadgets
+ui.gadgets.worlds ui.gestures core-foundation threads combinators ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )
@@ -360,8 +359,14 @@ CLASS: {
     ]
 } ;
 
+: sync-refresh-to-screen ( GLView -- )
+    -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 <int>
+    CGLSetParameter drop ;
+
 : <FactorView> ( world -- view )
-    FactorView over rect-dim <GLView> [ register-window ] keep ;
+    FactorView over rect-dim <GLView>
+    [ sync-refresh-to-screen ] keep
+    [ register-window ] keep ;
 
 CLASS: {
     { +superclass+ "NSObject" }

From 9f3baec4d28974f803a15b5acea54a2f73ad4844 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Sat, 17 May 2008 01:09:23 +1000
Subject: [PATCH 5/6] jamshred: updates... I don't remember what. But the
 flicker is gone!

---
 extra/jamshred/gl/gl.factor    | 4 ++--
 extra/jamshred/jamshred.factor | 8 ++++----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor
index 58e2b1f882..fe2009201f 100644
--- a/extra/jamshred/gl/gl.factor
+++ b/extra/jamshred/gl/gl.factor
@@ -51,9 +51,9 @@ IN: jamshred.gl
     GL_LIGHT0 glEnable
     GL_FOG glEnable
     GL_FOG_DENSITY 0.09 glFogf
+    GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
     GL_COLOR_MATERIAL glEnable
-    GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glColorMaterial
-    GL_LIGHT0 GL_POSITION F{ 0.0 0.0 -3.0 1.0 } >c-float-array glLightfv
+    GL_LIGHT0 GL_POSITION F{ 0.0 0.0 0.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 ;
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
index dd83efe824..078a23f5db 100755
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -21,9 +21,9 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
     dup jamshred>> quit>> [
         drop
     ] [
-        dup [ jamshred>> jamshred-update ]
-        [ relayout-1 ] bi
-        yield jamshred-loop
+        [ jamshred>> jamshred-update ]
+        [ relayout-1 ]
+        [ yield jamshred-loop ] tri
     ] if ;
 
 : fullscreen ( gadget -- )
@@ -45,7 +45,7 @@ M: jamshred-gadget ungraft* ( gadget -- )
     <jamshred> >>jamshred drop ;
 
 : pix>radians ( n m -- theta )
-    2 / / pi 2 * * ;
+    / pi 4 * * ; ! 2 / / pi 2 * * ;
 
 : x>radians ( x gadget -- theta )
     #! translate motion of x pixels to an angle

From 3a7faad878bf7cf3dcdcaf8494eb09cb1c9c4c47 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Sat, 17 May 2008 11:49:19 +1000
Subject: [PATCH 6/6] use gl-look-at, and make gl-look-at more elegant

---
 extra/jamshred/gl/gl.factor | 8 ++++----
 extra/opengl/opengl.factor  | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor
index fe2009201f..fffc97b4c6 100644
--- a/extra/jamshred/gl/gl.factor
+++ b/extra/jamshred/gl/gl.factor
@@ -59,10 +59,10 @@ IN: jamshred.gl
     GL_LIGHT0 GL_SPECULAR F{ 1.0 1.0 1.0 1.0 } >c-float-array glLightfv ;
 
 : player-view ( player -- )
-    [ location>> first3 ]
-    [ [ location>> ] [ forward>> ] bi v+ first3 ]
-    [ up>> first3 ] tri gluLookAt ;
+    [ location>> ]
+    [ [ location>> ] [ forward>> ] bi v+ ]
+    [ up>> ] tri gl-look-at ;
 
 : draw-jamshred ( jamshred width height -- )
-    init-graphics jamshred-player dup player-view draw-tunnel ;
+    init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ;
 
diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor
index ee58a4e345..a6e76cdc9e 100755
--- a/extra/opengl/opengl.factor
+++ b/extra/opengl/opengl.factor
@@ -154,7 +154,7 @@ MACRO: set-draw-buffers ( buffers -- )
     swap glPushAttrib call glPopAttrib ; inline
 
 : gl-look-at ( eye focus up -- )
-    >r >r first3 r> first3 r> first3 gluLookAt ;
+    [ first3 ] tri@ gluLookAt ;
 
 TUPLE: sprite loc dim dim2 dlist texture ;