module Graphics.PS.Cairo (renderImage, cg) where

import Data.IORef
import Graphics.PS as P
import Graphics.PS.Matrix as P
import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.Rendering.Cairo.Matrix as C
import qualified Graphics.UI.Gtk as G

applyMatrix :: Matrix -> C.Render ()
applyMatrix (Matrix a b c d e f) = C.transform (C.Matrix a b c d e f)

applyFont :: Font -> C.Render ()
applyFont (Font nm sz) = do
  C.selectFontFace nm C.FontSlantNormal C.FontWeightNormal
  C.setFontSize sz

renderPath :: P.Path -> C.Render ()
renderPath path =
    case path of
      P.MoveTo (Pt x y) -> C.moveTo x y
      P.LineTo (Pt x y) -> C.lineTo x y
      P.CurveTo (Pt x1 y1) (Pt x2 y2) (Pt x3 y3) -> C.curveTo x1 y1 x2 y2 x3 y3
      P.Text f t -> applyFont f >> C.textPath t
      P.PTransform m p -> C.save >> applyMatrix m >> renderPath p >> C.restore
      P.Join p1 p2 -> renderPath p1 >> renderPath p2

setGS :: GS -> C.Render ()
setGS (GS (RGB r b g) w k j _ _) = do 
  C.setSourceRGBA r g b 0.75
  C.setLineWidth w
  C.setLineCap (lineCap k)
  C.setLineJoin (lineJoin j)

renderImage :: P.Image -> C.Render ()
renderImage image =
    case image of
      P.Empty -> return ()
      P.Stroke g p -> renderPath p >> setGS g >> C.stroke
      P.Fill g p -> renderPath p >> setGS g >> C.fillPreserve >> C.stroke
      P.ITransform m i -> C.save >> applyMatrix m >> renderImage i >> C.restore
      P.Over i1 i2 -> renderImage i1 >> renderImage i2

lineCap :: LineCap -> C.LineCap
lineCap RoundCap = C.LineCapRound
lineCap ButtCap = C.LineCapButt
lineCap ProjectingSquareCap = C.LineCapSquare

lineJoin :: LineJoin -> C.LineJoin
lineJoin MiterJoin = C.LineJoinMiter
lineJoin RoundJoin = C.LineJoinRound
lineJoin BevelJoin = C.LineJoinBevel

--
cg :: String -> Paper -> [P.Image] -> IO ()
cg _ (Paper w h) pp = do
  G.initGUI
  window <- G.windowNew
  canvas <- G.drawingAreaNew
  n <- newIORef 0
  G.windowSetResizable window False
  G.widgetSetSizeRequest window w h
  G.onKeyPress window (\_ -> modifyIORef n (+ 1) >> 
                             G.widgetQueueDraw window >> 
                             return True)
  G.onDestroy window G.mainQuit
  G.onExpose canvas (const (updateCanvas n canvas pp))
  G.set window [G.containerChild G.:= canvas]
  G.widgetShowAll window
  G.mainGUI

updateCanvas :: (G.WidgetClass w) => IORef Int -> w -> [P.Image] -> IO Bool
updateCanvas n canvas pp = do
  window <- G.widgetGetDrawWindow canvas
  k <- readIORef n
  G.renderWithDrawable window (renderImage (cycle pp !! k))
  return True