! 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 ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors arrays calendar jamshred.game jamshred.gl
+jamshred.player kernel math math.constants math.vectors
+namespaces sequences threads ui ui.gadgets ui.gadgets.worlds
+ui.gestures ui.render ;
IN: jamshred
TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
] [
[ jamshred>> jamshred-update ]
[ relayout-1 ]
- [ 100 milliseconds sleep jamshred-loop ] tri
+ [ 100 milliseconds sleep jamshred-loop ] tri
] 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 -- )
[ find-gl-context init-graphics ]
[ [ 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 ;
/ pi 4 * * ; ! 2 / / pi 2 * * ;
: x>radians ( x gadget -- theta )
- #! translate motion of x pixels to an angle
+ ! translate motion of x pixels to an angle
dim>> first pix>radians neg ;
: y>radians ( y gadget -- theta )
- #! translate motion of y pixels to an angle
+ ! translate motion of y pixels to an angle
dim>> second pix>radians ;
: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
rot jamshred>> mouse-moved ;
-
+
: handle-mouse-motion ( jamshred-gadget -- )
hand-loc get [
over last-hand-loc>> [
- v- (handle-mouse-motion)
- ] [ 2drop ] if*
+ v- (handle-mouse-motion)
+ ] [ 2drop ] if*
] 2keep >>last-hand-loc drop ;
: handle-mouse-scroll ( jamshred-gadget -- )
[ second mouse-scroll-y ] 2bi ;
: quit ( gadget -- )
- [ no-fullscreen ] [ close-window ] bi ;
+ [ f set-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 "f" } [ 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 "ESC" } [ quit ] }
{ T{ key-down f f "q" } [ quit ] }
{ motion [ handle-mouse-motion ] }
{ mouse-scroll [ handle-mouse-scroll ] }
} set-gestures
-: jamshred-window ( -- )
- [ <jamshred> <jamshred-gadget> "Jamshred" open-window ] with-ui ;
-
-MAIN: jamshred-window
+MAIN-WINDOW: jamshred-window { { title "Jamshred" } }
+ <jamshred> <jamshred-gadget> >>gadgets ;