-
Notifications
You must be signed in to change notification settings - Fork 0
/
Layout.hs
122 lines (97 loc) · 3.83 KB
/
Layout.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
module Layout where
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.EventM
import Data.IORef
import Data.Time.Clock
import Structure
maxRows = 24 :: Int
maxColumns = 18 :: Int
initTetrisLayout :: IO LayoutInfo
initTetrisLayout = do
initGUI
mainWindow' <- windowNew
drawingArea' <- drawingAreaNew
previewArea' <- drawingAreaNew
table' <- tableNew 2 4 False
-- we make all buttons in a horizonal button box
pauseB' <- toggleButtonNewWithLabel stockMediaPause
restartB' <- buttonNewFromStock stockClear
infoB' <- buttonNewFromStock stockAbout
quitB' <- buttonNewFromStock stockQuit
hButtonBox' <- hButtonBoxNew
containerAdd hButtonBox' pauseB'
containerAdd hButtonBox' restartB'
containerAdd hButtonBox' infoB'
containerAdd hButtonBox' quitB'
--containerSetBorderWidth table' 5
-- score labels
strScore' <- labelNewWithMnemonic "S C O R E"
strLevel' <- labelNewWithMnemonic "L E V E L"
labelScore' <- labelNew $ Just "0"
labelLevel' <- labelNew $ Just "0"
upperPad' <- labelNew $ Just "T E T R I S"
labelSetJustify strScore' JustifyLeft
labelSetJustify strLevel' JustifyLeft
labelSetJustify labelScore' JustifyLeft
labelSetJustify labelLevel' JustifyLeft
-- we start do layout
tableAttach table' upperPad' 0 2 0 1 [Fill] [] 0 10
tableAttach table' drawingArea' 0 1 1 3 [Expand, Fill] [Expand, Fill] 10 0
-- right part of vBoxSub and alignment
vBoxSub' <- vBoxNew False 5
tableAttach table' vBoxSub' 1 2 1 2 [] [Fill] 0 0
widgetSetSizeRequest strScore' labelWidth labelHeight
widgetSetSizeRequest strLevel' labelWidth labelHeight
widgetSetSizeRequest labelScore' labelWidth labelHeight
widgetSetSizeRequest labelLevel' labelWidth labelHeight
boxPackStart vBoxSub' previewArea' PackNatural 1
boxPackStart vBoxSub' strScore' PackNatural 1
boxPackStart vBoxSub' labelScore' PackNatural 1
boxPackStart vBoxSub' strLevel' PackNatural 1
boxPackStart vBoxSub' labelLevel' PackNatural 1
widgetSetSizeRequest previewArea' previewWidth previewHeigh
align' <- alignmentNew 0 0 0 0
containerAdd align' labelLevel'
tableAttach table' align' 1 2 2 3 [] [Expand, Fill] 0 0
-- hButtonBox packing
tableAttach table' hButtonBox' 0 2 3 4 [Fill] [] 0 10
-- we put it into window
containerAdd mainWindow' table'
windowSetTitle mainWindow' "Hask-Tetris"
--windowSetDefaultSize mainWindow' 640 480
widgetSetSizeRequest mainWindow' windowWidth windowHeight
windowSetResizable mainWindow' False
initTime' <- getCurrentTime
(getTimerId,setTimerId) <- getAndSet Nothing
return LayoutInfo {
mainWindow = mainWindow' ,
drawingArea = drawingArea' ,
previewArea = previewArea' ,
labelScore = labelScore' ,
labelLevel = labelLevel' ,
pauseB = pauseB' ,
restartB = restartB' ,
infoB = infoB' ,
quitB = quitB' ,
initTime = initTime' ,
timerId = (getTimerId, setTimerId)
}
-- closure
getAndSet :: a -> IO (IO a, a -> IO ())
getAndSet a = do
ior <- newIORef a
let get = readIORef ior
let set = writeIORef ior
return (get,set)
windowWidth = 602
windowHeight = 554
previewWidth = 95
previewHeigh = 110
labelWidth = 110
labelHeight = 20
{-
-- we put the drawArea upon a frame
aFrame' <- aspectFrameNew 0.5 0.5 (Just (fromIntegral maxColumns / fromIntegral maxRows))
frameSetShadowType aFrame' ShadowNone
containerAdd aFrame' drawingArea'
-}