1 ! Copyright (C) 2007, 2008 Alex Chapman
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays calendar jamshred.game jamshred.gl
4 jamshred.player kernel math math.constants math.vectors
5 namespaces sequences threads ui ui.gadgets ui.gadgets.worlds
6 ui.gestures ui.render ;
9 TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
11 : <jamshred-gadget> ( jamshred -- gadget )
12 jamshred-gadget new swap >>jamshred ;
14 CONSTANT: default-width 800
15 CONSTANT: default-height 600
17 M: jamshred-gadget pref-dim*
18 drop default-width default-height 2array ;
20 M: jamshred-gadget draw-gadget* ( gadget -- )
21 [ jamshred>> ] [ dim>> first2 draw-jamshred ] bi ;
23 : jamshred-loop ( gadget -- )
24 dup jamshred>> quit>> [
27 [ jamshred>> jamshred-update ]
29 [ 100 milliseconds sleep jamshred-loop ] tri
32 M: jamshred-gadget graft* ( gadget -- )
33 [ find-gl-context init-graphics ]
34 [ [ jamshred-loop ] curry in-thread ] bi ;
36 M: jamshred-gadget ungraft* ( gadget -- )
37 dup find-gl-context cleanup-graphics jamshred>> t swap quit<< ;
39 : jamshred-restart ( jamshred-gadget -- )
40 <jamshred> >>jamshred drop ;
42 : pix>radians ( n m -- theta )
43 / pi 4 * * ; ! 2 / / pi 2 * * ;
45 : x>radians ( x gadget -- theta )
46 ! translate motion of x pixels to an angle
47 dim>> first pix>radians neg ;
49 : y>radians ( y gadget -- theta )
50 ! translate motion of y pixels to an angle
51 dim>> second pix>radians ;
53 : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
54 dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
55 rot jamshred>> mouse-moved ;
57 : handle-mouse-motion ( jamshred-gadget -- )
59 over last-hand-loc>> [
60 v- (handle-mouse-motion)
62 ] 2keep >>last-hand-loc drop ;
64 : handle-mouse-scroll ( jamshred-gadget -- )
65 jamshred>> scroll-direction get
66 [ first mouse-scroll-x ]
67 [ second mouse-scroll-y ] 2bi ;
70 [ f set-fullscreen ] [ close-window ] bi ;
73 { T{ key-down f f "r" } [ jamshred-restart ] }
74 { T{ key-down f f " " } [ jamshred>> toggle-running ] }
75 { T{ key-down f f "f" } [ toggle-fullscreen ] }
76 { T{ key-down f f "UP" } [ jamshred>> jamshred-player 1 swap change-player-speed ] }
77 { T{ key-down f f "DOWN" } [ jamshred>> jamshred-player -1 swap change-player-speed ] }
78 { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
79 { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
80 { T{ key-down f f "ESC" } [ quit ] }
81 { T{ key-down f f "q" } [ quit ] }
82 { motion [ handle-mouse-motion ] }
83 { mouse-scroll [ handle-mouse-scroll ] }
86 MAIN-WINDOW: jamshred-window { { title "Jamshred" } }
87 <jamshred> <jamshred-gadget> >>gadgets ;