module DrawDiagrams
( module Diagrams
, draw
, drawOn
) where
import Diagrams
import Graphics.UI.Gtk
import Graphics.Rendering.Cairo ( Render, liftIO )
import Graphics.Rendering.Diagrams.Engine ( render )
import Graphics.Rendering.Diagrams.Types ( runDiaRenderM, defaultDiaRenderEnv )
test1 = draw $ union [circle 2 `move` (x,0) | x<-[0..10]] `fill` white
draw :: Diagram -> IO ()
draw = drawOn 640 400
drawOn :: Int -> Int -> Diagram -> IO ()
drawOn w h dia = do
initGUI
dialog <- dialogNew
windowSetKeepAbove dialog True
set dialog [ windowWindowPosition := WinPosCenter ]
dialogAddButton dialog stockClose ResponseClose
contain <- dialogGetUpper dialog
canvas <- drawingAreaNew
canvas `onSizeRequest` return (Requisition w h)
boxPackStartDefaults contain canvas
canvas `on` exposeEvent $ tryEvent $ liftIO $ do
win <- widgetGetDrawWindow canvas
renderWithDrawable win $
flip runDiaRenderM defaultDiaRenderEnv $ render $
(rect (fromIntegral w) (fromIntegral h) `fill` white `strokeWidth` 0
<|> scaleY (1) dia `scale` 20)
`move` (fromIntegral w/2, fromIntegral h/2)
widgetShow canvas
dialogRun dialog
widgetDestroy dialog
flush