1 ! Copyright (C) 2006, 2007 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alarms arrays calendar kernel ui.gadgets ui.gadgets.labels
4 ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui
5 tetris.game tetris.gl sequences system math math.parser namespaces
9 TUPLE: tetris-gadget tetris alarm ;
11 : <tetris-gadget> ( tetris -- gadget )
12 tetris-gadget construct-gadget
13 [ set-tetris-gadget-tetris ] keep ;
15 M: tetris-gadget pref-dim* drop { 200 400 } ;
17 : update-status ( gadget -- )
18 dup tetris-gadget-tetris [
19 "Level: " % dup tetris-level #
20 " Score: " % tetris-score #
21 ] "" make swap show-status ;
23 M: tetris-gadget draw-gadget* ( gadget -- )
25 dup rect-dim dup first swap second rot tetris-gadget-tetris draw-tetris
26 ] keep update-status ;
28 : new-tetris ( gadget -- )
29 dup tetris-gadget-tetris <new-tetris> swap set-tetris-gadget-tetris ;
32 { T{ key-down f f "UP" } [ tetris-gadget-tetris rotate-right ] }
33 { T{ key-down f f "d" } [ tetris-gadget-tetris rotate-left ] }
34 { T{ key-down f f "f" } [ tetris-gadget-tetris rotate-right ] }
35 { T{ key-down f f "e" } [ tetris-gadget-tetris rotate-left ] } ! dvorak d
36 { T{ key-down f f "u" } [ tetris-gadget-tetris rotate-right ] } ! dvorak f
37 { T{ key-down f f "LEFT" } [ tetris-gadget-tetris move-left ] }
38 { T{ key-down f f "RIGHT" } [ tetris-gadget-tetris move-right ] }
39 { T{ key-down f f "DOWN" } [ tetris-gadget-tetris move-down ] }
40 { T{ key-down f f " " } [ tetris-gadget-tetris move-drop ] }
41 { T{ key-down f f "p" } [ tetris-gadget-tetris toggle-pause ] }
42 { T{ key-down f f "n" } [ new-tetris ] }
46 dup tetris-gadget-tetris maybe-update relayout-1 ;
48 M: tetris-gadget graft* ( gadget -- )
49 dup [ tick ] curry 100 milliseconds every
50 swap set-tetris-gadget-alarm ;
52 M: tetris-gadget ungraft* ( gadget -- )
53 [ tetris-gadget-alarm cancel-alarm f ] keep set-tetris-gadget-alarm ;
55 : tetris-window ( -- )
57 <default-tetris> <tetris-gadget>
58 "Tetris" open-status-window