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
|
module GraphicsUtils
( clearWindow, draw
, getKey, getKeyEx
, getButton, getLBP, getRBP
, windowSize
) where
import GraphicsPicture
import GraphicsWindows
import GraphicsEvent( Event(..) )
----------------------------------------------------------------
-- The interface
----------------------------------------------------------------
clearWindow :: Window -> IO ()
draw :: Window -> Picture -> IO ()
windowSize :: Window -> IO Point
-- wait for left/right mouse button up
getLBP :: Window -> IO Point
getRBP :: Window -> IO Point
-- wait for left/right mouse button to go down/up
getButton :: Window -> Bool -> Bool -> IO Point
-- wait for a key to go down then a (possibly different) key to go up
getKey :: Window -> IO Char
-- wait for key to go down/up
getKeyEx :: Window -> Bool -> IO Char
----------------------------------------------------------------
-- The window buffer
----------------------------------------------------------------
clearWindow w = setPicture w empty
draw w p = do
oldPicture <- getPicture w
setPicture w (p `over` oldPicture)
----------------------------------------------------------------
-- Simple input operations
----------------------------------------------------------------
getLBP w = getButton w True True
getRBP w = getButton w False True
getKey w = do { getKeyEx w True; getKeyEx w False }
----------------------------------------------------------------
-- Slightly more complicated input operations
----------------------------------------------------------------
getKeyEx w down = loop
where
loop = do
e <- getEvent w
case e of
Key { char = c, isDown }
| isDown == down
-> return c
_ -> loop
getButton w left down = loop
where
loop = do
e <- getEvent w
case e of
Button {pt,isLeft,isDown}
| isLeft == left && isDown == down
-> return pt
_ -> loop
----------------------------------------------------------------
windowSize w = do
((l,t),(r,b)) <- windowRect w
return (r-l, b-t)
----------------------------------------------------------------
-- The end
----------------------------------------------------------------
|
