| 1 |
module Main where
|
| 2 |
|
| 3 |
import Data.IORef
|
| 4 |
import Graphics.UI.Gtk hiding (eventButton)
|
| 5 |
import Graphics.UI.Gtk.Gdk.Events(eventX,eventY,eventButton)
|
| 6 |
import Graphics.UI.Gtk.Gdk.GC
|
| 7 |
|
| 8 |
data ApplicationState = ApplicationState
|
| 9 |
{ apLines :: [[(Int, Int)]]
|
| 10 |
, apCursor :: Maybe (Int, Int)
|
| 11 |
} deriving (Eq, Show)
|
| 12 |
|
| 13 |
rnd :: Double -> Int
|
| 14 |
rnd x = ((floor x) `div` 10) * 10
|
| 15 |
|
| 16 |
render :: WidgetClass d => d -> ApplicationState -> IO ()
|
| 17 |
render d state = do
|
| 18 |
dw <- widgetGetDrawWindow d
|
| 19 |
gc <- gcNewWithValues dw newGCValues { foreground = Color 0x9999 0x9999 0x9999 }
|
| 20 |
(w, h) <- drawableGetSize dw
|
| 21 |
drawRectangle dw gc True 0 0 w h
|
| 22 |
gcSetValues gc (newGCValues { foreground = Color 0 0 0 })
|
| 23 |
mapM_ (drawPoint dw gc) [ (x * 10, y * 10)
|
| 24 |
| x <- [0..w `div` 10]
|
| 25 |
, y <- [0..h `div` 10]
|
| 26 |
]
|
| 27 |
mapM_ (drawLines dw gc) (apLines state)
|
| 28 |
case apCursor state of
|
| 29 |
Nothing -> return ()
|
| 30 |
Just (x, y) -> do
|
| 31 |
gcSetValues gc (newGCValues { foreground = Color 0x9999 0 0 })
|
| 32 |
drawLine dw gc (x-5,y) (x+5,y)
|
| 33 |
drawLine dw gc (x,y-5) (x,y+5)
|
| 34 |
|
| 35 |
main :: IO ()
|
| 36 |
main = do
|
| 37 |
_ <- initGUI
|
| 38 |
window <- windowNew
|
| 39 |
da <- drawingAreaNew
|
| 40 |
set window [ windowDefaultWidth := 200
|
| 41 |
, windowDefaultHeight := 200
|
| 42 |
, containerChild := da
|
| 43 |
, containerBorderWidth := 10
|
| 44 |
]
|
| 45 |
stRef <- newIORef (ApplicationState [[]] Nothing)
|
| 46 |
_ <- onMotionNotify da True $ \ event -> do
|
| 47 |
st <- readIORef stRef
|
| 48 |
let (x, y) = (rnd (eventX event), rnd (eventY event))
|
| 49 |
let st' = st { apCursor = Just (x, y) }
|
| 50 |
render da st'
|
| 51 |
writeIORef stRef st'
|
| 52 |
return True
|
| 53 |
_ <- onButtonPress da $ \ event ->
|
| 54 |
if eventButton event == RightButton
|
| 55 |
then do
|
| 56 |
st <- readIORef stRef
|
| 57 |
let st' = st { apLines = [] : apLines st }
|
| 58 |
writeIORef stRef st'
|
| 59 |
return True
|
| 60 |
else do
|
| 61 |
st <- readIORef stRef
|
| 62 |
let (x, y) = (rnd (eventX event), rnd (eventY event))
|
| 63 |
let st' = st { apLines = ((x, y) : head (apLines st)) : tail (apLines st) }
|
| 64 |
writeIORef stRef st'
|
| 65 |
render da st'
|
| 66 |
return True
|
| 67 |
_ <- window `onDestroy` mainQuit
|
| 68 |
widgetShowAll window
|
| 69 |
mainGUI
|