{-# OPTIONS -Wall #-} -- -- Based on Gtk2Hs/demo/cairo/Drawing2.hs -- Author: Johan Bockgård -- -- This code is in the public domain. -- import Control.Monad (replicateM_) import qualified System.Glib.Types as GTypes import qualified Graphics.UI.Gtk as G import qualified Graphics.UI.Gtk.Glade as Glade import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as M import Paths_cairo_appbase as My windowWidth, windowHeight :: Int windowWidth = 500 windowHeight = 500 -- Write image to file _writePng :: IO () _writePng = C.withImageSurface C.FormatARGB32 width height $ \ result -> do C.renderWith result $ example width height C.surfaceWriteToPNG result "Draw.png" where width = windowWidth height = windowHeight -- Display image in window main :: IO () main = do _ <- G.initGUI -- load up the glade file filename <- My.getDataFileName "data/main.glade" windowXmlM <- Glade.xmlNew filename let windowXml = case windowXmlM of (Just wX) -> wX Nothing -> error ("can't find the glade file " ++ filename) get :: (G.WidgetClass widget) => (GTypes.GObject -> widget) -> String -> IO widget get = Glade.xmlGetWidget windowXml -- get a handle on widgets from the glade file window <- get G.castToWindow "window1" -- set up File->New new1 <- get G.castToMenuItem "new1" _ <- G.onActivateLeaf new1 $ myNew -- set up the File->Open dialog open1 <- get G.castToMenuItem "open1" openDialog <- get G.castToFileChooserDialog "opendialog" _ <- G.onActivateLeaf open1 $ G.widgetShow openDialog _ <- G.onResponse openDialog $ myFileOpen openDialog -- set up the File->Save_As dialog save1 <- get G.castToMenuItem "save1" save_as1 <- get G.castToMenuItem "save_as1" saveDialog <- get G.castToFileChooserDialog "savedialog" _ <- G.onActivateLeaf save_as1 $ G.widgetShow saveDialog _ <- G.onActivateLeaf save1 $ G.widgetShow saveDialog _ <- G.onResponse saveDialog $ myFileSave saveDialog -- set up Edit menu cut1 <- get G.castToMenuItem "cut1" _ <- G.onActivateLeaf cut1 $ myCut copy1 <- get G.castToMenuItem "copy1" _ <- G.onActivateLeaf copy1 $ myCopy paste1 <- get G.castToMenuItem "paste1" _ <- G.onActivateLeaf paste1 $ myPaste delete1 <- get G.castToMenuItem "delete1" _ <- G.onActivateLeaf delete1 $ myDelete -- set up the Help->About dialog about1 <- get G.castToMenuItem "about1" aboutdialog1 <- get G.castToAboutDialog "aboutdialog1" _ <- G.onActivateLeaf about1 $ G.widgetShow aboutdialog1 _ <- G.onResponse aboutdialog1 $ const $ G.widgetHide aboutdialog1 -- fix size -- G.windowSetResizable window False G.widgetSetSizeRequest window windowWidth windowHeight -- quit on File->Quit menu selection quit1 <- get G.castToMenuItem "quit1" _ <- G.onActivateLeaf quit1 $ G.widgetDestroy window _ <- G.onDestroy window G.mainQuit -- set up the canvas canvas <- get G.castToDrawingArea "drawingarea1" _ <- G.onExpose canvas $ const (updateCanvas canvas) G.widgetShowAll window G.mainGUI myNew :: IO () myNew = putStrLn "New" myFileOpen :: G.FileChooserDialog -> G.ResponseId -> IO () myFileOpen fcdialog response = do case response of G.ResponseOk -> do Just filename <- G.fileChooserGetFilename fcdialog putStrLn filename G.ResponseCancel -> putStrLn "Cancelled!" G.ResponseDeleteEvent -> putStrLn "FileChooserDialog Deleted!" G.ResponseClose -> putStrLn "Closed!" _ -> return () G.widgetHide fcdialog myFileSave :: G.FileChooserDialog -> G.ResponseId -> IO () myFileSave = myFileOpen myCut :: IO () myCut = putStrLn "Cut" myCopy :: IO () myCopy = putStrLn "Copy" myPaste :: IO () myPaste = putStrLn "Paste" myDelete :: IO () myDelete = putStrLn "Delete" updateCanvas :: G.DrawingArea -> IO Bool updateCanvas canvas = do win <- G.widgetGetDrawWindow canvas (width, height) <- G.widgetGetSize canvas G.renderWithDrawable win $ example width height return True ---------------------------------------------------------------- foreach :: (Monad m) => [a] -> (a -> m b) -> m [b] foreach = flip mapM keepState :: C.Render t -> C.Render () keepState render = do C.save _ <- render C.restore drawCircle :: Double -> Double -> Double -> C.Render () drawCircle x y r = do C.arc x y r 0 (2 * pi) fillStroke drawRectangle :: Double -> Double -> Double -> Double -> C.Render () drawRectangle x y w h = do C.rectangle x y w h fillStroke stroke :: C.Render () stroke = keepState $ do C.setSourceRGBA 0 0 0 0.7 C.stroke fillStroke :: C.Render () fillStroke = do C.fillPreserve stroke ---------------------------------------------------------------- -- Example example :: Int -> Int -> C.Render () example width height = do prologue width height example1 -- Set up stuff prologue :: Int -> Int -> C.Render () prologue wWidth wHeight = do let width = 10 height = 10 xmax = width / 2 xmin = - xmax ymax = height / 2 ymin = - ymax scaleX = realToFrac wWidth / width scaleY = realToFrac wHeight / height -- style and color C.setLineCap C.LineCapRound C.setLineJoin C.LineJoinRound C.setLineWidth $ 1 / max scaleX scaleY C.setSourceRGBA 0.5 0.7 0.5 0.5 -- Set up user coordinates C.scale scaleX scaleY -- center origin C.translate (width / 2) (height / 2) -- positive y-axis upwards let flipY = M.Matrix 1 0 0 (-1) 0 0 C.transform flipY grid xmin xmax ymin ymax -- Grid and axes grid :: Double -> Double -> Double -> Double -> C.Render () grid xmin xmax ymin ymax = keepState $ do C.setSourceRGBA 0 0 0 0.7 -- axes C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke C.moveTo xmin 0; C.lineTo xmax 0; C.stroke -- grid C.setDash [0.01, 0.99] 0 foreach [xmin .. xmax] $ \ x -> do C.moveTo x ymin C.lineTo x ymax C.stroke example1 :: C.Render () example1 = do -- circles drawCircle 0 0 1 drawCircle 2 2 3 -- a bunch of rectangles keepState $ replicateM_ 5 $ do drawRectangle 0 1 2 3 C.rotate (pi/8) -- some cute stuff thought apple snake thought :: C.Render () thought = keepState $ do C.scale 0.04 0.04 C.translate (200) (380) C.rotate pi C.setSourceRGBA 0.5 0.5 1 0.7 C.setLineWidth 1 image fillStroke where m = C.moveTo c = C.curveTo z = C.closePath image = do m 184 327 c 176 327 170 332 168 339 c 166 333 160 329 153 329 c 147 329 141 333 138 339 c 137 339 136 338 134 338 c 125 338 118 345 118 354 c 118 363 125 371 134 371 c 137 371 140 370 142 368 c 142 368 142 368 142 369 c 142 377 149 385 158 385 c 162 385 166 383 168 381 c 171 386 176 390 183 390 c 188 390 193 387 196 383 c 198 384 201 385 204 385 c 212 385 220 378 220 369 c 222 371 225 372 228 372 c 237 372 244 364 244 355 c 244 346 237 339 228 339 c 227 339 226 339 225 340 c 223 332 217 327 209 327 c 204 327 199 330 196 333 c 193 330 189 327 184 327 z m 164 387 c 158 387 153 391 153 397 c 153 402 158 407 164 407 c 170 407 174 402 174 397 c 174 391 170 387 164 387 z m 152 408 c 149 408 146 411 146 414 c 146 417 149 420 152 420 c 155 420 158 417 158 414 c 158 411 155 408 152 408 z m 143 422 c 141 422 139 424 139 426 c 139 428 141 429 143 429 c 144 429 146 428 146 426 c 146 424 144 422 143 422 z apple :: C.Render () apple = keepState $ do C.scale 0.05 0.05 C.translate (1110) (220) C.rotate pi C.setLineWidth 0.5 C.setSourceRGBA 0 0 0 0.7 image1 fillStroke C.setSourceRGBA 1 0 0 0.7 image2 fillStroke where m = C.moveTo c = C.curveTo z = C.closePath l = C.lineTo image1 = do m 1149 245 l 1156 244 l 1155 252 l 1149 245 z image2 = do m 1151 249 c 1145 249 1140 254 1140 261 c 1140 268 1145 273 1151 273 c 1152 273 1153 273 1154 272 c 1156 273 1157 273 1158 273 c 1164 273 1169 268 1169 261 c 1169 254 1164 249 1158 249 c 1157 249 1156 249 1154 250 c 1153 249 1152 249 1151 249 z snake :: C.Render () snake = keepState $ do C.scale 0.04 0.04 C.translate (150) (220) C.rotate pi C.setLineWidth 0.5 C.setSourceRGBA 0.1 0.1 0 0.7 image fillStroke where m = C.moveTo c = C.curveTo z = C.closePath l = C.lineTo image = do m 146 320 c 143 308 130 314 123 319 c 115 324 108 311 100 314 c 93 317 92 319 81 318 c 76 318 60 309 60 320 c 60 328 73 321 82 323 c 94 326 98 317 106 320 c 113 323 120 330 128 323 c 133 318 142 312 146 320 l 146 320 z ----------------------------------------------------------------