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