From 796e5f58eb5b237e9bb6fa887cd26cae2b9d8d75 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Fri, 2 May 2008 17:52:17 +1000 Subject: [PATCH 1/8] starting to add bouncing to jamshred --- extra/jamshred/oint/oint.factor | 4 ++++ extra/jamshred/player/player.factor | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index 11a89b314f..4680be4575 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -74,3 +74,7 @@ TUPLE: oint location forward up left ; : perpendicular-distance ( oint oint -- distance ) tuck distance-vector swap 2dup oint-left scalar-projection abs -rot oint-up scalar-projection abs + ; + +:: reflect ( v l -- v' ) + #! reflect v on l + v l v. l l v. / 2 * l n*v v v- ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 17843ef9c2..3e143a845e 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -28,7 +28,8 @@ TUPLE: player name tunnel nearest-segment ; 0.3 ; : player-speed ( player -- speed ) - dup player-nearest-segment fraction-from-wall sq max-speed * ; + max-speed ; + ! dup player-nearest-segment fraction-from-wall sq max-speed * ; : move-player ( player -- ) dup player-speed over go-forward update-nearest-segment ; From 78712fef1b7f68df705287b1912caac198bc7c32 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Wed, 7 May 2008 13:58:03 +1000 Subject: [PATCH 2/8] jamshred: some dodgy debug logging, and some dodgy collision detection :) --- extra/jamshred/game/game.factor | 9 ++-- extra/jamshred/jamshred.factor | 26 ++++----- extra/jamshred/log/log.factor | 10 ++++ extra/jamshred/oint/oint.factor | 64 +++++++++------------- extra/jamshred/player/player.factor | 55 +++++++++++++------ extra/jamshred/tunnel/tunnel.factor | 82 ++++++++++++++++++++++++----- 6 files changed, 157 insertions(+), 89 deletions(-) create mode 100644 extra/jamshred/log/log.factor diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index 3842816f0e..2a5fefcaed 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: kernel opengl arrays sequences jamshred.tunnel -jamshred.player math.vectors ; +USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.tunnel math.vectors ; IN: jamshred.game TUPLE: jamshred tunnel players running ; @@ -12,15 +11,15 @@ TUPLE: jamshred tunnel players running ; : jamshred-player ( jamshred -- player ) ! TODO: support more than one player - jamshred-players first ; + players>> first ; : jamshred-update ( jamshred -- ) - dup jamshred-running [ + dup running>> [ jamshred-player update-player ] [ drop ] if ; : toggle-running ( jamshred -- ) - dup jamshred-running not swap set-jamshred-running ; + [ running>> not ] [ (>>running) ] bi ; : mouse-moved ( x-radians y-radians jamshred -- ) jamshred-player -rot turn-player ; diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 42414b9893..3a7047929f 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -1,14 +1,12 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: alarms arrays calendar jamshred.game jamshred.gl kernel math -math.constants namespaces sequences ui ui.gadgets ui.gestures ui.render -math.vectors ; +USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.log kernel math math.constants namespaces sequences ui ui.gadgets ui.gestures ui.render math.vectors ; IN: jamshred TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; : ( jamshred -- gadget ) - jamshred-gadget construct-gadget tuck set-jamshred-gadget-jamshred ; + jamshred-gadget construct-gadget swap >>jamshred ; : default-width ( -- x ) 1024 ; : default-height ( -- y ) 768 ; @@ -17,22 +15,21 @@ M: jamshred-gadget pref-dim* drop default-width default-height 2array ; M: jamshred-gadget draw-gadget* ( gadget -- ) - dup jamshred-gadget-jamshred swap rect-dim first2 draw-jamshred ; + [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ; : tick ( gadget -- ) - dup jamshred-gadget-jamshred jamshred-update relayout-1 ; + [ jamshred>> jamshred-update ] [ relayout-1 ] bi ; M: jamshred-gadget graft* ( gadget -- ) [ [ tick ] curry 10 milliseconds from-now 10 milliseconds add-alarm - ] keep set-jamshred-gadget-alarm ; + ] keep (>>alarm) ; M: jamshred-gadget ungraft* ( gadget -- ) - [ jamshred-gadget-alarm cancel-alarm f ] keep - set-jamshred-gadget-alarm ; + [ alarm>> cancel-alarm ] [ f >>alarm drop ] bi ; : jamshred-restart ( jamshred-gadget -- ) - swap set-jamshred-gadget-jamshred ; + >>jamshred drop ; : pix>radians ( n m -- theta ) 2 / / pi 2 * * ; @@ -46,21 +43,20 @@ M: jamshred-gadget ungraft* ( gadget -- ) rect-dim second pix>radians ; : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- ) - over jamshred-gadget-jamshred >r + over jamshred>> >r [ first swap x>radians ] 2keep second swap y>radians r> mouse-moved ; : handle-mouse-motion ( jamshred-gadget -- ) hand-loc get [ - over jamshred-gadget-last-hand-loc [ + over last-hand-loc>> [ v- (handle-mouse-motion) ] [ 2drop ] if* - ] 2keep swap set-jamshred-gadget-last-hand-loc ; + ] 2keep >>last-hand-loc drop ; -USE: vocabs.loader jamshred-gadget H{ { T{ key-down f f "r" } [ jamshred-restart ] } - { T{ key-down f f " " } [ jamshred-gadget-jamshred toggle-running ] } + { T{ key-down f f " " } [ jamshred>> toggle-running ] } { T{ motion } [ handle-mouse-motion ] } } set-gestures diff --git a/extra/jamshred/log/log.factor b/extra/jamshred/log/log.factor new file mode 100644 index 0000000000..33498d8a2e --- /dev/null +++ b/extra/jamshred/log/log.factor @@ -0,0 +1,10 @@ +USING: kernel logging ; +IN: jamshred.log + +LOG: (jamshred-log) DEBUG + +: with-jamshred-log ( quot -- ) + "jamshred" swap with-logging ; + +: jamshred-log ( message -- ) + [ (jamshred-log) ] with-jamshred-log ; ! ugly... diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index 4680be4575..6b4f22bb9e 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: arrays float-arrays kernel math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ; +USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ; IN: jamshred.oint ! An oint is a point with three linearly independent unit vectors @@ -10,46 +10,23 @@ IN: jamshred.oint TUPLE: oint location forward up left ; -: ( location forward up left -- oint ) - oint boa ; - -! : x-rotation ( theta -- matrix ) -! #! construct this matrix: -! #! { { 1 0 0 } -! #! { 0 cos(theta) sin(theta) } -! #! { 0 -sin(theta) cos(theta) } } -! dup sin neg swap cos 2dup 0 -rot 3float-array >r -! swap neg 0 -rot 3float-array >r -! { 1 0 0 } r> r> 3float-array ; -! -! : y-rotation ( theta -- matrix ) -! #! costruct this matrix: -! #! { { cos(theta) 0 -sin(theta) } -! #! { 0 1 0 } -! #! { sin(theta) 0 cos(theta) } } -! dup sin swap cos 2dup -! 0 swap 3float-array >r -! { 0 1 0 } >r -! 0 rot neg 3float-array r> r> 3float-array ; - -: apply-to-oint ( oint quot -- ) - #! apply quot to each of forward, up, and left, storing the results - over oint-forward over call pick set-oint-forward - over oint-up over call pick set-oint-up - over oint-left swap call swap set-oint-left ; - : rotation-quaternion ( theta axis -- quaternion ) swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ; +: rotate-vector ( q qrecip v -- v ) + v>q swap q* q* q>v ; + : rotate-oint ( oint theta axis -- ) - rotation-quaternion dup qrecip - [ rot v>q swap q* q* q>v ] curry curry apply-to-oint ; + rotation-quaternion dup qrecip pick + [ forward>> rotate-vector >>forward ] + [ up>> rotate-vector >>up ] + [ left>> rotate-vector >>left ] 3tri drop ; : left-pivot ( oint theta -- ) - over oint-left rotate-oint ; + over left>> rotate-oint ; : up-pivot ( oint theta -- ) - over oint-up rotate-oint ; + over up>> rotate-oint ; : random-float+- ( n -- m ) #! find a random float between -n/2 and n/2 @@ -59,10 +36,10 @@ TUPLE: oint location forward up left ; 2 / 2dup random-float+- left-pivot random-float+- up-pivot ; : go-forward ( distance oint -- ) - tuck oint-forward n*v over oint-location v+ swap set-oint-location ; + [ forward>> n*v ] [ location>> v+ ] [ (>>location) ] tri ; : distance-vector ( oint oint -- vector ) - oint-location swap oint-location v- ; + [ location>> ] bi@ swap v- ; : distance ( oint oint -- distance ) distance-vector norm ; @@ -72,9 +49,16 @@ TUPLE: oint location forward up left ; tuck v. swap norm / ; : perpendicular-distance ( oint oint -- distance ) - tuck distance-vector swap 2dup oint-left scalar-projection abs - -rot oint-up scalar-projection abs + ; + tuck distance-vector swap 2dup left>> scalar-projection abs + -rot up>> scalar-projection abs + ; -:: reflect ( v l -- v' ) - #! reflect v on l - v l v. l l v. / 2 * l n*v v v- ; +: proj-perp ( v u -- w ) + dupd proj v- ; + +! :: reflect ( v l -- v' ) +! #! reflect v on l +! v l v. l l v. / 2 * l n*v v v- ; + +:: reflect ( vec n -- v' ) + #! bounce v on a surface with normal n + vec n v. n n*v -2 * vec v+ ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 3e143a845e..6feca27366 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,39 +1,64 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: colors jamshred.oint jamshred.tunnel kernel -math math.constants sequences ; +USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order sequences ; IN: jamshred.player -TUPLE: player name tunnel nearest-segment ; +TUPLE: player < oint name tunnel nearest-segment ; : ( name -- player ) - f f player boa - F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } over set-delegate ; + [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip f f player boa ; : turn-player ( player x-radians y-radians -- ) >r over r> left-pivot up-pivot ; : to-tunnel-start ( player -- ) - dup player-tunnel first dup oint-location pick set-oint-location - swap set-player-nearest-segment ; + [ tunnel>> first dup location>> ] + [ tuck (>>location) (>>nearest-segment) ] bi ; : play-in-tunnel ( player segments -- ) - over set-player-tunnel to-tunnel-start ; + >>tunnel to-tunnel-start ; : update-nearest-segment ( player -- ) - dup player-tunnel over dup player-nearest-segment nearest-segment - swap set-player-nearest-segment ; + [ tunnel>> ] [ dup nearest-segment>> nearest-segment ] + [ (>>nearest-segment) ] tri ; : max-speed ( -- speed ) - 0.3 ; + 0.01 ; : player-speed ( player -- speed ) - max-speed ; - ! dup player-nearest-segment fraction-from-wall sq max-speed * ; + drop max-speed ; + ! dup nearest-segment>> fraction-from-wall sq max-speed * ; + +! : move-player ( player -- ) +! dup player-speed over go-forward update-nearest-segment ; +DEFER: (move-player) + +: ?bounce ( distance-remaining player -- ) + over 0 > [ + [ dup nearest-segment>> bounce ] + ! [ (move-player) ] ! uncomment when bounce works... + [ 2drop ] + bi + ] [ + 2drop + ] if ; + +: move-player-distance ( distance-remaining player distance -- distance-remaining player ) + pick min tuck over go-forward [ - ] dip ; + +USE: prettyprint +USE: io.streams.string +: (move-player) ( distance-remaining player -- ) + over 0 <= [ + 2drop + ] [ + dup dup nearest-segment>> distance-to-collision ! [ .s ] with-string-writer jamshred-log + move-player-distance ?bounce + ] if ; : move-player ( player -- ) - dup player-speed over go-forward update-nearest-segment ; + [ player-speed ] [ (move-player) ] [ update-nearest-segment ] tri ; : update-player ( player -- ) - dup move-player player-nearest-segment + dup move-player nearest-segment>> white swap set-segment-color ; diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index c3f6b37fb8..7c6740f139 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,23 +1,20 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: arrays float-arrays kernel jamshred.oint math math.functions -math.ranges math.vectors math.constants random sequences vectors ; +USING: accessors arrays float-arrays kernel jamshred.oint locals math math.functions math.constants math.matrices math.order math.ranges math.vectors random sequences vectors ; IN: jamshred.tunnel : n-segments ( -- n ) 5000 ; inline -TUPLE: segment number color radius ; - -: ( number color radius location forward up left -- segment ) - >r segment boa r> over set-delegate ; +TUPLE: segment < oint number color radius ; +C: segment : segment-vertex ( theta segment -- vertex ) - tuck 2dup oint-up swap sin v*n - >r oint-left swap cos v*n r> v+ - swap oint-location v+ ; + tuck 2dup up>> swap sin v*n + >r left>> swap cos v*n r> v+ + swap location>> v+ ; : segment-vertex-normal ( vertex segment -- normal ) - oint-location swap v- normalize ; + location>> swap v- normalize ; : segment-vertex-and-normal ( segment theta -- vertex normal ) swap [ segment-vertex ] keep dupd segment-vertex-normal ; @@ -50,15 +47,15 @@ TUPLE: segment number color radius ; : default-segment-radius ( -- r ) 1 ; : initial-segment ( -- segment ) - 0 random-color default-segment-radius - F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ; + F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } + 0 random-color default-segment-radius ; : random-segments ( n -- segments ) initial-segment 1vector swap (random-segments) ; : simple-segment ( n -- segment ) - random-color default-segment-radius pick F{ 0 0 -1 } n*v - F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ; + [ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep + random-color default-segment-radius ; : simple-segments ( n -- segments ) [ simple-segment ] map ; @@ -111,3 +108,60 @@ TUPLE: segment number color radius ; : fraction-from-wall ( oint segment -- fraction ) fraction-from-centre 1 swap - ; + +: sideways-heading ( oint segment -- v ) + [ forward>> ] bi@ proj-perp ; + +! : facing-nearest-wall? ( oint segment -- ? ) +! [ [ location>> ] bi@ distance ] +! [ sideways-heading ] +! [ [ location>> ] bi@ [ v+ ] dip distance ] tri < ; + +! : distance-to-collision ( oint segment -- distance ) +! ! TODO: this isn't right. If oint is facing away from the wall then it should return a much bigger distance... +! #! distance on the oint's heading to the segment wall +! facing-nearest-wall? [ +! [ sideways-heading norm ] +! [ distance-from-wall ] 2bi swap / +! ] [ +! ] if ; + +:: (collision-coefficient) ( -2b sqrt(b^2-2ac) 2a -- c ) + -2b sqrt(b^2-2ac) + 2a / + -2b sqrt(b^2-2ac) - 2a / max ; ! the -ve answer is behind us (I think..) + +:: collision-coefficient ( v w -- c ) + [let* | a [ v dup v. ] + b [ v w v. 2 * ] + c [ w dup v. v dup v. - ] | + b -2 * b sq a c * 2 * - sqrt a 2 * (collision-coefficient) ] ; + +: distance-to-collision ( oint segment -- distance ) + [ sideways-heading ] [ [ location>> ] bi@ v- collision-coefficient ] + [ drop forward>> n*v norm ] 2tri ; + +:: (wall-normal) ( seg loc -- n ) + [let* | back [ loc seg location>> v- ] + back-proj [ back seg forward>> proj ] + perp-point [ loc back-proj v- ] | + perp-point seg location>> v- normalize ] ; + +: wall-normal ( segment oint -- n ) + location>> (wall-normal) ; + +: bounce-forward ( segment oint -- ) + [ wall-normal ] [ swap reflect ] [ (>>forward) ] tri ; + +: bounce-up ( oint segment -- ) + 2drop ; ! TODO + +: bounce-left ( oint segment -- ) + 2drop ; ! TODO + +! : bounce ( oint segment -- ) +! [ swap bounce-forward ] +! [ bounce-up ] +! [ bounce-left ] 2tri ; + +: bounce ( oint segment -- ) + drop 0.01 left-pivot ; ! just temporary From 805f025cc5802fc7115309493aa44cd39ee04382 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Wed, 7 May 2008 16:15:14 +1000 Subject: [PATCH 3/8] jamshred: some very wrong bounce code... --- extra/jamshred/game/game.factor | 12 +++++++--- extra/jamshred/jamshred.factor | 23 +++++++++++-------- extra/jamshred/oint/oint-tests.factor | 4 ++++ extra/jamshred/oint/oint.factor | 8 ++----- extra/jamshred/player/player.factor | 23 +++++++++++-------- extra/jamshred/tunnel/tunnel.factor | 33 +++++++++++++++------------ 6 files changed, 61 insertions(+), 42 deletions(-) create mode 100644 extra/jamshred/oint/oint-tests.factor diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index 2a5fefcaed..e187d26a17 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -3,10 +3,10 @@ USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.tunnel math.vectors ; IN: jamshred.game -TUPLE: jamshred tunnel players running ; +TUPLE: jamshred tunnel players running quit ; : ( -- jamshred ) - "Player 1" 2dup swap play-in-tunnel 1array f + "Player 1" 2dup swap play-in-tunnel 1array f f jamshred boa ; : jamshred-player ( jamshred -- player ) @@ -19,7 +19,13 @@ TUPLE: jamshred tunnel players running ; ] [ drop ] if ; : toggle-running ( jamshred -- ) - [ running>> not ] [ (>>running) ] bi ; + dup running>> [ + f >>running drop + ] [ + [ jamshred-player moved ] + [ t >>running drop ] bi + ] if ; : mouse-moved ( x-radians y-radians jamshred -- ) jamshred-player -rot turn-player ; + diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 3a7047929f..bdec1e57e5 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.log kernel math math.constants namespaces sequences ui ui.gadgets ui.gestures ui.render math.vectors ; +USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.log kernel math math.constants namespaces sequences threads ui ui.gadgets ui.gestures ui.render math.vectors ; IN: jamshred TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; @@ -8,8 +8,8 @@ TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; : ( jamshred -- gadget ) jamshred-gadget construct-gadget swap >>jamshred ; -: default-width ( -- x ) 1024 ; -: default-height ( -- y ) 768 ; +: default-width ( -- x ) 640 ; +: default-height ( -- y ) 480 ; M: jamshred-gadget pref-dim* drop default-width default-height 2array ; @@ -17,16 +17,19 @@ M: jamshred-gadget pref-dim* M: jamshred-gadget draw-gadget* ( gadget -- ) [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ; -: tick ( gadget -- ) - [ jamshred>> jamshred-update ] [ relayout-1 ] bi ; +: jamshred-loop ( gadget -- ) + dup jamshred>> quit>> [ + drop + ] [ + dup [ jamshred>> jamshred-update ] + [ relayout-1 ] bi + 50 sleep jamshred-loop + ] if ; M: jamshred-gadget graft* ( gadget -- ) - [ - [ tick ] curry 10 milliseconds from-now 10 milliseconds add-alarm - ] keep (>>alarm) ; - + [ jamshred-loop ] in-thread drop ; M: jamshred-gadget ungraft* ( gadget -- ) - [ alarm>> cancel-alarm ] [ f >>alarm drop ] bi ; + jamshred>> t >>quit drop ; : jamshred-restart ( jamshred-gadget -- ) >>jamshred drop ; diff --git a/extra/jamshred/oint/oint-tests.factor b/extra/jamshred/oint/oint-tests.factor new file mode 100644 index 0000000000..cf9f22261a --- /dev/null +++ b/extra/jamshred/oint/oint-tests.factor @@ -0,0 +1,4 @@ +USING: jamshred.oint tools.test ; +IN: jamshred.oint-tests + +[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index 6b4f22bb9e..9f4eada11e 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -55,10 +55,6 @@ TUPLE: oint location forward up left ; : proj-perp ( v u -- w ) dupd proj v- ; -! :: reflect ( v l -- v' ) -! #! reflect v on l -! v l v. l l v. / 2 * l n*v v v- ; - -:: reflect ( vec n -- v' ) +:: reflect ( v n -- v' ) #! bounce v on a surface with normal n - vec n v. n n*v -2 * vec v+ ; + v v n v. n n v. / 2 * n n*v v- ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 6feca27366..4aba302a75 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order sequences ; +USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order sequences system ; IN: jamshred.player -TUPLE: player < oint name tunnel nearest-segment ; +TUPLE: player < oint name tunnel nearest-segment last-move ; : ( name -- player ) - [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip f f player boa ; + [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip f f f player boa ; : turn-player ( player x-radians y-radians -- ) >r over r> left-pivot up-pivot ; @@ -22,19 +22,23 @@ TUPLE: player < oint name tunnel nearest-segment ; [ tunnel>> ] [ dup nearest-segment>> nearest-segment ] [ (>>nearest-segment) ] tri ; -: max-speed ( -- speed ) - 0.01 ; +: moved ( player -- ) millis swap (>>last-move) ; +: max-speed ( -- speed ) 1.0 ; ! units/second : player-speed ( player -- speed ) drop max-speed ; ! dup nearest-segment>> fraction-from-wall sq max-speed * ; -! : move-player ( player -- ) -! dup player-speed over go-forward update-nearest-segment ; +: distance-to-move ( player -- distance ) + [ player-speed ] [ last-move>> millis dup >r swap - 1000 / * r> ] + [ (>>last-move) ] tri ; + DEFER: (move-player) +USE: morse : ?bounce ( distance-remaining player -- ) over 0 > [ + "e" play-as-morse [ dup nearest-segment>> bounce ] ! [ (move-player) ] ! uncomment when bounce works... [ 2drop ] @@ -52,12 +56,13 @@ USE: io.streams.string over 0 <= [ 2drop ] [ - dup dup nearest-segment>> distance-to-collision ! [ .s ] with-string-writer jamshred-log + dup dup nearest-segment>> distance-to-collision + [ dup . ] with-string-writer jamshred-log move-player-distance ?bounce ] if ; : move-player ( player -- ) - [ player-speed ] [ (move-player) ] [ update-nearest-segment ] tri ; + [ distance-to-move ] [ (move-player) ] [ update-nearest-segment ] tri ; : update-player ( player -- ) dup move-player nearest-segment>> diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 7c6740f139..3ac864a7f7 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -126,15 +126,23 @@ C: segment ! ] [ ! ] if ; +USING: jamshred.log prettyprint io.streams.string ; + +: distant 10 ; inline + :: (collision-coefficient) ( -2b sqrt(b^2-2ac) 2a -- c ) - -2b sqrt(b^2-2ac) + 2a / - -2b sqrt(b^2-2ac) - 2a / max ; ! the -ve answer is behind us (I think..) + sqrt(b^2-2ac) complex? [ + distant + ] [ + -2b sqrt(b^2-2ac) + 2a / + -2b sqrt(b^2-2ac) - 2a / max ! the -ve answer is behind us + ] if ; :: collision-coefficient ( v w -- c ) [let* | a [ v dup v. ] b [ v w v. 2 * ] c [ w dup v. v dup v. - ] | - b -2 * b sq a c * 2 * - sqrt a 2 * (collision-coefficient) ] ; + b neg b sq a c * 4 * - sqrt a 2 * (collision-coefficient) ] ; : distance-to-collision ( oint segment -- distance ) [ sideways-heading ] [ [ location>> ] bi@ v- collision-coefficient ] @@ -150,18 +158,15 @@ C: segment location>> (wall-normal) ; : bounce-forward ( segment oint -- ) - [ wall-normal ] [ swap reflect ] [ (>>forward) ] tri ; + [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ; -: bounce-up ( oint segment -- ) - 2drop ; ! TODO +: bounce-left ( segment oint -- ) + [ forward>> vneg ] dip [ left>> swap reflect ] [ (>>left) ] bi ; -: bounce-left ( oint segment -- ) - 2drop ; ! TODO - -! : bounce ( oint segment -- ) -! [ swap bounce-forward ] -! [ bounce-up ] -! [ bounce-left ] 2tri ; +: bounce-up ( segment oint -- ) + #! must be done after forward and left! + nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ; : bounce ( oint segment -- ) - drop 0.01 left-pivot ; ! just temporary + swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ; + From d61683ecdbfd34d163d50a78568e698a25f2e12d Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 8 May 2008 01:08:48 +1000 Subject: [PATCH 4/8] jamshred: collision detection half working (half broken) --- extra/jamshred/oint/oint-tests.factor | 4 ++ extra/jamshred/oint/oint.factor | 7 +- extra/jamshred/player/player.factor | 11 +--- extra/jamshred/tunnel/tunnel-tests.factor | 31 ++++++++- extra/jamshred/tunnel/tunnel.factor | 79 ++++++++++------------- 5 files changed, 71 insertions(+), 61 deletions(-) diff --git a/extra/jamshred/oint/oint-tests.factor b/extra/jamshred/oint/oint-tests.factor index cf9f22261a..401935fd01 100644 --- a/extra/jamshred/oint/oint-tests.factor +++ b/extra/jamshred/oint/oint-tests.factor @@ -2,3 +2,7 @@ USING: jamshred.oint tools.test ; IN: jamshred.oint-tests [ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test +[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test +[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test +[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test +[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index 9f4eada11e..e2104b6f41 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -9,6 +9,7 @@ IN: jamshred.oint ! segment's location and orientation are given by an oint. TUPLE: oint location forward up left ; +C: oint : rotation-quaternion ( theta axis -- quaternion ) swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ; @@ -48,13 +49,13 @@ TUPLE: oint location forward up left ; #! the scalar projection of v1 onto v2 tuck v. swap norm / ; +: proj-perp ( u v -- w ) + dupd proj v- ; + : perpendicular-distance ( oint oint -- distance ) tuck distance-vector swap 2dup left>> scalar-projection abs -rot up>> scalar-projection abs + ; -: proj-perp ( v u -- w ) - dupd proj v- ; - :: reflect ( v n -- v' ) #! bounce v on a surface with normal n v v n v. n n v. / 2 * n n*v v- ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 4aba302a75..979ad136d3 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -27,7 +27,6 @@ TUPLE: player < oint name tunnel nearest-segment last-move ; : player-speed ( player -- speed ) drop max-speed ; - ! dup nearest-segment>> fraction-from-wall sq max-speed * ; : distance-to-move ( player -- distance ) [ player-speed ] [ last-move>> millis dup >r swap - 1000 / * r> ] @@ -35,14 +34,9 @@ TUPLE: player < oint name tunnel nearest-segment last-move ; DEFER: (move-player) -USE: morse : ?bounce ( distance-remaining player -- ) over 0 > [ - "e" play-as-morse - [ dup nearest-segment>> bounce ] - ! [ (move-player) ] ! uncomment when bounce works... - [ 2drop ] - bi + [ dup nearest-segment>> bounce ] [ (move-player) ] bi ] [ 2drop ] if ; @@ -50,14 +44,11 @@ USE: morse : move-player-distance ( distance-remaining player distance -- distance-remaining player ) pick min tuck over go-forward [ - ] dip ; -USE: prettyprint -USE: io.streams.string : (move-player) ( distance-remaining player -- ) over 0 <= [ 2drop ] [ dup dup nearest-segment>> distance-to-collision - [ dup . ] with-string-writer jamshred-log move-player-distance ?bounce ] if ; diff --git a/extra/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor index 8031678896..c6755318e6 100644 --- a/extra/jamshred/tunnel/tunnel-tests.factor +++ b/extra/jamshred/tunnel/tunnel-tests.factor @@ -3,8 +3,8 @@ USING: jamshred.oint jamshred.tunnel kernel sequences tools.test ; IN: jamshred.tunnel.tests -[ 0 ] [ T{ segment T{ oint f { 0 0 0 } } 0 } - T{ segment T{ oint f { 1 1 1 } } 1 } +[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 } + T{ segment f { 1 1 1 } f f f 1 } T{ oint f { 0 0 0.25 } } nearer-segment segment-number ] unit-test @@ -15,3 +15,30 @@ IN: jamshred.tunnel.tests [ 3 ] [ T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test [ F{ 0 0 0 } ] [ T{ oint f { 0 0 -0.25 } } over first nearest-segment oint-location ] unit-test + +: test-segment-oint ( -- oint ) + { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } ; + +[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test +[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test +[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test +[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test +[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test +[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test +[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test +[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test + +: simplest-straight-ahead ( -- oint segment ) + { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } + initial-segment ; + +[ { 0 0 0 } ] [ simplest-straight-ahead sideways-heading ] unit-test +[ { 0 0 0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test + +: simple-collision-up ( -- oint segment ) + { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } + initial-segment ; + +[ { 0 1 0 } ] [ simple-collision-up sideways-heading ] unit-test +[ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] unit-test +[ { 0 1 0 } ] [ simple-collision-up collision-vector ] unit-test diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 3ac864a7f7..9b0257d372 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays float-arrays kernel jamshred.oint locals math math.functions math.constants math.matrices math.order math.ranges math.vectors random sequences vectors ; +USING: accessors arrays combinators float-arrays kernel jamshred.oint locals math math.functions math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ; IN: jamshred.tunnel : n-segments ( -- n ) 5000 ; inline @@ -24,7 +24,7 @@ C: segment dup [ / pi 2 * * ] curry map ; : segment-number++ ( segment -- ) - dup segment-number 1+ swap set-segment-number ; + [ number>> 1+ ] keep (>>number) ; : random-color ( -- color ) { 100 100 100 } [ random 100 / >float ] map { 1.0 } append ; @@ -47,8 +47,8 @@ C: segment : default-segment-radius ( -- r ) 1 ; : initial-segment ( -- segment ) - F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } - 0 random-color default-segment-radius ; + F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } + 0 random-color default-segment-radius ; : random-segments ( n -- segments ) initial-segment 1vector swap (random-segments) ; @@ -97,65 +97,52 @@ C: segment [ nearest-segment-forward ] 3keep nearest-segment-backward r> nearer-segment ; -: distance-from-centre ( oint segment -- distance ) - perpendicular-distance ; +: vector-to-centre ( seg loc -- v ) + over location>> swap v- swap forward>> proj-perp ; -: distance-from-wall ( oint segment -- distance ) - tuck distance-from-centre swap segment-radius swap - ; +: distance-from-centre ( seg loc -- distance ) + vector-to-centre norm ; -: fraction-from-centre ( oint segment -- fraction ) - tuck distance-from-centre swap segment-radius / ; +: wall-normal ( seg oint -- n ) + location>> vector-to-centre normalize ; -: fraction-from-wall ( oint segment -- fraction ) +: from ( seg loc -- radius d-f-c ) + dupd location>> distance-from-centre [ radius>> ] dip ; + +: distance-from-wall ( seg loc -- distance ) from - ; +: fraction-from-centre ( seg loc -- fraction ) from / ; +: fraction-from-wall ( seg loc -- fraction ) fraction-from-centre 1 swap - ; -: sideways-heading ( oint segment -- v ) - [ forward>> ] bi@ proj-perp ; - -! : facing-nearest-wall? ( oint segment -- ? ) -! [ [ location>> ] bi@ distance ] -! [ sideways-heading ] -! [ [ location>> ] bi@ [ v+ ] dip distance ] tri < ; - -! : distance-to-collision ( oint segment -- distance ) -! ! TODO: this isn't right. If oint is facing away from the wall then it should return a much bigger distance... -! #! distance on the oint's heading to the segment wall -! facing-nearest-wall? [ -! [ sideways-heading norm ] -! [ distance-from-wall ] 2bi swap / -! ] [ -! ] if ; - -USING: jamshred.log prettyprint io.streams.string ; - : distant 10 ; inline -:: (collision-coefficient) ( -2b sqrt(b^2-2ac) 2a -- c ) - sqrt(b^2-2ac) complex? [ +:: (collision-coefficient) ( -b sqrt(b^2-4ac) 2a -- c ) + sqrt(b^2-4ac) complex? [ distant ] [ - -2b sqrt(b^2-2ac) + 2a / - -2b sqrt(b^2-2ac) - 2a / max ! the -ve answer is behind us + -b sqrt(b^2-4ac) + 2a / + -b sqrt(b^2-4ac) - 2a / max ! the -ve answer is behind us ] if ; :: collision-coefficient ( v w -- c ) [let* | a [ v dup v. ] b [ v w v. 2 * ] c [ w dup v. v dup v. - ] | - b neg b sq a c * 4 * - sqrt a 2 * (collision-coefficient) ] ; + c b a quadratic [ real-part ] bi@ max ] ; +: sideways-heading ( oint segment -- v ) + [ forward>> ] bi@ proj-perp ; + +: sideways-relative-location ( oint segment -- loc ) + [ [ location>> ] bi@ v- ] keep forward>> proj-perp ; + +: collision-vector ( oint segment -- v ) + dupd [ sideways-heading ] [ sideways-relative-location ] 2bi + collision-coefficient swap forward>> n*v ; + +USING: prettyprint jamshred.log io.streams.string ; : distance-to-collision ( oint segment -- distance ) - [ sideways-heading ] [ [ location>> ] bi@ v- collision-coefficient ] - [ drop forward>> n*v norm ] 2tri ; - -:: (wall-normal) ( seg loc -- n ) - [let* | back [ loc seg location>> v- ] - back-proj [ back seg forward>> proj ] - perp-point [ loc back-proj v- ] | - perp-point seg location>> v- normalize ] ; - -: wall-normal ( segment oint -- n ) - location>> (wall-normal) ; + collision-vector norm [ dup . ] with-string-writer jamshred-log ; : bounce-forward ( segment oint -- ) [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ; From ea2107e4637a9037aab3a02b307c378725dfdfc6 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 8 May 2008 12:17:05 +1000 Subject: [PATCH 5/8] jamshred: collision detection better, bounce still buggy --- extra/jamshred/tunnel/tunnel.factor | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 9b0257d372..4369944e9e 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -114,21 +114,11 @@ C: segment : fraction-from-wall ( seg loc -- fraction ) fraction-from-centre 1 swap - ; -: distant 10 ; inline - -:: (collision-coefficient) ( -b sqrt(b^2-4ac) 2a -- c ) - sqrt(b^2-4ac) complex? [ - distant - ] [ - -b sqrt(b^2-4ac) + 2a / - -b sqrt(b^2-4ac) - 2a / max ! the -ve answer is behind us - ] if ; - -:: collision-coefficient ( v w -- c ) +:: collision-coefficient ( v w r -- c ) [let* | a [ v dup v. ] b [ v w v. 2 * ] - c [ w dup v. v dup v. - ] | - c b a quadratic [ real-part ] bi@ max ] ; + c [ w dup v. r sq - ] | + c b a quadratic max ] ; : sideways-heading ( oint segment -- v ) [ forward>> ] bi@ proj-perp ; @@ -137,12 +127,11 @@ C: segment [ [ location>> ] bi@ v- ] keep forward>> proj-perp ; : collision-vector ( oint segment -- v ) - dupd [ sideways-heading ] [ sideways-relative-location ] 2bi - collision-coefficient swap forward>> n*v ; + [ sideways-heading ] [ sideways-relative-location ] [ radius>> ] 2tri + swap [ collision-coefficient ] dip forward>> n*v ; -USING: prettyprint jamshred.log io.streams.string ; : distance-to-collision ( oint segment -- distance ) - collision-vector norm [ dup . ] with-string-writer jamshred-log ; + collision-vector norm ; : bounce-forward ( segment oint -- ) [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ; From 052962d3b8dd9d5ea37bf515965f56c03421688e Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 8 May 2008 13:04:44 +1000 Subject: [PATCH 6/8] jamshred is playable! (scroll to acc/decelerate) --- extra/jamshred/jamshred.factor | 13 +++++++++---- extra/jamshred/player/player.factor | 21 ++++++++++++++------- extra/jamshred/tunnel/tunnel.factor | 4 +++- 3 files changed, 26 insertions(+), 12 deletions(-) diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index bdec1e57e5..44dcdc8659 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.log kernel math math.constants namespaces sequences threads ui ui.gadgets ui.gestures ui.render math.vectors ; +USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants namespaces sequences threads ui ui.gadgets ui.gestures ui.render math.vectors ; IN: jamshred TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; @@ -8,8 +8,8 @@ TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; : ( jamshred -- gadget ) jamshred-gadget construct-gadget swap >>jamshred ; -: default-width ( -- x ) 640 ; -: default-height ( -- y ) 480 ; +: default-width ( -- x ) 800 ; +: default-height ( -- y ) 600 ; M: jamshred-gadget pref-dim* drop default-width default-height 2array ; @@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) ] [ dup [ jamshred>> jamshred-update ] [ relayout-1 ] bi - 50 sleep jamshred-loop + 10 sleep jamshred-loop ] if ; M: jamshred-gadget graft* ( gadget -- ) @@ -57,10 +57,15 @@ M: jamshred-gadget ungraft* ( gadget -- ) ] [ 2drop ] if* ] 2keep >>last-hand-loc drop ; +: handle-mouse-scroll ( jamshred-gadget -- ) + jamshred>> jamshred-player scroll-direction get + second neg swap change-player-speed ; + jamshred-gadget H{ { T{ key-down f f "r" } [ jamshred-restart ] } { T{ key-down f f " " } [ jamshred>> toggle-running ] } { T{ motion } [ handle-mouse-motion ] } + { T{ mouse-scroll } [ handle-mouse-scroll ] } } set-gestures : jamshred-window ( -- ) diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 979ad136d3..1ff73d51e4 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,12 +1,17 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order sequences system ; +USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order math.ranges sequences system ; IN: jamshred.player -TUPLE: player < oint name tunnel nearest-segment last-move ; +TUPLE: player < oint name tunnel nearest-segment last-move speed ; + +! speeds are in GL units / second +: default-speed ( -- speed ) 1.0 ; +: max-speed ( -- speed ) 10.0 ; : ( name -- player ) - [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip f f f player boa ; + [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip + f f f default-speed player boa ; : turn-player ( player x-radians y-radians -- ) >r over r> left-pivot up-pivot ; @@ -23,13 +28,15 @@ TUPLE: player < oint name tunnel nearest-segment last-move ; [ (>>nearest-segment) ] tri ; : moved ( player -- ) millis swap (>>last-move) ; -: max-speed ( -- speed ) 1.0 ; ! units/second -: player-speed ( player -- speed ) - drop max-speed ; +: speed-range ( -- range ) + max-speed [0,b] ; + +: change-player-speed ( inc player -- ) + [ + speed-range clamp-to-range ] change-speed drop ; : distance-to-move ( player -- distance ) - [ player-speed ] [ last-move>> millis dup >r swap - 1000 / * r> ] + [ speed>> ] [ last-move>> millis dup >r swap - 1000 / * r> ] [ (>>last-move) ] tri ; DEFER: (move-player) diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 4369944e9e..139cdbfb53 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -137,7 +137,9 @@ C: segment [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ; : bounce-left ( segment oint -- ) - [ forward>> vneg ] dip [ left>> swap reflect ] [ (>>left) ] bi ; + #! must be done after forward + [ forward>> vneg ] dip [ left>> swap reflect ] + [ forward>> proj-perp normalize ] [ (>>left) ] tri ; : bounce-up ( segment oint -- ) #! must be done after forward and left! From 28d7fc37b87e57d5c7314a2fd2f9af8326fed8c0 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 8 May 2008 17:41:49 +1000 Subject: [PATCH 7/8] jamshred: attempts at deployment, bangs on hitting the wall --- extra/jamshred/deploy.factor | 12 ++++++++++++ extra/jamshred/game/game.factor | 8 ++++---- extra/jamshred/jamshred.factor | 19 +++++++++++++++++-- extra/jamshred/player/player.factor | 13 +++++++------ extra/jamshred/sound/bang.wav | Bin 0 -> 20460 bytes extra/jamshred/sound/sound.factor | 13 +++++++++++++ 6 files changed, 53 insertions(+), 12 deletions(-) create mode 100644 extra/jamshred/deploy.factor create mode 100644 extra/jamshred/sound/bang.wav create mode 100644 extra/jamshred/sound/sound.factor diff --git a/extra/jamshred/deploy.factor b/extra/jamshred/deploy.factor new file mode 100644 index 0000000000..9a18cf1f9b --- /dev/null +++ b/extra/jamshred/deploy.factor @@ -0,0 +1,12 @@ +USING: tools.deploy.config ; +V{ + { deploy-ui? t } + { deploy-io 1 } + { deploy-reflection 1 } + { deploy-compiler? t } + { deploy-math? t } + { deploy-word-props? f } + { deploy-c-types? f } + { "stop-after-last-window?" t } + { deploy-name "Jamshred" } +} diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index e187d26a17..dcb82d1de0 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -1,13 +1,13 @@ ! 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.tunnel math.vectors ; +USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math.vectors ; IN: jamshred.game -TUPLE: jamshred tunnel players running quit ; +TUPLE: jamshred sounds tunnel players running quit ; : ( -- jamshred ) - "Player 1" 2dup swap play-in-tunnel 1array f f - jamshred boa ; + "Player 1" pick + 2dup swap play-in-tunnel 1array f f jamshred boa ; : jamshred-player ( jamshred -- player ) ! TODO: support more than one player diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 44dcdc8659..6b305696e5 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants namespaces sequences threads ui ui.gadgets ui.gestures ui.render math.vectors ; +USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render math.vectors ; IN: jamshred TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; @@ -26,10 +26,20 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) 10 sleep jamshred-loop ] if ; +: fullscreen ( gadget -- ) + find-world t swap set-fullscreen* ; + +: no-fullscreen ( gadget -- ) + find-world f swap set-fullscreen* ; + +: toggle-fullscreen ( world -- ) + [ fullscreen? not ] keep set-fullscreen* ; + M: jamshred-gadget graft* ( gadget -- ) [ jamshred-loop ] in-thread drop ; + M: jamshred-gadget ungraft* ( gadget -- ) - jamshred>> t >>quit drop ; + jamshred>> t swap (>>quit) ; : jamshred-restart ( jamshred-gadget -- ) >>jamshred drop ; @@ -61,9 +71,14 @@ M: jamshred-gadget ungraft* ( gadget -- ) jamshred>> jamshred-player scroll-direction get second neg swap change-player-speed ; +: quit ( gadget -- ) + [ no-fullscreen ] [ close-window ] bi ; + 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 "q" } [ quit ] } { T{ motion } [ handle-mouse-motion ] } { T{ mouse-scroll } [ handle-mouse-scroll ] } } set-gestures diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 1ff73d51e4..bea4ab4836 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors jamshred.log jamshred.oint jamshred.tunnel kernel math math.constants math.order math.ranges sequences system ; +USING: accessors colors 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 tunnel nearest-segment last-move speed ; +TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; ! speeds are in GL units / second : default-speed ( -- speed ) 1.0 ; -: max-speed ( -- speed ) 10.0 ; +: max-speed ( -- speed ) 30.0 ; -: ( name -- player ) - [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] dip +: ( 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 ; : turn-player ( player x-radians y-radians -- ) @@ -43,7 +43,8 @@ DEFER: (move-player) : ?bounce ( distance-remaining player -- ) over 0 > [ - [ dup nearest-segment>> bounce ] [ (move-player) ] bi + [ dup nearest-segment>> bounce ] [ sounds>> bang ] + [ (move-player) ] tri ] [ 2drop ] if ; diff --git a/extra/jamshred/sound/bang.wav b/extra/jamshred/sound/bang.wav new file mode 100644 index 0000000000000000000000000000000000000000..b15af141eca5d69222fe90ae594afe407ae971a5 GIT binary patch literal 20460 zcmXB64J>r~z9zW7*Q!$Lt=DUNYuB+I$8qawS8MHRaYY*~#<i(Yz;_v@m?f=;Nzx5>B2!bH-NU0@=k`02O2piGzAA0`75%#$- zN{NtBLs+rRL2$$&5l2)IEkr7|WD@s=&v-B{jU^(3s3hi%RbvMK7ZYxygeW6)qn^ko z=7?KjljtQjh&5uB$RiqvK|&`Mi8CS_`;-zVII?UU8B@lEv1{xbE<7iVL8ISjH~I_* zv0|hVeK_)>VK!2Yd*f2yFdlK9(Qo@P#=KEx6d4`ZQfq7&bH=nWV4N6xxQ<~Q^&HO& zqs8zWl}1R9C%O#I$TU>F*9hwM21VTA8+L;sE{!9-$Vep2#0~ztB^Z3Ni2qbWH=d0{ zT-k{cz`0g%?jHQ@F_w%q!(nV1IYz0mW4MhPoN30e7y|B%Alh-4b4EOIYuGUY?{`v< z`?VA4L@Tyu5F^C0F-SZa2}A->fU`x6aol48k&DsK$Myh@)<9fgd`EERkTHv^SixNc zjVz;*NFgj3xgH{iD8Y!@Fhh3i8^UL+*pDJoamRTCg=@UWCvM}$h$9A#1|tc_PR6&V zhyna9BHhFiQHPmXC6aIreK?aJJNF;gv3f_MlnV=-|*{;7|kBs)eVjo!brB`nx=5>pplFt9^h)?iGCsu_b^5* z5FB|<6p%KmfLteB#3O929_Jq<9taD$3+tOFycmfFVge(%Pc#$fMlCT7TlN}tMzzsT zG!Z4nG2tXcV+ThK84=@wu#ps*j_)+X;_q;*L?VPe4u~53pGq9UGu#-l8T{8p%;J1K z*c!oc&oDcMF;gz%m2&u|Jv1(+R$AU_iz3G>iXX#e$Eihw|oC@)&DU(K@9!>kM(iKh(0p)zi*EX zjGrx>&rU7$|EG%8-T!#7M*OF}jg-xX|Fdzc^8ZTR7Poi)@2(x^f4=_DL%Ui3<>tS1 z?%DtA?tjhOKicp9e+mx@4txG!eLOw(9Tgrph`7J${I@m#gRgA9o%x50!JAtBAM}67 z{MUyy`ahhNJ!_fXIcLJ}^xt>?i>ZIyc8)Z6#JQ<~UsF}$zq$WO|A(%ByerR=l74dh z{=hi;NA;WWjBer?~=a^G@)esBNhwtwFJ=g>cwJd8e^KiK|M^{2T%J^sn=YH%&N zo?J)k4{cXUm;b zsT3N!`mO0auG@0|Vff>sxrbVaCL3PWtF;l<@0Qt#*pAp+o--PleDl(Wsh9=x(1-h^ z%I`}}J7)8DdVPr2w_ov)HCI8cvd+_I4Pu-V?P)cMwni{@+jgxJ` z!N5dt%i+vW4oj~(vmuW6B@7q2)K zdQvij=SGg=R?~$$y;@(5Nn%U1ZL%%Y@MY=Erg+%OxJQR2`6ziIx&HUW@4L-~rj(d# zv+%K6STF`yv+fZybw7KA5#B#?K*Ic{nX~#^K86Kyr%l^1C7yC zy+Q9Xc9mm8Cpb#}lKkb-HTf{+PJb@*4@i^B)Yk)dUT{upcnwIsoT}{6?znrQmB}JP z(F?jSW+MJsaDKWmSH}36h+G=V3FZ0j{S6-9KX?2&@MYzfJMXD?;MYg*`GfmsF*x|T z8g3@m^lQ}_jVKo1sZztbxE@P9*UlGli{z4WWND92O(^|7JH9ueDpvo#QRbKN`(@_WqHswxJ?srHz3qk4f^FebZB98;mb5W{Rb(`B`!!CQH_XZ+Bb%IR zYII&Z(QkQMO!bEm+fLj}?AoX54|!~qe zYjICPk;QLMviWSc34_ULiO0WjBv(5cVrKM1Df?|Ha2Z~Uo~uE!Tuvd&qMTZzj;fpF zhBi$033=wSn1YXv__@zdKU{pSh#UTJM(@+lLixu$TcIuGw_S0RWih5McK*X*{O#x7 z-#sM?@pZN$x6yeyJ6i8c z{i*hT`+oK^^S=lG(DzW`8ho1jx##ESKVJQ5=||@uY_2s=%`Z#-fl%7h^82I;#~0LwIejF4=RUbHoc+NQ!`vLxoX(86y}T@)(iDgdWs1e9sDg{i=&9V z$kZ5Jbe=pwmzn1nm0RHM7>+J84RX^=H<8A6MyptlUdXJAjjvR+ELg9u64~6ju>Rf6 z$Bvj3HlXgvJ^G_5ThN6Q;egqquZ?|W#;8~OBdgk=u+3$gu9#DLQqEJaxl>}Bx-)9D za=L_hWS?SsO%9<`7^e@6F@2huqb}ITnBABmQ^4G3tzf6ROXH_2 z$La5HQr&-%YhRA5{ZJd5W44;hOtT-x6Q>g!Kh=ER|Gx9Hm>Bm%hke13@I$6u{!Q-h zcAPhVCI5B*UluzLlIK20Vh5NwCJ^I|7vr$3m|Jtb zw#uEx7IIEgJRdM02^ZGh58M2hdCxZXx%4le|K-?UdYxB)nVnSsgD3epnfMoLf5l~; zIfK6y?WaGaB-j4My3?Cd=%`A_j&sF7f4B3o-) z50!;i1EUdlF!z_EUzh!v{)u02yt6;$JeEE>e{BBo^rw!;ygya_;q(voyV;*=0%PIl zS4(guyeE47y}|gD@o7ala_4C@-b6@^1n}ItY6^IKQz1(=Ke_eK`e5w5P{CV%i5y|$;&)p$=usGoG z&p%&$34ZB%8u@dAtMSjmPsdN|?zE@uKb8Es`*Hi}(x3X8^<~yG>OFAR{B-T*eD`0s z-zvm?H7J&Ty?(8G&G7F0I`4mcS$i#bOZZY5nttsHI70_t?|xqL_WttZ9}gACjH;5B zj{~1(tXmcrGs>oD=BV&C`EupW@>#z$2CgD!N}SrK&&W2VQ$J&y*$dLIJZW~#7xqN$ z%D(21lZ;knE&43wtCtaX`2I}})IQIA$%tCR<>5BX$7XAH+Ku8+S|c0Mww$P3$nDAy zGhx)KdsHFK5gnlG7X4JU>t)OtwFyphMm7kSv9p%U?}~ot_^!zov~1H$MweWst|`^v zKzT+)UoqCzIO04s5K58F+K}-~) zC2rfAhFn}qEl}n3jma6eZC^2MjeO_)&Gz?wKg^|`{>zMv@l?z2j(>1EsvMX0%Wk~K zR9ihJ!E_Ykj@jjw_-S(o*Cn(HLQIimH}>g+Ze5RQv~1F4l+~1G8UN5`J>|0aMpK5c zXPGwTn+blx5^vdyRgtmFOqG@k>jFP#-ZU=?S4OIqqXqSK;+#6xvgKa2QL}?{_KN=3 z8Go5?>N)T_?RS6K4HZV6f!?pjuW7-jx58kVSf@P`ZRWC%+vW_$EHLJp59J?6;x9kU zeelIu?7knCe^~#)gJ^ES81Op~ipqY)%M{Ao?T@LsuME4???#6b$v>*)bhKgxtMIuOEpku z=@}G^b)UuJvxU+t^_$_y*IO#rmPe>?4vyv*?LVgxB9HB1hqAsZo4* z8-Kfa+j<%MlJd17u<_;(ZA&TPO0hC}|8^q9!#|4k3%Y<9P#?rZNmY;J(Qt!29xnB- zyq1N^-v-0Nn=i5!=@fUh6LCqNF>#R#SkLiw?jGeG-TPHu<^I0EOJ|$Yx zOhLiP_47?!BKgd3@SRKoTTa%=&(cmfC%6&%+Iq1;JDY9exSoZiAtab|s7Y?v|hWeqMP@a3}xT z?|%N#>~(&*^koDF!n@&)x96bw<;?%^a`}AqJo#((m%Ko2U^kfccKVtXdJgUe(_hnG zpWbqU^?~x&$(L&1R$wJE5`KK03#5eXZ{FA0x2@2F+@==FeX5m8Ags(jUCOqD0hCBR z(N4Kmnbm5EBV%7X*HV-`t$|hrGpuu)X@d&o;DYp_>C`mMRO@?MadaX&FPS43k#!@U z+9EF1W@$Av^2S6DLS>5PrAPA;UgDS!m`koE34(5vLqIIH8 zebQ}&E$Vt3h-600p@E<~*z_8D-HUEX#cHBH4HapYZYB1OWOjxuR34;;Xu+!-DUlZ< zBQF`h9RHm9%fxflTkqRWq*5Dze&@tY$iddPvB2tUY9PbE6P$Q0^soCay}D=N=fa=b z-4=K8&)hF#o;LTv&!fJhm!q#9KNCpt)dhrCA{Y=)aA$2%;%z7F5@*7bZ?4EO*g{cA zj%KRsYP-5EFDmE80%tKhVs~w07AmGPb{?T7jnLH@-AVPRoB9Pgr=IEAR14W?TxlM8 zPVI=UNZ0y}m>kWKtia;s;q*v-)EzDqXQVZ8GjtZ7kxO7F<$4y~#}twIdMmJ=!+2J! zJ(GiBT+UyNwC$ZwgfF+p=2m(6fTh1)Su>~KTu?Mj^)?6zWt6F^4Y}@2_SN1;p*r$Elg>XnasY|ZF z)NQG@WLbtR^RW-+5iW;c;5Rr6yTV2(>81n0!)L}c z#+=#uV#iF`yo++^jJ6^*MVM%rTt}Rery6CXlDn!`^&3tiQSVn)#8G)q3#lb~r+%w< z>FK&h-BvrKbTt6`oKXwaR`DiO8Y&Sd;#l>*eUJF_IoB ziK@z#oGh2iPSGyU>n&s(bIb4W$LtWR6CLEJDS>-p^_XYYMITaW#-es8Hi}bnn^dG_ zsJnWb5)AJ}=0YiN@ox{W7k=W)?XT@GRe}4r_P6Yy`7Jm66l#0f{5s(4eIEWI_*-7Z zmka+c@ZjJVU!YNJP-iqNc|fI7GU=yIgd5YGX(%SgvSQj5Mq>ueDsL5JrkXyW)}d6F zlTK13+~gFOXg-ClyG#e>km=5Jz}a~VGs{d1{pJf{nAtJzj1%Hi8&>PpF{w$uGWy9J zZPZvIJE;pMo%adX$mIvN;<%iT!I%!PlRkdkGH^N;>*4YDYpKfMl zcACkeUF1Cx)Z2|?IZsZKIpmExbwj^_Puq=3ZArb=n)DWRP0yqWev(^ZUlL9%x zotKT5i@?C!cBE68)H4i^@x*vcd9hR0qEB<*B_>pTUQ3wx)bp_!camc*j2#r*=2S~n zOrm)vCRcd(`4HXAYy&&oQnQ3p$rqcX2FWeWBjPQoqT*9~)g9fd9cr?+pzkP)`W<1@ zH?=L&L8^qEDxxghAbSNbiV%Z(zqV!E>LsYWTxs*799;-qMRFnoQolN+-vj$47(O{u zy-;(NEwM3di&Ve0hwG$+=vKrLafWt+hi`h+qRmnX^sQ+!CfRatO5hK9mr%f!upC(< z`6Y`~6gdf%gw!{C_&QYac8%CXQkLEFxvGAbx+SU`qgQ9O&wPvl1r*q zij`a`2iWOIE>uUfbkaeu6IoOiT|%rGllqlPNsFQ?Ii=@lk8~muG8JtNtp!Jeu3$p2 z=*<%Kh`QJYFIbX;6gYLph`LTyl?0fLou>#0x|pCgaq(qQXr#oKPME;tq%7B}U3okJAA zBeRK4qexv=eA*~EOU2XIR3TMPT~JeGt(Kr*mep3}P}3zs62wJuE1WA+`i(wS=xU`JDFlO!0t1LY(6{4 zIB0og6S?J@PSQx-Sh1-93~%uV<%w?Ri(Ctt(#5=Z(eGA3md z>DNlS>QtsBkCI6w>#alz(?gdrrOXUBV>&T+#Abask6E=m#*A_e%mQ1^w+i)ql90qN z30K0EdC@$_X9)#-1JuVh`jOb8Lv%6b%0>H)Mx#Q#RN8bAwXY82m|Ri^#7k*6(i63d z<%rKrv`FlVdgUj5NDt||hEo|*7v*`y3;t_U8{{=*Q7Mnqho9v^?N+l86NE#3h;D{! zLwmu_z=LnwH}bOmYI)lX1pOZWq2KJ^`nurH4&=Oaybv$hugih+*Sv6AWHl^CkHW<` zXP-Q1oY3R+E!9e*mPr;7J^Gz)1|CdSl5|d47e}Nz$u1?S9Ym1KM6L)@gH(WOr*qf~ zwwT-Hy}Z>_z@wgG$}>f{HDN}m;aj*IW`nM$os5NV5xRvEp^#7H8o_TW*(PqCt6)}{ zEcTk}qqgW|wp{RYd!|)XBO1+_<_?R?EPn`^>&y;IoVCQfEv%TB7_dXGmK&uW_yKc) zdDrAL7h4>$d9fDjh$VzdS>>%&^Twj~GE zWPO(CBr}L1x{GF*09VKLFpDh1R{>uYaYIaio}!M76SYXm*T#%C^+J>NMr~O>QifGQ z-y>U@Yt9el)h^hDK7p{Lo5%Q8Hb`5^ZmNgsCNHQhCZFZ_0`sV_02^#X&9g8j5_|t4 z#X23k_Tf2Z$ee51GwZ?@PB~ghu)&cDGoU>kM&dO^b*--%)%#2 z$qKRv_5EXA)J}j*E{p(4uobk64$@Wh0pk-qCcEI}##lE;3FoFVOQYo(%6~uG%#CyF z>@}Of7jsr-hj!EVghyLcFQlF5hIlVGDkG{}X;5r(g?uYt%LQ_k`~=Q+NF1X_q1ISZ zHxW+@5&cJi9&U*Nazig8z0@e143s-3$U-fD$ChGl&P=4xEbz&%B3f$ zQ`C$Z^4@sTFO6sIQV(ctT1Yw7dbLLNRH;yKHsuUe_$H$Sv)PCma~G9Ea9TMsP_;Uy z&7ohQ5QwjYJK^nY23O8!a{JttAo3pWncbk@yB2N@ogAhn$u=!lU6ht0ZIL7?L7D~z zm8A+5=5WWr>z+tq92w05c&#KZ9?bBc64!AbWzP#pXI%1eX*M3q#f z3D>!R$Y2g0(m-Qt9}5Q&7Z@ZE`UZkPzKgu5cP$Xz%o z5(v$Q215sLOOb`hIaIvTP+gDut~;N`Je2m4Oy3gXiJxXiYRNN<9l; z?$q=2N5iKlA<8i1dmqgRkx2&8k+F|Hl5Gw7Lwiu~)fIJAyVsYrTy0G+M2AlT?k=C) zCK{;(W|lr8d&ooTgu10ly4Kq!{Jst(hS*NDJ<#joK&Ys0@0R z@{r9`BUwhLG9z>=-OIMIZbXqLHVf}=xe;M0U5E{V-#%Md}2zxAe!GJV{v@L-xVw;03uKi%V_TQCW6c4a98p%a1N{#1YJeP|YUm+4!sPRUFl=r`ta8Nc zS`sZ=mhPBclLajFh!=TP7!sT@(-zKhgHD((b8^hOnL#FO;jXy?evixL?3|swW1pFR zCY=>eN&pbDrPjM9o#?HvLBmoP5ChLVef`%Z@=Y^*y5PoLo$@<4dIML5`e6>+$}9kVOiWyV!i>=E4FrhkfBJX z2p8-G?Eqp?$tJ3ma!@H`B2i!vx=r`%-9#VFv2{!%^vZlPNF zUfGn-q3UixV@g0&dqx(q%C+*6T=cFd$m>$Am@J+}gVC1gp;#eph^x{H;$*e#m0V(> zcpy$lE79FZUF1156Fv&hgs8BJSnUoihmXU{z~Sf712JBj6KztuJR~nG(~3))lS}2v zC>L>s3nH6{@MDq3NF|O!MdPARkqKxBJ7HTm6ec46P+wRKkB72DZDB678_ap#@u&Eg zzFK^DzUQyGe(~$m*Xgg$ukNpHFB^gTz}D;bYwzpw>u$gqPy?tIymr1`2g(AWm+}|K z%ah;huX}lTSqiiVG6F3x-TuLsfj~{5HBkM!7i}9GRx^E%-Y6dJ!0WX?|f|L}<1b zFI$0yx7yIt+d#NCvLBhlb1=Gs+%_y1VrCr5m{O^Y>RZM*`Vy_^$J+#AtE3(D4(un% zn9_65nb{1k(`8r<%1A*!;V3%jat({VuU4yb>WVg_J)k3S5__Z(Wu)IIAV=ta#tK|W zA&%98dDNlWvWO4R5G3L*d8{So8}6*AvTB2glD@r zKWg^ttea_PoV1Aj;qb#>-YnH6?brkYZ+s+m?z|we)1Zat)Dm|Hpx=* znY7TGjG4Jdzur8qqLbdEfi>wwc9C=O&B83dVwyBT9TE~v>82H7UlGJ>4pBuCKo=tW0p3HlLh;hBuyplzy6TA|)) zm7@Imp8Os4Vs=X6;6EL$R~z8(O8dq1EbJTAseFPwSYB>w*Xi)7y*ON!90z){4a#V<3;6-B$N}f*6lS#Py z8lu>+p?h@&-K*(DH5pGek$sd%U7$DMhOTCM7=h_yw!w-9n0vYyBa}erQB%|wl}|O| zm7<67St=8vC+JaT4EqLY57Uc2kZpQ|nxmd68;(@Sw6M?Y6H~>GBB!45S*T}*OeN++ z)J7}#Vp!=s&j|H`pI_p)`38QQWB6p@imPYSgmR&UUF97@H|OKpxn-b{3Pxb>k^knH zD^`U?mm%A`nGxUuGcV(tDnBPY34^9$lWe**1q8p~5nO`Vlpsv-c5amIXZ`FFn~38% z!ArY<5=yxPZiky>ZOk1k+Q+Q1@vNEkGc8OxIyj2xTl$WvXLgucR%Zgt6C*-#N$2~K z4Q-qg9y7|cF$`;G+`wHa%r$*RZWvX@xORo?QfRC}wHza?WB_)%U^MEKKBRR6x5a5* z)q$CN00s=|rBGbz^=o}a-_jF}3%q;QSG9UIRjHH{IsgRuhzCMO25>Zsk_7E2mPCxlT?}?&U>!To#}oH$gpU zM-ID{)}&*pMYiyXk|1hsz;N=-Dn^>6U~p7M}pz0Fcm%v4TTOv4Wa9h4OuiV zToD-y_lEOA7JM>>PoCbYLcO8*@I|OAlpL-M1>Um2ni7%YR>Rkk9C2Peh-OBcP#NXI zS)tjt<=}d-{Vfi<6NRHshwH%ZQ9c?xMHR)#wwL%W$+ink9CNgW{C5C>=^7Dgd|Q zjuezDlvU*RF}XqBmTcfq#pjXPGN>N1r0PH!$l^u+pHBm2#6@5As3;sC^vSq8_+5oz4aZGsA!O88=hT zhL~e~XAF^=;gX@(%k)ixA(amWWerkh&c-$*w0t;C;X(a3M}mrvQ2(?W+#7)n(#1R zAmpJ(tOdv~-)u3LfF*Di!g3wsiAj&CfW|g!o->V^4uxAG*L06Oq4LA{w$A%_2k+&I z;obGT51Da~D@8uKMIX{8m(QQ_R(P%zIVy{Dvz@pSf{#Gkd4hj=StqBn1<(-VnM}GH zz2!IbH0`9Hs5*?MgIQv2TseEk95L0*0L{^J)H&%Uw}8sqp`C3IbwG?qh|4Z$hz$Dq z3yD2q0W2v(d7#y{Q7IHd?I2_6U?p~FXewrInRHO4=!kCs2E8Q?uw{^_CPs+_vY2cH z@;t<0jfDu;+(uFvZi`V25|9vG=tf6(9ammjhGPEAy+pbyU|7SxKaO>)rs?6`?w)awWd?0EIK6*j1N$qV6lX%CmBzoGbC_ zfwG~@D!Njkwy00YeY;u_?jgtMHL{`G92gd?E>TgPt|t>Pl0}4ol_fpo2}UrHY$j*P zZBoYgJ`fCo~y8e;*?B6y=np| zMkfVw2kR$xkfF<=Q1@b8L_T>y`p8T$i%BYpZUc6xMm07OTymY|xHYznU1jfqz{=re zy=)!0aT&N>BCEsdGPxi-%zBwEW{N3-wwy)xL(iY1X24eaVR|zaNz3Wv2Fu>1gH$VwM2bDw;3tO%n8Plo~SnhuiWXP-iFm56jsFCBa7ET8}sS6 z+7$AB4N!> zX2DtW$R;4)E^?Plq>?EYSp?05p*Yl7Me+{1K^*EtC*&&G5A@nWx?nBn%As_it~6Su z?6BA#MEyf51PcnH4rZexR55A+6Z9qB$Z%{P+sSsILL6dCxKlO-nm{u52uxEA4qwI9 zAi8dI9Itb$z)N2Ck$qrm-+SK>U$>#aPJ(eTTpDGQOIBU%zvSRXkT*H$TN+0hhV?3c)Gd^P7AZR`eue zpE@8qC!f!Y+z4mkE^uX|td(^_MfX9OPDbwYGafJmU_q?L>2~$ z(kb}HFjj5VBbK~de;oWJ9T{6Ujtv>Bp=uB{Qn5P9LYxAxKVwy&8-C)2r#0%iP}kb@ zb;R}^eMEQbj&E4|Q5(``VHIZBM6t$cW9p%@qg=z5GZE#7)rjiQ1Wi`;cO0g!s;$^J zOS?ksJOENF10v5>1$6;+#wK(zq`+Gz5S44dS8U3(Yyrlblu9LCT9rzq8tDjLw}bcf zi0dhmPjbqqz;F-pjNA^Nnv)0QefU*|oCpt11VWsJpLNP+#i}sy|8pg%R4ZwUU#3vm zUW1;|j3W(76ViY*EU8i(jDmf=cIf)2j z?cl93N7RtRWGQm556C8iK8MQbr3iWk^O%neY^Kto-$ck8auJotC2|vfKAn7ga;eQvFc3Mv((1s5EL3_jE%hAaiWty343c ztX>*G2AiWSV42IvC*81GC+^3KqcgM}UVj9A>l9~iz@6`4Bnpr(Y=|y#VDGEYKiq^2 zCO1xwVw{E%ZyLyFjPn6>kazsy!r12%%UDr4PxygPZ%~zNc&~ba>8V(ax&CcErW0#F z=g=KBkJX`eC@YVcuXC(28HA3Rgtd+<@PZ_LP3r`2O-Ec55Jz*sQx{Q5l;ZNJxt5AK0eeMCjG%M+_WgB{qtK@uWbR)O3nPB4) zAeM3*r3kr920F@VF$*^K*cN%5h@*+h$BN}4mk6&d}tJn%4sU|j+Erj~2Gfwst%zTZJ89VF4b*8YJ z&=6K})yIq#t4Q+ERe45dp{ppL$)``?neFi1Qn~_ny#X(rqz7R6wTK0a@Rd5~Q(IV# zO%S`rn9+@O#M7|cJ)rDKXu+NMdk9rH7dU(qcG(UL?nI4#Os~@I`ka=cb%QBaLlZg1 zY|g6r>aMb;3T#+>My zn3K|_T4_RT2G&Uz3(z@|fjU-`$VlfvM$2HN9a26zRUA@C42qRf8s1q@b=((=(H-mt zvo02^pg(Vl5mdO=#49`(#Zx@SMZ1_Hwu%*Er+6lEQU`hy`w+8F&rzwAh2sG z0-Q4r)U%Ce2O@Y8u5b!|a1ARThc=+&ZkCjO+}$j!eG2zkk2{G&9;gO3DuoYa1ADm? zH+m_$pb@o0Kj??At-SAdq!K`V(?)71nF_V_WXGHSX_`r3owJE3uCI z2|0p!uMHti)nW~E2tCS&$k7~DqwhdTEG7q`Bw7)H%Ymc=R3+AV9nzb?;+u%?H|T86 zWJ;g~p{m17Bf_ULoAecZ4h8d&UPY%vF(UOeeMEb(^^V>}o*1BKfG+YF8UF|AL?$1| z;sol}G_#1;9^``kcccNfjj9tn&#u6;ZqVi6ME%Ucr2=Ec;o-!)Txh&K=nzeXUsQ7e zAhCV+3HsJFTM9o=nFCa)N8qnJKsslP4O>gu5~yHVtb;9PUFfe~M-IA$XH4P>HsSBB z;IQq`iIbQL<`^jG5|#O5dKrjl8R)13KGI4HbS_l56nIK4U5)x}m zCcO^%rWVf*aA!BLaS%D?8uPn=)&C+YuG^Sr5B{HmM_+$?FF=i52S?90E)ho)z<=^# zH#^8k)A&1vcN6$_H{z=URkm&Y5@=0?ebplu#lhM<_!fmxe$xzk-MIexw?>n zQnf9$3jFsDt6-9ld*Xr6*3?t=8ZjPSOUO1e>b`oZo*`Daz}Fw}=>U9U9f;@wTN1uy zvwd*+WBAKBo_VN-`@lEuQ2ap@rYm5YO^|ztJ_gGkyVp{$u87N z#IqdavK=T`!)hs5OfAsok$R-vMXCE?{i;p;SkVUd-AcW^x%bT}Nc$HxK;y&5TOS;3#G{4lK0@pYP*&Ntn_7&_HJ4 zw*vNvW^}mAb72~X>U>^kI!7)`l?T7{i z3|4tC^LQNN=neSv7`#274pGxoCzzX)s-Uu{diYowYQIfDtP~Wd5In|-J1?Sgfao5f zbF5=zCc*Ef$#SR?PST5NixpbP6UKG`nqeJOiw2?!bt)@ZNCA|?dHgm;27dFQ1D0Hm zUldVc%a2e$*70;>_8RpTVD4H}O5>2-95Lqd>yf*LakZPc(j551J3<_QCl0Hf@P!&E zv&U*C{G%P(`I>sIh15czun=rNQM(4#bg2b;J3OF5)753|QY(Y5{)mp+as3MG%Ww2n zjBzP`x8n*L(<9=_GhRzjfhvSPm4&%zdH)?5C{*c~vwR@#CSZ_haLYRAI`OCqT|x74 z!mi&np$qB~4B-swZUQ238E{(({gy00DZmZqFiXj zBAdg-gZ+Eh31lnufkGG9z;|x(O@X_@_D$f!6?P64k1Hr&2P}glxsaz;an=sj&dSiC z@4&`UzW{#YfHYmeoNh4hOJu@L2cA|$Vw~l-)``wT-pckX262X z=z!gW+O-5!I|Uvzi)SNM0_JoD_HqGU-T;O!Ap49ULo^d@@PHb`mR6`I_@rx!?U?&TxsEq{KsRH+=IdZ$vN z)B-ov;*kV)UWzJQ7c93M*4hZ3-HZ1#sL{_ui9H7EI6#-&2`qRGJzE0y4PeU_EPP#d z%L{m2MR!!2+zNYdgT*hSD_{v;v4&&yg2xO)74sv1!~=Vp(Ux`_f{ZN z4%gww+0JmDIoXA+XYi>b?6(H*I>vV$K&{otMzu--_>M!-Wz@!TQKh{!BK z)Dvrf2WOB^`t<>H;3N0NvVyXr-dhIs-K<26@^7v{wKA_Ksj{0y?N=Xnlw1eaZye>%x)SQEl%+ z+*rcv6maV*)V^aVVJASl{m?L0Q4t?N7HWl}U5x#j@OKM)jN!9OytV@aPT^4x#bXNp zzv~jsxT8wMqcS=kwe&>j8Vt@GqMX=X4gGADUPJD^0Lt6}mcGF8Mu3z%@EpW-jNwY! zaGo^!5mD|8YRCZcb_@D#%AiQRA7RTd zSwnV`Wq5XC7PH7S^y{U74L_iUe~+6)X#U+5hxRr@P?Cb81NXH#R9w}@(md> z(9i|M5&{nk&UlV~zEkxUdFdQ@@*0To20eZupt2GufOXm&Sk#{Oqw2Kj z4B_t~)VDL>1h;NQZJ+__+YoAz+d#`3@VQguJP)F0DiB-){I4F-wH#=D0_tZQd@!E$ zqq;SWS@olev4EKh5ZPoE_(Bq?6Ytq@23wCv54gb*X8aOZ&jVhO3oMj`IA0FcZWQX( zEcCKvybeJD>!*5w1BZc{ur3Sg9z(@J4;QEhsCfk5)!>sp>@^7#HHt?gwj=^iIVqKV zgn}EvIYd~Qg}TPOOY$66b&9iY!q$cnABMj1mMrAzLNfWiBNUyXB5FVs9t4!K0Kq{K zy8%``1SjdoJ$J&Y`tUjf?h^d=3ui}AgFP6X4LoLnz%Ic_N6^9125alV@3r+qV_3yF z79ht2P?L#3)v-Y*_M+xjgq26{ytnt~{HV)%HO`{zX0T*gk3+9U3KTX1Hot@DieetP_CEC1 zBmD&2=NQp<5A%Kw<#i4^Y&E!e18iXgtfvijR0_*k){f9Gas#Wsgbj{Do2&n(#igR} z#D(sdTg3SVSo9I>^-fLJ?(p{-ykZ4gg0Sd)@R1YjbA*iG#%F|>DL_FUuKVG|6 tZP4{xYL@1~ew)B)XUHMjcs+p^y?^`NS5o0wc2w4@;BQ^Pr# ( -- sounds ) + init-openal 1 gen-sources first sounds boa + dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ; + +: bang ( sounds -- ) bang>> source-play check-error ; From 70ac6fdc15fd82ba66aef0f1258b1592b5a5cf86 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Fri, 9 May 2008 00:09:12 +1000 Subject: [PATCH 8/8] jamshred: fixed hang bug with a call to yield (I think it's fixed) --- extra/jamshred/jamshred.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 6b305696e5..3fb7113fde 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) ] [ dup [ jamshred>> jamshred-update ] [ relayout-1 ] bi - 10 sleep jamshred-loop + yield jamshred-loop ] if ; : fullscreen ( gadget -- )