| 1 | 1 |
module Main where
|
| 2 | 2 |
|
| 3 | 3 |
import Data.IORef
|
| 4 |
import Graphics.UI.Gtk.Cairo
|
| 4 | 5 |
import Graphics.UI.Gtk hiding (eventButton)
|
| 5 | 6 |
import Graphics.UI.Gtk.Gdk.Events(eventX,eventY,eventButton)
|
| 6 | |
import Graphics.UI.Gtk.Gdk.GC
|
| 7 |
import qualified Graphics.Rendering.Cairo as C
|
| 7 | 8 |
|
| 8 | 9 |
data ApplicationState = ApplicationState
|
| 9 | 10 |
{ apLines :: [[(Int, Int)]]
|
|
| 13 | 14 |
rnd :: Double -> Int
|
| 14 | 15 |
rnd x = ((floor x) `div` 10) * 10
|
| 15 | 16 |
|
| 17 |
dLine :: [(Int, Int)] -> C.Render ()
|
| 18 |
dLine [] = return ()
|
| 19 |
dLine [(x,y)] = do
|
| 20 |
C.moveTo (fromIntegral x) (fromIntegral y)
|
| 21 |
C.lineTo (fromIntegral x) (fromIntegral y)
|
| 22 |
C.stroke
|
| 23 |
dLine ((x,y):rs) = do
|
| 24 |
C.moveTo (fromIntegral x) (fromIntegral y)
|
| 25 |
sequence_ [ C.lineTo (fromIntegral x') (fromIntegral y')
|
| 26 |
| (x', y') <- rs
|
| 27 |
]
|
| 28 |
C.stroke
|
| 29 |
|
| 30 |
dPoints :: [(Int, Int)] -> C.Render ()
|
| 31 |
dPoints ps =
|
| 32 |
sequence_ [ C.arc (fromIntegral x) (fromIntegral y) 2.0 0.0 (2 * pi) >>
|
| 33 |
C.stroke
|
| 34 |
| (x, y) <- ps
|
| 35 |
]
|
| 36 |
|
| 16 | 37 |
render :: WidgetClass d => d -> ApplicationState -> IO ()
|
| 17 | 38 |
render d state = do
|
| 18 | 39 |
dw <- widgetGetDrawWindow d
|
| 19 | |
gc <- gcNewWithValues dw newGCValues { foreground = Color 0x9999 0x9999 0x9999 }
|
| 20 | 40 |
(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)
|
| 41 |
renderWithDrawable dw $ do
|
| 42 |
C.setSourceRGB 1.0 1.0 1.0
|
| 43 |
C.rectangle 0 0 (fromIntegral w) (fromIntegral h)
|
| 44 |
C.fill
|
| 45 |
C.setSourceRGB 0.0 0.0 0.0
|
| 46 |
mapM_ dLine (apLines state)
|
| 47 |
case apLines state of
|
| 48 |
[] -> return ()
|
| 49 |
(x:xs) -> do
|
| 50 |
mapM_ dPoints xs
|
| 51 |
C.setSourceRGB 0.0 1.0 1.0
|
| 52 |
dPoints x
|
| 53 |
C.setSourceRGB 1.0 0.0 0.0
|
| 54 |
case apCursor state of
|
| 55 |
Nothing -> return ()
|
| 56 |
Just (x, y) -> do
|
| 57 |
C.arc (fromIntegral x) (fromIntegral y) 5.0 0.0 (2 * pi)
|
| 58 |
C.stroke
|
| 59 |
return ()
|
| 34 | 60 |
|
| 35 | 61 |
main :: IO ()
|
| 36 | 62 |
main = do
|