blob: 1ba68ceba344cce477d8a4a10e5f8eda93662c73 (
about) (
plain)
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
|
module Draw where
import Xlib
main = getEnv "DISPLAY" exit (\ host -> draw host)
draw :: String -> IO ()
draw host =
xOpenDisplay host `thenIO` \ display ->
let (screen:_) = xDisplayRoots display
fg_color = xScreenBlackPixel screen
bg_color = xScreenWhitePixel screen
root = xScreenRoot screen
in
xCreateWindow root
(XRect 100 100 400 400)
[XWinBackground bg_color,
XWinEventMask (XEventMask [XButtonMotion,
XButtonPress,
XKeyPress])]
`thenIO` \window ->
xMapWindow window `thenIO` \() ->
xCreateGcontext (XDrawWindow root)
[XGCBackground bg_color,
XGCForeground fg_color] `thenIO` \ gcontext ->
let
handleEvent :: XPoint -> IO ()
handleEvent last =
xGetEvent display `thenIO` \event ->
let pos = xEventPos event
in
case (xEventType event) of
XButtonPressEvent -> handleEvent pos
XMotionNotifyEvent ->
xDrawLine (XDrawWindow window) gcontext last pos `thenIO` \() ->
handleEvent pos
XKeyPressEvent -> xCloseDisplay display
_ -> handleEvent last
in
appendChan stdout "Press any key to quit.\n" exit done `thenIO` \ _ ->
handleEvent (XPoint 0 0)
|
