home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / demo / X11 / draw / draw.hs next >
Encoding:
Text File  |  1994-09-27  |  1.3 KB  |  42 lines  |  [TEXT/YHS2]
  1. module Draw where
  2.  
  3. import Xlib 
  4.  
  5. main = getEnv "DISPLAY" >>= (\ host -> draw host)
  6.  
  7. draw :: String -> IO ()
  8. draw host =
  9.   xOpenDisplay host >>= \ display ->
  10.   let (screen:_) = xDisplayRoots display
  11.       fg_color = xScreenBlackPixel screen
  12.       bg_color = xScreenWhitePixel screen
  13.       root = xScreenRoot screen
  14.   in
  15.   xCreateWindow root
  16.                 (XRect 100 100 400 400)
  17.                 [XWinBackground bg_color,
  18.                  XWinEventMask (XEventMask [XButtonMotion, 
  19.                                     XButtonPress,
  20.                                             XKeyPress])] 
  21.   >>= \window ->
  22.   xMapWindow window >>= \() ->
  23.   xCreateGcontext (XDrawWindow root)
  24.                   [XGCBackground bg_color,
  25.                    XGCForeground fg_color] >>= \ gcontext ->
  26.   let
  27.     handleEvent :: XPoint -> IO ()
  28.     handleEvent last =
  29.       xGetEvent display >>= \event ->
  30.         let pos = xEventPos event
  31.     in        
  32.     case (xEventType event) of
  33.           XButtonPressEvent  -> handleEvent pos
  34.           XMotionNotifyEvent -> 
  35.             xDrawLine (XDrawWindow window) gcontext last pos >>= \() ->
  36.         handleEvent pos
  37.           XKeyPressEvent     -> xCloseDisplay display
  38.           _                  -> handleEvent last
  39.   in
  40.   putStr "Press any key to quit.\n" >>
  41.   handleEvent (XPoint 0 0)
  42.