1 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alarms arrays calendar kernel make math math.rectangles math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
4 FROM: tetris.game => level>> ;
7 TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ;
9 : <tetris-gadget> ( tetris -- gadget )
10 tetris-gadget new swap >>tetris ;
12 M: tetris-gadget pref-dim* drop { 200 400 } ;
14 : update-status ( gadget -- )
16 "Level: " % dup level>> #
17 " Score: " % score>> #
18 ] "" make swap show-status ;
20 M: tetris-gadget draw-gadget* ( gadget -- )
22 [ dim>> first2 ] [ tetris>> ] bi draw-tetris
23 ] keep update-status ;
25 : new-tetris ( gadget -- gadget )
26 [ <new-tetris> ] change-tetris ;
29 { T{ button-down f f 1 } [ request-focus ] }
30 { T{ key-down f f "UP" } [ tetris>> rotate-right ] }
31 { T{ key-down f f "d" } [ tetris>> rotate-left ] }
32 { T{ key-down f f "f" } [ tetris>> rotate-right ] }
33 { T{ key-down f f "e" } [ tetris>> rotate-left ] } ! dvorak d
34 { T{ key-down f f "u" } [ tetris>> rotate-right ] } ! dvorak f
35 { T{ key-down f f "LEFT" } [ tetris>> move-left ] }
36 { T{ key-down f f "RIGHT" } [ tetris>> move-right ] }
37 { T{ key-down f f "DOWN" } [ tetris>> move-down ] }
38 { T{ key-down f f " " } [ tetris>> move-drop ] }
39 { T{ key-down f f "p" } [ tetris>> toggle-pause ] }
40 { T{ key-down f f "n" } [ new-tetris drop ] }
44 [ tetris>> ?update ] [ relayout-1 ] bi ;
46 M: tetris-gadget graft* ( gadget -- )
47 [ [ tick ] curry 100 milliseconds every ] keep (>>alarm) ;
49 M: tetris-gadget ungraft* ( gadget -- )
50 [ cancel-alarm f ] change-alarm drop ;
52 : tetris-window ( -- )
54 <default-tetris> <tetris-gadget>
55 "Tetris" open-status-window