steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

jamshred is playable! (scroll to acc/decelerate)

db4
Alex Chapman 2008-05-08 13:04:44 +10:00
parent ea2107e463
commit 052962d3b8
3 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/jamshred/jamshred.factor
View File

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

21
extra/jamshred/player/player.factor
View File

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

4
extra/jamshred/tunnel/tunnel.factor
View File

@ -137,7 +137,9 @@ C: <segment> 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!