diff options
| author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
|---|---|---|
| committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
| commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
| tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /progs/demo/X11/draw | |
Import to github.
Diffstat (limited to 'progs/demo/X11/draw')
| -rw-r--r-- | progs/demo/X11/draw/README | 1 | ||||
| -rw-r--r-- | progs/demo/X11/draw/draw.hs | 41 | ||||
| -rw-r--r-- | progs/demo/X11/draw/draw.hu | 2 |
3 files changed, 44 insertions, 0 deletions
diff --git a/progs/demo/X11/draw/README b/progs/demo/X11/draw/README new file mode 100644 index 0000000..b844d2b --- /dev/null +++ b/progs/demo/X11/draw/README @@ -0,0 +1 @@ +This is the draw program used in the X window documentation diff --git a/progs/demo/X11/draw/draw.hs b/progs/demo/X11/draw/draw.hs new file mode 100644 index 0000000..1ba68ce --- /dev/null +++ b/progs/demo/X11/draw/draw.hs @@ -0,0 +1,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) diff --git a/progs/demo/X11/draw/draw.hu b/progs/demo/X11/draw/draw.hu new file mode 100644 index 0000000..f09a72e --- /dev/null +++ b/progs/demo/X11/draw/draw.hu @@ -0,0 +1,2 @@ +$HASKELL_LIBRARY/X11/xlib.hu +draw.hs |