{-# LANGUAGE NoMonomorphismRestriction #-}

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