packages feed

simple-cairo (empty) → 0.1.0.5

raw patch · 51 files changed

+3644/−0 lines, 51 filesdep +basedep +bytestringdep +c-structsetup-changedbinary-added

Dependencies added: base, bytestring, c-struct, cairo-image, exception-hierarchy, primitive, simple-cairo, stm, template-haskell, text, union-angle, union-color, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for simple-cairo++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Yoshikuni Jujo (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yoshikuni Jujo nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# simple-cairo
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data/HaskellLogo.png view

binary file changed (absent → 4323 bytes)

+ simple-cairo.cabal view
@@ -0,0 +1,169 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7c3e571101f6a187c78f2a538fd77a1ce529acc5dc775036e798b6c186a1c8bc++name:           simple-cairo+version:        0.1.0.5+synopsis:       Binding to Cairo library+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/simple-cairo#readme>+category:       Graphics+homepage:       https://github.com/YoshikuniJujo/simple-cairo#readme+bug-reports:    https://github.com/YoshikuniJujo/simple-cairo/issues+author:         Yoshikuni Jujo+maintainer:     PAF01143@nifty.ne.jp+copyright:      Yoshikuni Jujo+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+data-files:+    HaskellLogo.png+data-dir:       data++source-repository head+  type: git+  location: https://github.com/YoshikuniJujo/simple-cairo++library+  exposed-modules:+      Data.CairoContext+      Graphics.Cairo.Drawing.CairoPatternT+      Graphics.Cairo.Drawing.CairoPatternT.Basic+      Graphics.Cairo.Drawing.CairoPatternT.Mesh+      Graphics.Cairo.Drawing.CairoPatternT.Setting+      Graphics.Cairo.Drawing.CairoT+      Graphics.Cairo.Drawing.CairoT.Basic+      Graphics.Cairo.Drawing.CairoT.CairoOperatorT+      Graphics.Cairo.Drawing.CairoT.Clip+      Graphics.Cairo.Drawing.CairoT.Page+      Graphics.Cairo.Drawing.CairoT.SaveAndRestore+      Graphics.Cairo.Drawing.CairoT.Setting+      Graphics.Cairo.Drawing.Extents+      Graphics.Cairo.Drawing.Paths+      Graphics.Cairo.Drawing.Paths.Basic+      Graphics.Cairo.Drawing.Paths.CairoPathT+      Graphics.Cairo.Drawing.Paths.CopyAppend+      Graphics.Cairo.Drawing.Paths.Relative+      Graphics.Cairo.Drawing.Regions+      Graphics.Cairo.Drawing.TagsAndLinks+      Graphics.Cairo.Drawing.Text+      Graphics.Cairo.Drawing.Transformations+      Graphics.Cairo.Exception+      Graphics.Cairo.Surfaces.CairoSurfaceT+      Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+      Graphics.Cairo.Surfaces.CairoSurfaceTypeT+      Graphics.Cairo.Surfaces.CairoSurfaceTypeT.Template+      Graphics.Cairo.Surfaces.CairoWriteFuncT+      Graphics.Cairo.Surfaces.ImageSurfaces+      Graphics.Cairo.Surfaces.PdfSurfaces+      Graphics.Cairo.Surfaces.PdfSurfaces.Template+      Graphics.Cairo.Surfaces.PngSupport+      Graphics.Cairo.Surfaces.SvgSurfaces+      Graphics.Cairo.Surfaces.SvgSurfaces.Template+      Graphics.Cairo.Template+      Graphics.Cairo.Types+      Graphics.Cairo.Utilities.CairoMatrixT+      Graphics.Cairo.Utilities.CairoMatrixT.Internal+      Graphics.Cairo.Utilities.Types+      Graphics.Cairo.Values+  other-modules:+      Paths_simple_cairo+  hs-source-dirs:+      src+  pkgconfig-depends:+      cairo+  build-depends:+      base >=4.7 && <5+    , bytestring+    , c-struct+    , cairo-image+    , exception-hierarchy+    , primitive+    , stm+    , template-haskell+    , text+    , union-angle+    , union-color+    , vector+  default-language: Haskell2010++test-suite cairo-image-test+  type: exitcode-stdio-1.0+  main-is: cairo-image-test.hs+  other-modules:+      Title+      Paths_simple_cairo+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , c-struct+    , cairo-image+    , exception-hierarchy+    , primitive+    , simple-cairo+    , stm+    , template-haskell+    , text+    , union-angle+    , union-color+    , vector+  default-language: Haskell2010++test-suite exception-test+  type: exitcode-stdio-1.0+  main-is: exception.hs+  other-modules:+      Title+      Paths_simple_cairo+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , c-struct+    , cairo-image+    , exception-hierarchy+    , primitive+    , simple-cairo+    , stm+    , template-haskell+    , text+    , union-angle+    , union-color+    , vector+  default-language: Haskell2010++test-suite test-rotate+  type: exitcode-stdio-1.0+  main-is: test-rotate.hs+  other-modules:+      Title+      Paths_simple_cairo+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , c-struct+    , cairo-image+    , exception-hierarchy+    , primitive+    , simple-cairo+    , stm+    , template-haskell+    , text+    , union-angle+    , union-color+    , vector+  default-language: Haskell2010
+ src/Data/CairoContext.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.CairoContext where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Primitive++newtype CairoT r s = CairoT (ForeignPtr (CairoT r s)) deriving Show++type CairoTIO r = CairoT r RealWorld++withCairoT :: PrimMonad m => CairoT r (PrimState m) -> (Ptr (CairoT r (PrimState m)) -> IO a) -> m a+withCairoT (CairoT fcr) = unsafeIOToPrim . withForeignPtr fcr
+ src/Graphics/Cairo/Drawing/CairoPatternT.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoPatternT (+	cairoPatternAddColorStopRgb, cairoPatternAddColorStopRgba,+	cairoPatternCreateLinear, cairoPatternCreateRadial,+	cairoPatternCreateForSurface+	) where++import Graphics.Cairo.Drawing.CairoPatternT.Basic
+ src/Graphics/Cairo/Drawing/CairoPatternT/Basic.hsc view
@@ -0,0 +1,304 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoPatternT.Basic where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad.Primitive+import Data.Traversable+import Data.Maybe+import Data.Word+import Data.Color+import System.IO.Unsafe++import Graphics.Cairo.Exception+import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal++#include <cairo.h>++class IsCairoPatternT pt where toCairoPatternT :: pt s -> CairoPatternT s++newtype CairoPatternT s = CairoPatternT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternT where toCairoPatternT = id++makeCairoPatternT :: Ptr (CairoPatternT s) -> IO (CairoPatternT s)+makeCairoPatternT p = CairoPatternT <$> newForeignPtr p (c_cairo_pattern_destroy p)++returnCairoPatternT :: PrimMonad m => IO (Ptr (CairoPatternT (PrimState m))) -> m (CairoPatternT (PrimState m))+returnCairoPatternT io = unsafeIOToPrim $ makeCairoPatternT =<< io++foreign import ccall "cairo_pattern_destroy" c_cairo_pattern_destroy ::+	Ptr (CairoPatternT s) -> IO ()++newtype CairoPatternTypeT = CairoPatternTypeT #{type cairo_pattern_type_t} deriving Show++pattern CairoPatternTypeSolid :: CairoPatternTypeT+pattern CairoPatternTypeSolid <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_SOLID} where+	CairoPatternTypeSolid = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_SOLID}++pattern CairoPatternTypeSurface :: CairoPatternTypeT+pattern CairoPatternTypeSurface <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_SURFACE} where+	CairoPatternTypeSurface = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_SURFACE}++pattern CairoPatternTypeLinear :: CairoPatternTypeT+pattern CairoPatternTypeLinear <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_LINEAR} where+	CairoPatternTypeLinear = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_LINEAR}++pattern CairoPatternTypeRadial :: CairoPatternTypeT+pattern CairoPatternTypeRadial <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_RADIAL} where+	CairoPatternTypeRadial = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_RADIAL}++pattern CairoPatternTypeMesh :: CairoPatternTypeT+pattern CairoPatternTypeMesh <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_MESH} where+	CairoPatternTypeMesh = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_MESH}++pattern CairoPatternTypeRasterSource :: CairoPatternTypeT+pattern CairoPatternTypeRasterSource <- CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_RASTER_SOURCE} where+	CairoPatternTypeRasterSource = CairoPatternTypeT #{const CAIRO_PATTERN_TYPE_RASTER_SOURCE}++cairoPatternGetType :: CairoPatternT s -> CairoPatternTypeT+cairoPatternGetType (CairoPatternT fpt) = unsafePerformIO $ withForeignPtr fpt \pt ->+	CairoPatternTypeT <$> c_cairo_pattern_get_type pt++foreign import ccall "cairo_pattern_get_type" c_cairo_pattern_get_type ::+	Ptr (CairoPatternT s) -> IO #{type cairo_pattern_type_t}++newtype CairoPatternSolidT s = CairoPatternSolidT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternSolidT where toCairoPatternT = CairoPatternTSolid++pattern CairoPatternTSolid :: CairoPatternSolidT s -> CairoPatternT s+pattern CairoPatternTSolid pts <- (cairoPatternSolidT -> Just pts) where+	CairoPatternTSolid (CairoPatternSolidT pts) = CairoPatternT pts++cairoPatternSolidT :: CairoPatternT s -> Maybe (CairoPatternSolidT s)+cairoPatternSolidT pt@(CairoPatternT fpt) = case cairoPatternGetType pt of+	CairoPatternTypeSolid -> Just $ CairoPatternSolidT fpt+	_ -> Nothing++cairoPatternCreateRgb :: PrimMonad m => Rgb CDouble -> m (CairoPatternSolidT (PrimState m))+cairoPatternCreateRgb (RgbDouble r g b) = unsafeIOToPrim do+	ppt <- c_cairo_pattern_create_rgb r g b+	pt <- CairoPatternSolidT <$> newForeignPtr ppt (c_cairo_pattern_destroy ppt)+	pt <$ raiseIfErrorPattern (CairoPatternTSolid pt)++foreign import ccall "cairo_pattern_create_rgb" c_cairo_pattern_create_rgb ::+	CDouble -> CDouble -> CDouble -> IO (Ptr (CairoPatternT s))++cairoPatternCreateRgba :: PrimMonad m => Rgba CDouble -> m (CairoPatternSolidT (PrimState m))+cairoPatternCreateRgba (RgbaDouble r g b a) = unsafeIOToPrim do+	ppt <- c_cairo_pattern_create_rgba r g b a+	pt <- CairoPatternSolidT <$> newForeignPtr ppt (c_cairo_pattern_destroy ppt)+	pt <$ raiseIfErrorPattern (CairoPatternTSolid pt)++foreign import ccall "cairo_pattern_create_rgba" c_cairo_pattern_create_rgba ::+	CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr (CairoPatternT s))++cairoPatternGetRgba :: PrimMonad m => CairoPatternSolidT (PrimState m) -> m (Rgba CDouble)+cairoPatternGetRgba (CairoPatternSolidT fpts) = unsafeIOToPrim $ withForeignPtr fpts \pts ->+	alloca \r -> alloca \g -> alloca \b -> alloca \a -> do+		cairoStatusToThrowError =<< c_cairo_pattern_get_rgba pts r g b a+		rgbaDouble <$> peek r <*> peek g <*> peek b <*> peek a >>= \case+			Just rgba -> pure rgba+			Nothing -> error $ "(r, g, b, a) = " ++ show (r, g, b, a)++foreign import ccall "cairo_pattern_get_rgba" c_cairo_pattern_get_rgba ::+	Ptr (CairoPatternT s) ->+	Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble ->+	IO #{type cairo_status_t}++class IsCairoPatternT pt => IsCairoPatternGradientT pt where+	toCairoPatternGradientT :: pt s -> CairoPatternGradientT s++newtype CairoPatternGradientT s = CairoPatternGradientT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternGradientT where+	toCairoPatternT = CairoPatternTGradient++instance IsCairoPatternGradientT CairoPatternGradientT where+	toCairoPatternGradientT = id++pattern CairoPatternTGradient :: CairoPatternGradientT s -> CairoPatternT s+pattern CairoPatternTGradient ptg <- (cairoPatternGradientT -> Just ptg) where+	CairoPatternTGradient (CairoPatternGradientT ptg) = CairoPatternT ptg++cairoPatternGradientT :: CairoPatternT s -> Maybe (CairoPatternGradientT s)+cairoPatternGradientT pt@(CairoPatternT fpt) = case cairoPatternGetType pt of+	CairoPatternTypeLinear -> Just $ CairoPatternGradientT fpt+	CairoPatternTypeRadial -> Just $ CairoPatternGradientT fpt+	_ -> Nothing++cairoPatternAddColorStopRgb :: (PrimMonad m, IsCairoPatternGradientT pt) =>+	pt (PrimState m) -> CDouble -> Rgb CDouble -> m ()+cairoPatternAddColorStopRgb (toCairoPatternGradientT -> CairoPatternGradientT fpt) os (RgbDouble r g b) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> c_cairo_pattern_add_color_stop_rgb ppt os r g b++foreign import ccall "cairo_pattern_add_color_stop_rgb" c_cairo_pattern_add_color_stop_rgb ::+	Ptr (CairoPatternT s) -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoPatternAddColorStopRgba :: (PrimMonad m, IsCairoPatternGradientT pt) =>+	pt (PrimState m) -> CDouble -> Rgba CDouble -> m ()+cairoPatternAddColorStopRgba (toCairoPatternGradientT -> CairoPatternGradientT fpt) os (RgbaDouble r g b a) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> c_cairo_pattern_add_color_stop_rgba ppt os r g b a++foreign import ccall "cairo_pattern_add_color_stop_rgba" c_cairo_pattern_add_color_stop_rgba ::+	Ptr (CairoPatternT s) -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++newtype CairoPatternLinearT s = CairoPatternLinearT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternGradientT CairoPatternLinearT where+	toCairoPatternGradientT = CairoPatternGradientTLinear++instance IsCairoPatternT CairoPatternLinearT where+	toCairoPatternT = CairoPatternTGradient . toCairoPatternGradientT++pattern CairoPatternGradientTLinear :: CairoPatternLinearT s -> CairoPatternGradientT s+pattern CairoPatternGradientTLinear ptl <- (cairoPatternGradientLinearT -> Just ptl) where+	CairoPatternGradientTLinear (CairoPatternLinearT ptl) = CairoPatternGradientT ptl++cairoPatternGradientLinearT :: CairoPatternGradientT s -> Maybe (CairoPatternLinearT s)+cairoPatternGradientLinearT pt@(CairoPatternGradientT fpt) = case cairoPatternGetType $ CairoPatternTGradient pt of+	CairoPatternTypeLinear -> Just $ CairoPatternLinearT fpt+	_ -> Nothing++cairoPatternCreateLinear :: PrimMonad m =>+	CDouble -> CDouble -> CDouble -> CDouble -> m (CairoPatternLinearT (PrimState m))+cairoPatternCreateLinear x0 y0 x1 y1 = unsafeIOToPrim+	$ CairoPatternLinearT <$> do+		p <- c_cairo_pattern_create_linear x0 y0 x1 y1+		newForeignPtr p $ c_cairo_pattern_destroy p++foreign import ccall "cairo_pattern_create_linear" c_cairo_pattern_create_linear ::+	CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr (CairoPatternT s))++cairoPatternGetLinearPoints :: PrimMonad m =>+	CairoPatternLinearT (PrimState m) -> m ((CDouble, CDouble), (CDouble, CDouble))+cairoPatternGetLinearPoints (CairoPatternLinearT fpt) = unsafeIOToPrim+	$ withForeignPtr fpt \ppt -> alloca \x0 -> alloca \y0 -> alloca \x1 -> alloca \y1 -> do+		cs <- c_cairo_pattern_get_linear_points ppt x0 y0 x1 y1+		cairoStatusToThrowError cs+		(,) <$> ((,) <$> peek x0 <*> peek y0) <*> ((,) <$> peek x1 <*> peek y1)++foreign import ccall "cairo_pattern_get_linear_points" c_cairo_pattern_get_linear_points ::+	Ptr (CairoPatternT s) -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO #{type cairo_status_t}++cairoPatternGetColorStopRgbaList :: (PrimMonad m, IsCairoPatternGradientT pt) =>+	pt (PrimState m) -> m [(CDouble, Rgba CDouble)]+cairoPatternGetColorStopRgbaList pt = cairoPatternGetColorStopCount pt >>= \n ->+	for [0 .. n - 1] \i -> cairoPatternGetColorStopRgba pt i++cairoPatternGetColorStopCount :: (PrimMonad m, IsCairoPatternGradientT pt) =>+	pt (PrimState m) -> m CInt+cairoPatternGetColorStopCount (toCairoPatternGradientT -> CairoPatternGradientT fpt) = unsafeIOToPrim+	$ withForeignPtr fpt \ppt -> alloca \n -> do+		cs <- c_cairo_pattern_get_color_stop_count ppt n+		cairoStatusToThrowError cs+		peek n++foreign import ccall "cairo_pattern_get_color_stop_count" c_cairo_pattern_get_color_stop_count ::+	Ptr (CairoPatternT s) -> Ptr CInt -> IO #{type cairo_status_t}++cairoPatternGetColorStopRgba :: (PrimMonad m, IsCairoPatternGradientT pt) =>+	pt (PrimState m) -> CInt -> m (CDouble, Rgba CDouble)+cairoPatternGetColorStopRgba (toCairoPatternGradientT -> CairoPatternGradientT fpt) i = unsafeIOToPrim+	$ withForeignPtr fpt \ppt -> alloca \os -> alloca \rd -> alloca \gr -> alloca \bl -> alloca \al -> do+		cs <- c_cairo_pattern_get_color_stop_rgba ppt i os rd gr bl al+		cairoStatusToThrowError cs+		(,) <$> peek os <*> ((\r g b a -> fromJust $ rgbaDouble r g b a) <$> peek rd <*> peek gr <*> peek bl <*> peek al)++foreign import ccall "cairo_pattern_get_color_stop_rgba" c_cairo_pattern_get_color_stop_rgba ::+	Ptr (CairoPatternT s) -> CInt ->+	Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO #{type cairo_status_t}++newtype CairoPatternRadialT s = CairoPatternRadialT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternRadialT where+	toCairoPatternT = CairoPatternTGradient . toCairoPatternGradientT++instance IsCairoPatternGradientT CairoPatternRadialT where+	toCairoPatternGradientT = CairoPatternGradientTRadial++pattern CairoPatternGradientTRadial :: CairoPatternRadialT s -> CairoPatternGradientT s+pattern CairoPatternGradientTRadial pt <- (cairoPatternGradientRadialT -> Just pt) where+	CairoPatternGradientTRadial (CairoPatternRadialT fpt) = CairoPatternGradientT fpt++cairoPatternGradientRadialT :: CairoPatternGradientT s -> Maybe (CairoPatternRadialT s)+cairoPatternGradientRadialT pt@(CairoPatternGradientT fpt) = case cairoPatternGetType $ CairoPatternTGradient pt of+	CairoPatternTypeRadial -> Just $ CairoPatternRadialT fpt+	_ -> Nothing++cairoPatternCreateRadial :: PrimMonad m =>+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble ->+	m (CairoPatternRadialT (PrimState m))+cairoPatternCreateRadial cx0 cy0 r0 cx1 cy1 r1 = unsafeIOToPrim+	$ CairoPatternRadialT <$> do+		p <- c_cairo_pattern_create_radial cx0 cy0 r0 cx1 cy1 r1+		newForeignPtr p $ c_cairo_pattern_destroy p++foreign import ccall "cairo_pattern_create_radial" c_cairo_pattern_create_radial ::+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr (CairoPatternT s))++cairoPatternGetRadialCircles :: PrimMonad m =>+	CairoPatternRadialT (PrimState m) -> m ((CDouble, CDouble, CDouble), (CDouble, CDouble, CDouble))+cairoPatternGetRadialCircles (CairoPatternRadialT fpt) = unsafeIOToPrim+	$ withForeignPtr fpt \ppt -> alloca \x0 -> alloca \y0 -> alloca \r0 -> alloca \x1 -> alloca \y1 -> alloca \r1 -> do+		cs <- c_cairo_pattern_get_radial_circles ppt x0 y0 r0 x1 y1 r1+		cairoStatusToThrowError cs+		(,) <$> ((,,) <$> peek x0 <*> peek y0 <*> peek r0) <*> ((,,) <$> peek x1 <*> peek y1 <*> peek r1)++foreign import ccall "cairo_pattern_get_radial_circles" c_cairo_pattern_get_radial_circles ::+	Ptr (CairoPatternT s) ->+	Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO #{type cairo_status_t}++newtype CairoPatternSurfaceT s = CairoPatternSurfaceT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternSurfaceT where+	toCairoPatternT = CairoPatternTSurface++pattern CairoPatternTSurface :: CairoPatternSurfaceT s -> CairoPatternT s+pattern CairoPatternTSurface pt <- (cairoPatternTSurface -> Just pt) where+	CairoPatternTSurface (CairoPatternSurfaceT fpt) = CairoPatternT fpt++cairoPatternTSurface :: CairoPatternT s -> Maybe (CairoPatternSurfaceT s)+cairoPatternTSurface pt@(CairoPatternT fpt) = case cairoPatternGetType pt of+	CairoPatternTypeSurface -> Just $ CairoPatternSurfaceT fpt+	_ -> Nothing++cairoPatternCreateForSurface :: (PrimMonad m, IsCairoSurfaceT sr) =>+	sr s (PrimState m) -> m (CairoPatternSurfaceT (PrimState m))+cairoPatternCreateForSurface (toCairoSurfaceT -> CairoSurfaceT fs) =+	unsafeIOToPrim $ CairoPatternSurfaceT <$> withForeignPtr fs \ps -> do+		p <- c_cairo_pattern_create_for_surface ps+		newForeignPtr p $ touchForeignPtr fs >> c_cairo_pattern_destroy p++foreign import ccall "cairo_pattern_create_for_surface" c_cairo_pattern_create_for_surface ::+	Ptr (CairoSurfaceT s ps) -> IO (Ptr (CairoPatternT ps))++cairoPatternGetSurface :: PrimMonad m =>+	CairoPatternSurfaceT (PrimState m) -> m (CairoSurfaceT s (PrimState m))+cairoPatternGetSurface (CairoPatternSurfaceT fpt) =+	unsafeIOToPrim $ CairoSurfaceT <$> withForeignPtr fpt \ppt -> alloca \pps -> do+		cairoStatusToThrowError =<< c_cairo_pattern_get_surface ppt pps+		p <- c_cairo_surface_reference =<< peek pps+		newForeignPtr p $ c_cairo_surface_destroy p++foreign import ccall "cairo_pattern_get_surface" c_cairo_pattern_get_surface ::+	Ptr (CairoPatternT ps) -> Ptr (Ptr (CairoSurfaceT s ps)) -> IO #{type cairo_status_t}++foreign import ccall "cairo_surface_reference" c_cairo_surface_reference ::+	Ptr (CairoSurfaceT s ps) -> IO (Ptr (CairoSurfaceT s ps))++raiseIfErrorPattern :: CairoPatternT s -> IO ()+raiseIfErrorPattern (CairoPatternT fpt) = withForeignPtr fpt \pt ->+	cairoStatusToThrowError =<< c_cairo_pattern_status pt++foreign import ccall "cairo_pattern_status" c_cairo_pattern_status ::+	Ptr (CairoPatternT s) -> IO #{type cairo_status_t}
+ src/Graphics/Cairo/Drawing/CairoPatternT/Mesh.hsc view
@@ -0,0 +1,216 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoPatternT.Mesh where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad+import Control.Monad.Primitive+import Data.Word+import Data.Maybe+import Data.Color++import Graphics.Cairo.Exception+import Graphics.Cairo.Drawing.Paths.CairoPathT++#include <cairo.h>++import Graphics.Cairo.Drawing.CairoPatternT.Basic++newtype CairoPatternMeshT s = CairoPatternMeshT (ForeignPtr (CairoPatternT s)) deriving Show++instance IsCairoPatternT CairoPatternMeshT where+	toCairoPatternT = CairoPatternTMesh++pattern CairoPatternTMesh :: CairoPatternMeshT s -> CairoPatternT s+pattern CairoPatternTMesh pt <- (cairoPatternMeshT -> Just pt) where+	CairoPatternTMesh (CairoPatternMeshT fpt) = CairoPatternT fpt++cairoPatternMeshT :: CairoPatternT s -> Maybe (CairoPatternMeshT s)+cairoPatternMeshT pt@(CairoPatternT fpt) = case cairoPatternGetType pt of+	CairoPatternTypeMesh -> Just $ CairoPatternMeshT fpt+	_ -> Nothing++cairoPatternCreateMesh :: PrimMonad m => m (CairoPatternMeshT (PrimState m))+cairoPatternCreateMesh = unsafeIOToPrim do+	p <- c_cairo_pattern_create_mesh+	CairoPatternMeshT <$> newForeignPtr p (c_cairo_pattern_destroy p)++foreign import ccall "cairo_pattern_create_mesh" c_cairo_pattern_create_mesh ::+	IO (Ptr (CairoPatternT s))++data Color = ColorRgb (Rgb CDouble) | ColorRgba (Rgba CDouble) deriving Show++data Point = Point CDouble CDouble deriving Show++cairoMeshPatternAddPatchDefaultControlPoints3 :: PrimMonad m => CairoPatternMeshT (PrimState m) ->+	MoveTo -> LineCurveTo -> LineCurveTo -> CloseTo ->+	Color -> Color -> Color -> m ()+cairoMeshPatternAddPatchDefaultControlPoints3 pt mv lc1 lc2 cls c0 c1 c2 = do+	cairoMeshPatternBeginPatch pt+	cairoMeshPatternMoveTo pt mv+	cairoMeshPatternLineTo pt `mapM_` [lc1, lc2]+	cairoMeshPatternCloseTo pt mv cls+	zipWithM_ (cairoMeshPatternSetCornerColor pt) [0 ..] [c0, c1, c2]+	cairoMeshPatternEndPatch pt++cairoMeshPatternAddPatchDefaultControlPoints :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) ->+	MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo ->+	Color -> Color -> Color -> Color -> m ()+cairoMeshPatternAddPatchDefaultControlPoints pt mv lc1 lc2 lc3 cls c0 c1 c2 c3 = do+	cairoMeshPatternBeginPatch pt+	cairoMeshPatternMoveTo pt mv+	cairoMeshPatternLineTo pt `mapM_` [lc1, lc2, lc3]+	cairoMeshPatternCloseTo pt mv cls+	zipWithM_ (cairoMeshPatternSetCornerColor pt) [0 ..] [c0, c1, c2, c3]+	cairoMeshPatternEndPatch pt++cairoMeshPatternAddPatch :: PrimMonad m => CairoPatternMeshT (PrimState m) ->+	MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo ->+	Color -> Color -> Color -> Color ->+	Maybe Point -> Maybe Point -> Maybe Point -> Maybe Point -> m ()+cairoMeshPatternAddPatch pt mv lc1 lc2 lc3 cls c0 c1 c2 c3 cp0 cp1 cp2 cp3 = do+	cairoMeshPatternBeginPatch pt+	cairoMeshPatternMoveTo pt mv+	cairoMeshPatternLineTo pt `mapM_` [lc1, lc2, lc3]+	cairoMeshPatternCloseTo pt mv cls+	zipWithM_ (cairoMeshPatternSetCornerColor pt) [0 ..] [c0, c1, c2, c3]+	zipWithM_ (cairoMeshPatternSetControlPointMaybe pt) [0 ..] [cp0, cp1, cp2, cp3]+	cairoMeshPatternEndPatch pt++cairoMeshPatternBeginPatch :: PrimMonad m => CairoPatternMeshT (PrimState m) -> m ()+cairoMeshPatternBeginPatch (CairoPatternMeshT fpt) = unsafeIOToPrim +	$ withForeignPtr fpt c_cairo_mesh_pattern_begin_patch++foreign import ccall "cairo_mesh_pattern_begin_patch" c_cairo_mesh_pattern_begin_patch ::+	Ptr (CairoPatternT s) -> IO ()++cairoMeshPatternEndPatch :: PrimMonad m => CairoPatternMeshT (PrimState m) -> m ()+cairoMeshPatternEndPatch (CairoPatternMeshT fpt) = unsafeIOToPrim+	$ withForeignPtr fpt c_cairo_mesh_pattern_end_patch++foreign import ccall "cairo_mesh_pattern_end_patch" c_cairo_mesh_pattern_end_patch ::+	Ptr (CairoPatternT s) -> IO ()++cairoMeshPatternMoveTo :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> MoveTo -> m ()+cairoMeshPatternMoveTo (CairoPatternMeshT fpt) (MoveTo x y) = unsafeIOToPrim+	$ withForeignPtr fpt \ppt -> c_cairo_mesh_pattern_move_to ppt x y++foreign import ccall "cairo_mesh_pattern_move_to" c_cairo_mesh_pattern_move_to ::+	Ptr (CairoPatternT s) -> CDouble -> CDouble -> IO ()++cairoMeshPatternLineTo :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> LineCurveTo -> m ()+cairoMeshPatternLineTo (CairoPatternMeshT fpt) = \case+	LineTo x y -> unsafeIOToPrim+		$ withForeignPtr fpt \ppt -> c_cairo_mesh_pattern_line_to ppt x y+	CurveTo x1  y1 x2 y2 x3 y3 -> unsafeIOToPrim+		$ withForeignPtr fpt \ppt -> c_cairo_mesh_pattern_curve_to ppt x1 y1 x2 y2 x3 y3++cairoMeshPatternCloseTo :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> MoveTo -> CloseTo -> m ()+cairoMeshPatternCloseTo (CairoPatternMeshT fpt) (MoveTo x0 y0) cls =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> case cls of+		CloseLineTo -> pure ()+		CloseCurveTo x1 y1 x2 y2 -> c_cairo_mesh_pattern_curve_to ppt x1 y1 x2 y2 x0 y0++foreign import ccall "cairo_mesh_pattern_line_to" c_cairo_mesh_pattern_line_to ::+	Ptr (CairoPatternT s) -> CDouble -> CDouble -> IO ()++foreign import ccall "cairo_mesh_pattern_curve_to" c_cairo_mesh_pattern_curve_to ::+	Ptr (CairoPatternT s) ->+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoMeshPatternSetControlPointMaybe :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> CUInt -> Maybe Point -> m ()+cairoMeshPatternSetControlPointMaybe (CairoPatternMeshT fpt) i = \case+	Nothing -> pure ()+	Just (Point x y) -> unsafeIOToPrim+		$ withForeignPtr fpt \ppt -> c_cairo_mesh_pattern_set_control_point ppt i x y++foreign import ccall "cairo_mesh_pattern_set_control_point" c_cairo_mesh_pattern_set_control_point ::+	Ptr (CairoPatternT s) -> CUInt -> CDouble -> CDouble -> IO ()++cairoMeshPatternSetCornerColor :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> CUInt -> Color -> m ()+cairoMeshPatternSetCornerColor (CairoPatternMeshT fpt) i c =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> case c of+		ColorRgb (RgbDouble r g b) -> c_cairo_mesh_pattern_set_corner_color_rgb ppt i r g b+		ColorRgba (RgbaDouble r g b a) -> c_cairo_mesh_pattern_set_corner_color_rgba ppt i r g b a++foreign import ccall "cairo_mesh_pattern_set_corner_color_rgb" c_cairo_mesh_pattern_set_corner_color_rgb ::+	Ptr (CairoPatternT s) -> CUInt -> CDouble -> CDouble -> CDouble -> IO ()++foreign import ccall "cairo_mesh_pattern_set_corner_color_rgba" c_cairo_mesh_pattern_set_corner_color_rgba ::+	Ptr (CairoPatternT s) -> CUInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoMeshPatternGetPatchCount :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> m CUInt+cairoMeshPatternGetPatchCount (CairoPatternMeshT fpt) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> alloca \cnt -> do+		cairoStatusToThrowError =<< c_cairo_mesh_pattern_get_patch_count ppt cnt+		peek cnt++foreign import ccall "cairo_mesh_pattern_get_patch_count" c_cairo_mesh_pattern_get_patch_count ::+	Ptr (CairoPatternT s) -> Ptr CUInt -> IO #{type cairo_status_t}++cairoMeshPatternGetPath :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> CUInt -> m CairoPatchPathT+cairoMeshPatternGetPath (CairoPatternMeshT fpt) i =+	unsafeIOToPrim $ withForeignPtr fpt \ppt ->+		mkCairoPatchPathT =<< c_cairo_mesh_pattern_get_path ppt i++foreign import ccall "cairo_mesh_pattern_get_path" c_cairo_mesh_pattern_get_path ::+	Ptr (CairoPatternT s) -> CUInt -> IO (Ptr CairoPathT)++cairoMeshPatternGetControlPoint :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> CUInt -> CUInt -> m Point+cairoMeshPatternGetControlPoint (CairoPatternMeshT fpt) i j =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> alloca \x -> alloca \y -> do+		cairoStatusToThrowError =<< c_cairo_mesh_pattern_get_control_point ppt i j x y+		Point <$> peek x <*> peek y++foreign import ccall "cairo_mesh_pattern_get_control_point" c_cairo_mesh_pattern_get_control_point ::+	Ptr (CairoPatternT s) -> CUInt -> CUInt -> Ptr CDouble -> Ptr CDouble -> IO #{type cairo_status_t}++cairoMeshPatternGetCornerColorRgba :: PrimMonad m =>+	CairoPatternMeshT (PrimState m) -> CUInt -> CUInt -> m (Rgba CDouble)+cairoMeshPatternGetCornerColorRgba (CairoPatternMeshT fpt) i j =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> alloca \r -> alloca \g -> alloca \b -> alloca \a -> do+		cairoStatusToThrowError =<< c_cairo_mesh_pattern_get_corner_color_rgba ppt i j r g b a+		fromJust <$> (rgbaDouble <$> peek r <*> peek g <*> peek b <*> peek a)++foreign import ccall "cairo_mesh_pattern_get_corner_color_rgba" c_cairo_mesh_pattern_get_corner_color_rgba ::+	Ptr (CairoPatternT s) -> CUInt -> CUInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO #{type cairo_status_t}++cairoMeshPatternGetPatch1 :: PrimBase m => CairoPatternMeshT (PrimState m) -> CUInt ->+	m (CairoPatchPathT, (Rgba CDouble, Rgba CDouble, Rgba CDouble, Rgba CDouble), (Point, Point, Point, Point))+cairoMeshPatternGetPatch1 pt i = do+	pth <- unsafeInterleave $ cairoMeshPatternGetPath pt i+	(unsafeInterleave . cairoMeshPatternGetCornerColorRgba pt i) `mapM` [0, 1, 2, 3] >>= \case+		[c0, c1, c2, c3] ->+			(unsafeInterleave . cairoMeshPatternGetControlPoint pt i) `mapMLazy` [0, 1, 2, 3] >>= \case+				[p0, p1, p2, p3] -> pure (pth, (c0, c1, c2, c3), (p0, p1, p2, p3))+				_ -> error "never occur"+		_ -> error "never occur"++forLazy :: PrimBase m => [a] -> (a -> m b) -> m [b]+forLazy [] _ = pure []+forLazy (x : xs) f = unsafeInterleave $ (:) <$> f x <*> forLazy xs f++mapMLazy :: PrimBase m => (a -> m b) -> [a] -> m [b]+mapMLazy = flip forLazy++cairoMeshPatternGetPatchList :: PrimBase m => CairoPatternMeshT (PrimState m) ->+	m [(CairoPatchPathT, (Rgba CDouble, Rgba CDouble, Rgba CDouble, Rgba CDouble), (Point, Point, Point, Point))]+cairoMeshPatternGetPatchList pt = do+	n <- cairoMeshPatternGetPatchCount pt+	forLazy [0 .. n - 1] $ unsafeInterleave . cairoMeshPatternGetPatch1 pt
+ src/Graphics/Cairo/Drawing/CairoPatternT/Setting.hsc view
@@ -0,0 +1,118 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoPatternT.Setting where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Primitive+import Data.Word+import Graphics.Cairo.Drawing.CairoPatternT.Basic+import Graphics.Cairo.Utilities.CairoMatrixT.Internal++#include <cairo.h>++class CairoPatternSetting s where+	cairoPatternSet :: (PrimMonad m, IsCairoPatternT pt) => pt (PrimState m) -> s -> m ()+	cairoPatternGet :: (PrimMonad m, IsCairoPatternT pt) => pt (PrimState m) -> m s++newtype CairoExtendT = CairoExtendT #{type cairo_extend_t} deriving Show++pattern CairoExtendNone :: CairoExtendT+pattern CairoExtendNone <- CairoExtendT #{const CAIRO_EXTEND_NONE} where+	CairoExtendNone = CairoExtendT #{const CAIRO_EXTEND_NONE}++pattern CairoExtendRepeat :: CairoExtendT+pattern CairoExtendRepeat <- CairoExtendT #{const CAIRO_EXTEND_REPEAT} where+	CairoExtendRepeat = CairoExtendT #{const CAIRO_EXTEND_REPEAT}++pattern CairoExtendReflect :: CairoExtendT+pattern CairoExtendReflect <- CairoExtendT #{const CAIRO_EXTEND_REFLECT} where+	CairoExtendReflect = CairoExtendT #{const CAIRO_EXTEND_REFLECT}++pattern CairoExtendPad :: CairoExtendT+pattern CairoExtendPad <- CairoExtendT #{const CAIRO_EXTEND_PAD} where+	CairoExtendPad = CairoExtendT #{const CAIRO_EXTEND_PAD}++instance CairoPatternSetting CairoExtendT where+	cairoPatternSet = cairoPatternSetExtend+	cairoPatternGet = cairoPatternGetExtend++cairoPatternSetExtend :: (PrimMonad m, IsCairoPatternT pt) => pt (PrimState m) -> CairoExtendT -> m ()+cairoPatternSetExtend (toCairoPatternT -> CairoPatternT fpt) (CairoExtendT ex) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> c_cairo_pattern_set_extend ppt ex++foreign import ccall "cairo_pattern_set_extend" c_cairo_pattern_set_extend ::+	Ptr (CairoPatternT s) -> #{type cairo_extend_t} -> IO ()++cairoPatternGetExtend :: (PrimMonad m, IsCairoPatternT pt) => pt (PrimState m) -> m CairoExtendT+cairoPatternGetExtend (toCairoPatternT -> CairoPatternT fpt) =+	unsafeIOToPrim $ CairoExtendT <$> withForeignPtr fpt c_cairo_pattern_get_extend++foreign import ccall "cairo_pattern_get_extend" c_cairo_pattern_get_extend ::+	Ptr (CairoPatternT s) -> IO #{type cairo_extend_t}++newtype CairoFilterT = CairoFilterT #{type cairo_filter_t} deriving Show++pattern CairoFilterFast :: CairoFilterT+pattern CairoFilterFast <- CairoFilterT #{const CAIRO_FILTER_FAST} where+	CairoFilterFast = CairoFilterT #{const CAIRO_FILTER_FAST}++pattern CairoFilterGood :: CairoFilterT+pattern CairoFilterGood <- CairoFilterT #{const CAIRO_FILTER_GOOD} where+	CairoFilterGood = CairoFilterT #{const CAIRO_FILTER_GOOD}++pattern CairoFilterBest :: CairoFilterT+pattern CairoFilterBest <- CairoFilterT #{const CAIRO_FILTER_BEST} where+	CairoFilterBest = CairoFilterT #{const CAIRO_FILTER_BEST}++pattern CairoFilterNearest :: CairoFilterT+pattern CairoFilterNearest <- CairoFilterT #{const CAIRO_FILTER_NEAREST} where+	CairoFilterNearest = CairoFilterT #{const CAIRO_FILTER_NEAREST}++pattern CairoFilterBilinear :: CairoFilterT+pattern CairoFilterBilinear <- CairoFilterT #{const CAIRO_FILTER_BILINEAR} where+	CairoFilterBilinear = CairoFilterT #{const CAIRO_FILTER_BILINEAR}++pattern CairoFilterGaussian :: CairoFilterT+pattern CairoFilterGaussian <- CairoFilterT #{const CAIRO_FILTER_GAUSSIAN} where+	CairoFilterGaussian = CairoFilterT #{const CAIRO_FILTER_GAUSSIAN}++instance CairoPatternSetting CairoFilterT where+	cairoPatternSet = cairoPatternSetFilter+	cairoPatternGet = cairoPatternGetFilter++cairoPatternSetFilter :: (PrimMonad m, IsCairoPatternT pt) =>+	pt (PrimState m) -> CairoFilterT -> m ()+cairoPatternSetFilter (toCairoPatternT -> CairoPatternT fpt) (CairoFilterT flt) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> c_cairo_pattern_set_filter ppt flt++foreign import ccall "cairo_pattern_set_filter" c_cairo_pattern_set_filter ::+	Ptr (CairoPatternT s) -> #{type cairo_filter_t} -> IO ()++cairoPatternGetFilter :: (PrimMonad m, IsCairoPatternT pt) =>+	pt (PrimState m) -> m CairoFilterT+cairoPatternGetFilter (toCairoPatternT -> CairoPatternT fpt) =+	unsafeIOToPrim $ CairoFilterT <$> withForeignPtr fpt c_cairo_pattern_get_filter++foreign import ccall "cairo_pattern_get_filter" c_cairo_pattern_get_filter ::+	Ptr (CairoPatternT s) -> IO #{type cairo_filter_t}++cairoPatternSetMatrix :: (PrimMonad m, IsCairoPatternT pt, IsCairoMatrixT mtx) =>+	pt (PrimState m) -> mtx (PrimState m) -> m ()+cairoPatternSetMatrix (toCairoPatternT -> CairoPatternT fpt) (toCairoMatrixT -> CairoMatrixT fmtx) =+	unsafeIOToPrim $ withForeignPtr fpt \ppt -> withForeignPtr fmtx \pmtx ->+		c_cairo_pattern_set_matrix ppt pmtx++foreign import ccall "cairo_pattern_set_matrix" c_cairo_pattern_set_matrix ::+	Ptr (CairoPatternT s) -> Ptr (CairoMatrixT s) -> IO ()++cairoPatternGetMatrix :: (PrimMonad m, IsCairoPatternT pt) =>+	pt (PrimState m) -> m (CairoMatrixT (PrimState m))+cairoPatternGetMatrix (toCairoPatternT -> CairoPatternT fpt) = (CairoMatrixT <$>)+	$ cairoMatrixAlloc \pmtx -> withForeignPtr fpt \ppt ->+		c_cairo_pattern_get_matrix ppt pmtx++foreign import ccall "cairo_pattern_get_matrix" c_cairo_pattern_get_matrix ::+	Ptr (CairoPatternT s) -> Ptr (CairoMatrixT s) -> IO ()
+ src/Graphics/Cairo/Drawing/CairoT.hsc view
@@ -0,0 +1,47 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT (+	-- * Basic+	cairoCreate,+	-- * Push and Pop Group+	cairoPushGroup, cairoPopGroup, cairoPopGroupToSource,+	-- * Set Source+	cairoSetSourceRgb, cairoSetSourceRgba, cairoSetSource, cairoSetSourceSurface,+	-- * Set Attribute+	cairoSetLineWidth,+	-- * Verb+	cairoFill, cairoMask, cairoPaint, cairoPaintWithAlpha,+	cairoStroke, cairoStrokePreserve, cairoStrokeExtents,+	) where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Primitive++import Graphics.Cairo.Exception++import Graphics.Cairo.Drawing.CairoT.Basic+import Graphics.Cairo.Drawing.CairoT.Setting++import Data.CairoContext++import Graphics.Cairo.Drawing.CairoPatternT.Basic++foreign import ccall "cairo_push_group" c_cairo_push_group ::+	Ptr (CairoT r s) -> IO ()++cairoPushGroup :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoPushGroup = (`withCairoT` c_cairo_push_group)++foreign import ccall "cairo_pop_group_to_source" c_cairo_pop_group_to_source ::+	Ptr (CairoT r s) -> IO ()++cairoPopGroupToSource :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoPopGroupToSource cr@(CairoT fcr) = unsafeIOToPrim $ withForeignPtr fcr c_cairo_pop_group_to_source <* raiseIfError cr++foreign import ccall "cairo_pop_group" c_cairo_pop_group ::+	Ptr (CairoT r s) -> IO (Ptr (CairoPatternT s))++cairoPopGroup :: PrimMonad m => CairoT r s -> m (CairoPatternT s)+cairoPopGroup (CairoT fcr) = unsafeIOToPrim $ makeCairoPatternT =<< withForeignPtr fcr c_cairo_pop_group
+ src/Graphics/Cairo/Drawing/CairoT/Basic.hsc view
@@ -0,0 +1,157 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.Basic (+	cairoCreate,+	cairoSetSourceRgb, cairoSetSourceRgba, cairoSetSource, cairoSetSourceSurface,+	cairoStroke, cairoStrokePreserve, cairoStrokeExtents, cairoInStroke,+	cairoFill, cairoFillPreserve, cairoFillExtents, cairoInFill,+	cairoPaint, cairoPaintWithAlpha,+	cairoMask, cairoMaskSurface,++	CairoExtents(..),+	pattern CairoExtentsLeftTopWidthHeight, cairoExtentsLeft, cairoExtentsTop, cairoExtentsWidth, cairoExtentsHeight+	) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr, addForeignPtrFinalizer)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad.Primitive+import Control.Concurrent.STM+import Data.Int++import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+import Graphics.Cairo.Exception+import Graphics.Cairo.Drawing.Extents++import Data.Color+import Data.CairoContext++import Graphics.Cairo.Drawing.CairoPatternT.Basic++#include <cairo.h>++cairoCreate :: (PrimMonad m, IsCairoSurfaceT sr) =>+	sr s (PrimState m) -> m (CairoT r (PrimState m))+cairoCreate sr_ = unsafeIOToPrim do+	cr <- withForeignPtr sr c_cairo_create >>= \pcr ->+		CairoT <$> newForeignPtr pcr (do+			atomically (readTChan =<< ck)+			putStrLn "begin CairoT destroy"+			c_cairo_destroy pcr+			putStrLn "end CairoT destroy")+	cr <$ raiseIfError cr+	where+	CairoSurfaceT sr = toCairoSurfaceT sr_+	ck = cairoSurfaceTFinishChecker sr_++foreign import ccall "cairo_create"+	c_cairo_create :: Ptr (CairoSurfaceT s ps) -> IO (Ptr (CairoT r ps))+foreign import ccall "cairo_destroy" c_cairo_destroy :: Ptr (CairoT r s) -> IO ()++cairoSetSourceRgb :: PrimMonad m => CairoT r (PrimState m) -> Rgb CDouble -> m ()+cairoSetSourceRgb cr (RgbDouble r g b) =+	withCairoT cr \pcr -> c_cairo_set_source_rgb pcr r g b++foreign import ccall "cairo_set_source_rgb" c_cairo_set_source_rgb ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> IO ()++cairoSetSourceRgba :: PrimMonad m => CairoT r (PrimState m) -> Rgba CDouble -> m ()+cairoSetSourceRgba cr (RgbaDouble r g b a) =+	withCairoT cr \pcr -> c_cairo_set_source_rgba pcr r g b a++foreign import ccall "cairo_set_source_rgba" c_cairo_set_source_rgba ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoSetSource :: (PrimMonad m, IsCairoPatternT pt) => CairoT r s -> pt s -> m ()+cairoSetSource cr@(CairoT fcr) (toCairoPatternT -> CairoPatternT fpt) = unsafeIOToPrim do+	withForeignPtr fcr \pcr -> withForeignPtr fpt \ppt -> c_cairo_set_source pcr ppt >> raiseIfError cr+	addForeignPtrFinalizer fcr $ touchForeignPtr fpt++foreign import ccall "cairo_set_source" c_cairo_set_source ::+	Ptr (CairoT r s) -> Ptr (CairoPatternT s) -> IO ()++cairoSetSourceSurface :: (PrimMonad m, IsCairoSurfaceT sr) =>+	CairoT r ps -> sr s ps -> CDouble -> CDouble -> m ()+cairoSetSourceSurface (CairoT fcr) (toCairoSurfaceT -> CairoSurfaceT fsr) x y = unsafeIOToPrim+	$ withForeignPtr fcr \cr -> withForeignPtr fsr \sr -> c_cairo_set_source_surface cr sr x y++foreign import ccall "cairo_set_source_surface" c_cairo_set_source_surface ::+	Ptr (CairoT r ps) -> Ptr (CairoSurfaceT s ps) -> CDouble -> CDouble -> IO ()++cairoStroke :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoStroke = (`withCairoT` c_cairo_stroke)++foreign import ccall "cairo_stroke" c_cairo_stroke :: Ptr (CairoT r s) -> IO ()++cairoStrokePreserve :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoStrokePreserve = (`withCairoT` c_cairo_stroke_preserve)++foreign import ccall "cairo_stroke_preserve" c_cairo_stroke_preserve :: Ptr (CairoT r s) -> IO ()++cairoStrokeExtents :: PrimMonad m => CairoT r (PrimState m) -> m CairoExtents+cairoStrokeExtents = flip withCairoT \pcr -> alloca \x1 -> alloca \y1 -> alloca \x2 -> alloca \y2 -> do+	c_cairo_stroke_extents pcr x1 y1 x2 y2+	CairoExtentsLeftTopRightBottom <$> peek x1 <*> peek y1 <*> peek x2 <*> peek y2++foreign import ccall "cairo_stroke_extents" c_cairo_stroke_extents ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoInStroke :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m Bool+cairoInStroke cr x y = withCairoT cr \pcr -> (/= 0) <$> c_cairo_in_stroke pcr x y++foreign import ccall "cairo_in_stroke" c_cairo_in_stroke ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO #{type cairo_bool_t}++cairoFill :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoFill = (`withCairoT` c_cairo_fill)++foreign import ccall "cairo_fill" c_cairo_fill :: Ptr (CairoT r s) -> IO ()++cairoFillPreserve :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoFillPreserve = (`withCairoT` c_cairo_fill_preserve)++foreign import ccall "cairo_fill_preserve" c_cairo_fill_preserve :: Ptr (CairoT r s) -> IO ()++cairoFillExtents :: PrimMonad m => CairoT r (PrimState m) -> m CairoExtents+cairoFillExtents = flip withCairoT \pcr -> alloca \x1 -> alloca \y1 -> alloca \x2 -> alloca \y2 -> do+	c_cairo_fill_extents pcr x1 y1 x2 y2+	CairoExtentsLeftTopRightBottom <$> peek x1 <*> peek y1 <*> peek x2 <*> peek y2++foreign import ccall "cairo_fill_extents" c_cairo_fill_extents ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoInFill :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m Bool+cairoInFill cr x y = withCairoT cr \pcr -> (/= 0) <$> c_cairo_in_fill pcr x y++foreign import ccall "cairo_in_fill" c_cairo_in_fill ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO #{type cairo_bool_t}++cairoPaint :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoPaint cr = withCairoT cr \pcr -> c_cairo_paint pcr >> raiseIfError cr++foreign import ccall "cairo_paint" c_cairo_paint :: Ptr (CairoT r s) -> IO ()++cairoPaintWithAlpha :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> m ()+cairoPaintWithAlpha cr a = withCairoT cr \pcr -> c_cairo_paint_with_alpha pcr a++foreign import ccall "cairo_paint_with_alpha" c_cairo_paint_with_alpha ::+	Ptr (CairoT r s) -> CDouble -> IO ()++cairoMask :: (PrimMonad m, IsCairoPatternT pt) => CairoT r s -> pt s -> m ()+cairoMask cr@(CairoT fcr) (toCairoPatternT -> CairoPatternT fpt) = unsafeIOToPrim+	$ withForeignPtr fcr \pcr -> withForeignPtr fpt (c_cairo_mask pcr) >> raiseIfError cr++foreign import ccall "cairo_mask" c_cairo_mask ::+	Ptr (CairoT r s) -> Ptr (CairoPatternT s) -> IO ()++cairoMaskSurface :: (PrimMonad m, IsCairoSurfaceT sr) => CairoT r ps -> sr s ps -> CDouble -> CDouble -> m ()+cairoMaskSurface (CairoT fcr) (toCairoSurfaceT -> CairoSurfaceT fsr) x y = unsafeIOToPrim+	$ withForeignPtr fcr \cr -> withForeignPtr fsr \sr -> c_cairo_mask_surface cr sr x y++foreign import ccall "cairo_mask_surface" c_cairo_mask_surface ::+	Ptr (CairoT r ps) -> Ptr (CairoSurfaceT s ps) -> CDouble -> CDouble -> IO ()
+ src/Graphics/Cairo/Drawing/CairoT/CairoOperatorT.hsc view
@@ -0,0 +1,126 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.CairoOperatorT where++import Data.Word++#include <cairo.h>++newtype Operator = Operator #{type cairo_operator_t} deriving Show++pattern OperatorClear :: Operator+pattern OperatorClear <- Operator #{const CAIRO_OPERATOR_CLEAR} where+	OperatorClear = Operator #{const CAIRO_OPERATOR_CLEAR}++pattern OperatorSource :: Operator+pattern OperatorSource <- Operator #{const CAIRO_OPERATOR_SOURCE} where+	OperatorSource = Operator #{const CAIRO_OPERATOR_SOURCE}++pattern OperatorOver :: Operator+pattern OperatorOver <- Operator #{const CAIRO_OPERATOR_OVER} where+	OperatorOver = Operator #{const CAIRO_OPERATOR_OVER}++pattern OperatorIn :: Operator+pattern OperatorIn <- Operator #{const CAIRO_OPERATOR_IN} where+	OperatorIn = Operator #{const CAIRO_OPERATOR_IN}++pattern OperatorOut :: Operator+pattern OperatorOut <- Operator #{const CAIRO_OPERATOR_OUT} where+	OperatorOut = Operator #{const CAIRO_OPERATOR_OUT}++pattern OperatorAtop :: Operator+pattern OperatorAtop <- Operator #{const CAIRO_OPERATOR_ATOP} where+	OperatorAtop = Operator #{const CAIRO_OPERATOR_ATOP}++pattern OperatorDest :: Operator+pattern OperatorDest <- Operator #{const CAIRO_OPERATOR_DEST} where+	OperatorDest = Operator #{const CAIRO_OPERATOR_DEST}++pattern OperatorDestOver :: Operator+pattern OperatorDestOver <- Operator #{const CAIRO_OPERATOR_DEST_OVER} where+	OperatorDestOver = Operator #{const CAIRO_OPERATOR_DEST_OVER}++pattern OperatorDestIn :: Operator+pattern OperatorDestIn <- Operator #{const CAIRO_OPERATOR_DEST_IN} where+	OperatorDestIn = Operator #{const CAIRO_OPERATOR_DEST_IN}++pattern OperatorDestOut :: Operator+pattern OperatorDestOut <- Operator #{const CAIRO_OPERATOR_DEST_OUT} where+	OperatorDestOut = Operator #{const CAIRO_OPERATOR_DEST_OUT}++pattern OperatorDestAtop :: Operator+pattern OperatorDestAtop <- Operator #{const CAIRO_OPERATOR_DEST_ATOP} where+	OperatorDestAtop = Operator #{const CAIRO_OPERATOR_DEST_ATOP}++pattern OperatorXor :: Operator+pattern OperatorXor <- Operator #{const CAIRO_OPERATOR_XOR} where+	OperatorXor = Operator #{const CAIRO_OPERATOR_XOR}++pattern OperatorAdd :: Operator+pattern OperatorAdd <- Operator #{const CAIRO_OPERATOR_ADD} where+	OperatorAdd = Operator #{const CAIRO_OPERATOR_ADD}++pattern OperatorSaturate :: Operator+pattern OperatorSaturate <- Operator #{const CAIRO_OPERATOR_ADD} where+	OperatorSaturate = Operator #{const CAIRO_OPERATOR_SATURATE}++pattern OperatorMultiply :: Operator+pattern OperatorMultiply <- Operator #{const CAIRO_OPERATOR_MULTIPLY} where+	OperatorMultiply = Operator #{const CAIRO_OPERATOR_MULTIPLY}++pattern OperatorScreen :: Operator+pattern OperatorScreen <- Operator #{const CAIRO_OPERATOR_SCREEN} where+	OperatorScreen = Operator #{const CAIRO_OPERATOR_SCREEN}++pattern OperatorOverlay :: Operator+pattern OperatorOverlay <- Operator #{const CAIRO_OPERATOR_OVERLAY} where+	OperatorOverlay = Operator #{const CAIRO_OPERATOR_OVERLAY}++pattern OperatorDarken :: Operator+pattern OperatorDarken <- Operator #{const CAIRO_OPERATOR_DARKEN} where+	OperatorDarken = Operator #{const CAIRO_OPERATOR_DARKEN}++pattern OperatorLighten :: Operator+pattern OperatorLighten <- Operator #{const CAIRO_OPERATOR_LIGHTEN} where+	OperatorLighten = Operator #{const CAIRO_OPERATOR_LIGHTEN}++pattern OperatorColorDodge :: Operator+pattern OperatorColorDodge <- Operator #{const CAIRO_OPERATOR_COLOR_DODGE} where+	OperatorColorDodge = Operator #{const CAIRO_OPERATOR_COLOR_DODGE}++pattern OperatorColorBurn :: Operator+pattern OperatorColorBurn <- Operator #{const CAIRO_OPERATOR_COLOR_BURN} where+	OperatorColorBurn = Operator #{const CAIRO_OPERATOR_COLOR_BURN}++pattern OperatorHardLight :: Operator+pattern OperatorHardLight <- Operator #{const CAIRO_OPERATOR_HARD_LIGHT} where+	OperatorHardLight = Operator #{const CAIRO_OPERATOR_HARD_LIGHT}++pattern OperatorSoftLight :: Operator+pattern OperatorSoftLight <- Operator #{const CAIRO_OPERATOR_SOFT_LIGHT} where+	OperatorSoftLight = Operator #{const CAIRO_OPERATOR_SOFT_LIGHT}++pattern OperatorDifference :: Operator+pattern OperatorDifference <- Operator #{const CAIRO_OPERATOR_DIFFERENCE} where+	OperatorDifference = Operator #{const CAIRO_OPERATOR_DIFFERENCE}++pattern OperatorExclusion :: Operator+pattern OperatorExclusion <- Operator #{const CAIRO_OPERATOR_EXCLUSION} where+	OperatorExclusion = Operator #{const CAIRO_OPERATOR_EXCLUSION}++pattern OperatorHslHue :: Operator+pattern OperatorHslHue <- Operator #{const CAIRO_OPERATOR_HSL_HUE} where+	OperatorHslHue = Operator #{const CAIRO_OPERATOR_HSL_HUE}++pattern OperatorHslSaturation :: Operator+pattern OperatorHslSaturation <- Operator #{const CAIRO_OPERATOR_HSL_SATURATION} where+	OperatorHslSaturation = Operator #{const CAIRO_OPERATOR_HSL_SATURATION}++pattern OperatorHslColor :: Operator+pattern OperatorHslColor <- Operator #{const CAIRO_OPERATOR_HSL_COLOR} where+	OperatorHslColor = Operator #{const CAIRO_OPERATOR_HSL_COLOR}++pattern OperatorHslLuminosity :: Operator+pattern OperatorHslLuminosity <- Operator #{const CAIRO_OPERATOR_HSL_LUMINOSITY} where+	OperatorHslLuminosity = Operator #{const CAIRO_OPERATOR_HSL_LUMINOSITY}
+ src/Graphics/Cairo/Drawing/CairoT/Clip.hsc view
@@ -0,0 +1,43 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.Clip where++import Foreign.Ptr+import Foreign.C.Types+import Foreign.Marshal+import Foreign.Storable+import Control.Monad.Primitive+import Data.Int+import Data.CairoContext+import Graphics.Cairo.Drawing.Extents++#include <cairo.h>++cairoClip, cairoClipPreserve :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoClip = (`withCairoT` c_cairo_clip)+cairoClipPreserve = (`withCairoT` c_cairo_clip_preserve)++foreign import ccall "cairo_clip" c_cairo_clip :: Ptr (CairoT r s) -> IO ()++foreign import ccall "cairo_clip_preserve" c_cairo_clip_preserve :: Ptr (CairoT r s) -> IO ()++cairoClipExtents :: PrimMonad m => CairoT r (PrimState m) -> m CairoExtents+cairoClipExtents = flip withCairoT \pcr -> alloca \x1 -> alloca \y1 -> alloca \x2 -> alloca \y2 -> do+	c_cairo_clip_extents pcr x1 y1 x2 y2+	CairoExtentsLeftTopRightBottom <$> peek x1 <*> peek y1 <*> peek x2 <*> peek y2++foreign import ccall "cairo_clip_extents" c_cairo_clip_extents ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoInClip :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m Bool+cairoInClip cr x y = withCairoT cr \pcr -> (/= 0) <$> c_cairo_in_clip pcr x y++foreign import ccall "cairo_in_clip" c_cairo_in_clip ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO #{type cairo_bool_t}++cairoResetClip :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoResetClip = (`withCairoT` c_cairo_reset_clip)++foreign import ccall "cairo_reset_clip" c_cairo_reset_clip ::+	Ptr (CairoT r s) -> IO ()
+ src/Graphics/Cairo/Drawing/CairoT/Page.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.Page where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Primitive+import Data.CairoContext++cairoCopyPage :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoCopyPage (CairoT fcr) =+	unsafeIOToPrim $ withForeignPtr fcr c_cairo_copy_page++foreign import ccall "cairo_copy_page" c_cairo_copy_page ::+	Ptr (CairoT r s) -> IO ()++cairoShowPage :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoShowPage (CairoT fcr) =+	unsafeIOToPrim $ withForeignPtr fcr c_cairo_show_page++foreign import ccall "cairo_show_page" c_cairo_show_page ::+	Ptr (CairoT r s) -> IO ()
+ src/Graphics/Cairo/Drawing/CairoT/SaveAndRestore.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.SaveAndRestore where++import Foreign.Ptr+import Control.Monad.Primitive+import Data.CairoContext++cairoSave :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoSave = (`withCairoT` c_cairo_save)++foreign import ccall "cairo_save" c_cairo_save :: Ptr (CairoT r s) -> IO ()++cairoRestore :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoRestore = (`withCairoT` c_cairo_restore)++foreign import ccall "cairo_restore" c_cairo_restore :: Ptr (CairoT r s) -> IO ()
+ src/Graphics/Cairo/Drawing/CairoT/Setting.hsc view
@@ -0,0 +1,154 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIOnS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.CairoT.Setting where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad.Primitive+import Data.Word+import Data.CairoContext+import Graphics.Cairo.Exception++import Graphics.Cairo.Drawing.CairoT.CairoOperatorT++#include <cairo.h>++class CairoSetting s where+	cairoSet :: PrimMonad m => CairoT r (PrimState m) -> s -> m ()+	cairoGet :: PrimMonad m => CairoT r (PrimState m) -> m s++newtype LineWidth = LineWidth { getLineWidth :: CDouble } deriving Show++instance CairoSetting LineWidth where+	cairoSet cr = cairoSetLineWidth cr . getLineWidth+	cairoGet cr = LineWidth <$> withCairoT cr c_cairo_get_line_width++cairoSetLineWidth :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> m ()+cairoSetLineWidth cr w = withCairoT cr \pcr -> c_cairo_set_line_width pcr w++foreign import ccall "cairo_set_line_width" c_cairo_set_line_width ::+	Ptr (CairoT r s) -> CDouble -> IO ()++foreign import ccall "cairo_get_line_width" c_cairo_get_line_width ::+	Ptr (CairoT r s) -> IO CDouble++data Dash = Dash [CDouble] CDouble deriving Show++instance CairoSetting Dash where+	cairoSet cr (Dash ds ofs) = cairoSetDash cr ds ofs+	cairoGet cr = uncurry Dash <$> cairoGetDash cr++cairoSetDash :: PrimMonad m => CairoT r (PrimState m) -> [CDouble] -> CDouble -> m ()+cairoSetDash cr ds ofs = withCairoT cr \pcr -> withArrayLen ds \lds pds -> do+	c_cairo_set_dash pcr pds (fromIntegral lds) ofs+	raiseIfError cr++foreign import ccall "cairo_set_dash" c_cairo_set_dash ::+	Ptr (CairoT r s) -> Ptr CDouble -> CInt -> CDouble -> IO ()++cairoGetDash :: PrimMonad m => CairoT r (PrimState m) -> m ([CDouble], CDouble)+cairoGetDash cr = withCairoT cr \pcr -> do+	ln <- fromIntegral <$> c_cairo_get_dash_count pcr+	allocaArray ln \ds -> alloca \ofs -> do+		c_cairo_get_dash pcr ds ofs+		(,) <$> peekArray ln ds <*> peek ofs++foreign import ccall "cairo_get_dash_count" c_cairo_get_dash_count :: Ptr (CairoT r s) -> IO CInt++foreign import ccall "cairo_get_dash" c_cairo_get_dash ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> IO ()++newtype FillRule = FillRule #{type cairo_fill_rule_t} deriving Show++pattern FillRuleWinding :: FillRule+pattern FillRuleWinding <- FillRule #{const CAIRO_FILL_RULE_WINDING} where+	FillRuleWinding = FillRule #{const CAIRO_FILL_RULE_WINDING}++pattern FillRuleEvenOdd :: FillRule+pattern FillRuleEvenOdd <- FillRule #{const CAIRO_FILL_RULE_EVEN_ODD} where+	FillRuleEvenOdd = FillRule #{const CAIRO_FILL_RULE_EVEN_ODD}++instance CairoSetting FillRule where+	cairoSet cr (FillRule fr) = withCairoT cr \pcr -> c_cairo_set_fill_rule pcr fr+	cairoGet cr = FillRule <$> withCairoT cr c_cairo_get_fill_rule++foreign import ccall "cairo_set_fill_rule" c_cairo_set_fill_rule ::+	Ptr (CairoT r s) -> #{type cairo_fill_rule_t} -> IO ()++foreign import ccall "cairo_get_fill_rule" c_cairo_get_fill_rule ::+	Ptr (CairoT r s) -> IO #{type cairo_fill_rule_t}++newtype LineCap = LineCap {+	getLineCap :: #{type cairo_line_cap_t} } deriving Show++pattern LineCapButt :: LineCap+pattern LineCapButt <- LineCap #{const CAIRO_LINE_CAP_BUTT} where+	LineCapButt = LineCap #{const CAIRO_LINE_CAP_BUTT}++pattern LineCapRound :: LineCap+pattern LineCapRound <- LineCap #{const CAIRO_LINE_CAP_ROUND} where+	LineCapRound = LineCap #{const CAIRO_LINE_CAP_ROUND}++pattern LineCapSquare :: LineCap+pattern LineCapSquare <- LineCap #{const CAIRO_LINE_CAP_SQUARE} where+	LineCapSquare = LineCap #{const CAIRO_LINE_CAP_SQUARE}++instance CairoSetting LineCap where+	cairoSet cr (LineCap c) = withCairoT cr (`c_cairo_set_line_cap` c)+	cairoGet cr = LineCap <$> withCairoT cr c_cairo_get_line_cap++foreign import ccall "cairo_set_line_cap" c_cairo_set_line_cap ::+	Ptr (CairoT r s) -> #{type cairo_line_cap_t} -> IO ()++foreign import ccall "cairo_get_line_cap" c_cairo_get_line_cap ::+	Ptr (CairoT r s) -> IO #{type cairo_line_cap_t}++newtype LineJoin = LineJoin #{type cairo_line_join_t} deriving Show++pattern LineJoinMiter :: LineJoin+pattern LineJoinMiter <- LineJoin #{const CAIRO_LINE_JOIN_MITER} where+	LineJoinMiter = LineJoin #{const CAIRO_LINE_JOIN_MITER}++pattern LineJoinRound :: LineJoin+pattern LineJoinRound <- LineJoin #{const CAIRO_LINE_JOIN_ROUND} where+	LineJoinRound = LineJoin #{const CAIRO_LINE_JOIN_ROUND}++pattern LineJoinBevel :: LineJoin+pattern LineJoinBevel <- LineJoin #{const CAIRO_LINE_JOIN_BEVEL} where+	LineJoinBevel = LineJoin #{const CAIRO_LINE_JOIN_BEVEL}++instance CairoSetting LineJoin where+	cairoSet cr (LineJoin j) = withCairoT cr (`c_cairo_set_line_join` j)+	cairoGet cr = LineJoin <$> withCairoT cr c_cairo_get_line_join++foreign import ccall "cairo_set_line_join" c_cairo_set_line_join ::+	Ptr (CairoT r s) -> #{type cairo_line_join_t} -> IO ()++foreign import ccall "cairo_get_line_join" c_cairo_get_line_join ::+	Ptr (CairoT r s) -> IO #{type cairo_line_join_t}++newtype MiterLimit = MiterLimit CDouble deriving Show++instance CairoSetting MiterLimit where+	cairoSet cr (MiterLimit ml) = withCairoT cr (`c_cairo_set_miter_limit` ml)+	cairoGet cr = MiterLimit <$> withCairoT cr c_cairo_get_miter_limit++foreign import ccall "cairo_set_miter_limit" c_cairo_set_miter_limit ::+	Ptr (CairoT r s) -> CDouble -> IO ()++foreign import ccall "cairo_get_miter_limit" c_cairo_get_miter_limit ::+	Ptr (CairoT r s) -> IO CDouble++instance CairoSetting Operator where+	cairoSet cr (Operator o) = withCairoT cr (`c_cairo_set_operator` o)+	cairoGet cr = Operator <$> withCairoT cr c_cairo_get_operator++foreign import ccall "cairo_set_operator" c_cairo_set_operator ::+	Ptr (CairoT r s) -> #{type cairo_operator_t} -> IO ()++foreign import ccall "cairo_get_operator" c_cairo_get_operator ::+	Ptr (CairoT r s) -> IO #{type cairo_operator_t}
+ src/Graphics/Cairo/Drawing/Extents.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Extents where++import Foreign.C.Types++data CairoExtents = CairoExtentsLeftTopRightBottom {+	cairoExtentsLeftX :: CDouble,+	cairoExtentsTopY :: CDouble,+	cairoExtentsRightX :: CDouble,+	cairoExtentsBottomY :: CDouble } deriving Show++pattern CairoExtentsLeftTopWidthHeight :: CDouble -> CDouble -> CDouble -> CDouble -> CairoExtents+pattern CairoExtentsLeftTopWidthHeight {+	cairoExtentsLeft, cairoExtentsTop,+	cairoExtentsWidth, cairoExtentsHeight } <-+	(cairoExtentsLeftTopWidthHeight -> (cairoExtentsLeft, cairoExtentsTop, cairoExtentsWidth, cairoExtentsHeight)) where +	CairoExtentsLeftTopWidthHeight l t w h = CairoExtentsLeftTopRightBottom l t (l + w) (t + h)++cairoExtentsLeftTopWidthHeight :: CairoExtents -> (CDouble, CDouble, CDouble, CDouble)+cairoExtentsLeftTopWidthHeight (CairoExtentsLeftTopRightBottom l t r b) = (l, t, r - l, b - t)
+ src/Graphics/Cairo/Drawing/Paths.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Paths (+	cairoClosePath, cairoArc, cairoLineTo, cairoMoveTo, cairoRectangle,+	cairoRelCurveTo, cairoRelLineTo,++	cairoNewPath+	) where++import Graphics.Cairo.Drawing.Paths.Basic+import Graphics.Cairo.Drawing.Paths.Relative
+ src/Graphics/Cairo/Drawing/Paths/Basic.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Paths.Basic where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad.Primitive+import Data.Angle+import Data.CairoContext++import Graphics.Cairo.Drawing.Extents++cairoNewPath :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoNewPath = (`withCairoT` c_cairo_new_path)++foreign import ccall "cairo_new_path" c_cairo_new_path :: Ptr (CairoT r s) -> IO ()++cairoNewSubPath :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoNewSubPath = (`withCairoT` c_cairo_new_sub_path)++foreign import ccall "cairo_new_sub_path" c_cairo_new_sub_path :: Ptr (CairoT r s) -> IO ()++cairoMoveTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoMoveTo cr x y = withCairoT cr \pcr -> c_cairo_move_to pcr x y++foreign import ccall "cairo_move_to" c_cairo_move_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoLineTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoLineTo cr x y = withCairoT cr \pcr -> c_cairo_line_to pcr x y++foreign import ccall "cairo_line_to" c_cairo_line_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoCurveTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble ->+	CDouble -> CDouble -> CDouble -> CDouble -> m ()+cairoCurveTo cr x1 y1 x2 y2 x3 y3 = withCairoT cr \pcr -> c_cairo_curve_to pcr x1 y1 x2 y2 x3 y3++foreign import ccall "cairo_curve_to" c_cairo_curve_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoClosePath :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoClosePath = (`withCairoT` c_cairo_close_path)++foreign import ccall "cairo_close_path" c_cairo_close_path ::+	Ptr (CairoT r s) -> IO ()++cairoRectangle :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> CDouble -> CDouble -> m ()+cairoRectangle cr x y w h = withCairoT cr \pcr -> c_cairo_rectangle pcr x y w h++foreign import ccall "cairo_rectangle" c_cairo_rectangle ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoArc :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble ->+	CDouble -> Angle CDouble -> Angle CDouble -> m ()+cairoArc cr xc yc r (Radian a1) (Radian a2) =+	withCairoT cr \pcr -> c_cairo_arc pcr xc yc r a1 a2++foreign import ccall "cairo_arc" c_cairo_arc :: Ptr (CairoT r s) ->+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoArcNegative :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble ->+	CDouble -> Angle CDouble -> Angle CDouble -> m ()+cairoArcNegative cr xc yc r (Radian a1) (Radian a2) =+	withCairoT cr \pcr -> c_cairo_arc_negative pcr xc yc r a1 a2++foreign import ccall "cairo_arc_negative" c_cairo_arc_negative ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble ->+	IO ()++cairoPathExtents :: PrimMonad m => CairoT r (PrimState m) -> m CairoExtents+cairoPathExtents = flip withCairoT \pcr -> alloca \x1 -> alloca \y1 -> alloca \x2 -> alloca \y2 -> do+	c_cairo_path_extents pcr x1 y1 x2 y2+	CairoExtentsLeftTopRightBottom <$> peek x1 <*> peek y1 <*> peek x2 <*> peek y2++foreign import ccall "cairo_path_extents" c_cairo_path_extents ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()
+ src/Graphics/Cairo/Drawing/Paths/CairoPathT.hsc view
@@ -0,0 +1,393 @@+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Paths.CairoPathT (+	Path(..), CairoPathT, pattern CairoPathT, withCairoPathT, mkCairoPathT,+	MoveTo(..), LineCurveTo(..), CloseTo(..),+	CairoPatchPathT, pattern CairoPatchPathT,+	pattern CairoPathTPatch, mkCairoPatchPathT ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Data.Bool+import Data.Word++import Graphics.Cairo.Exception++import System.IO.Unsafe++#include <cairo.h>++newtype CairoPathT = CairoPathT_ (ForeignPtr CairoPathT) deriving Show++pattern CairoPathT :: [Path] -> CairoPathT+pattern CairoPathT ps <- (unsafePerformIO . cairoPathTPathList -> ps) where+	CairoPathT = unsafePerformIO . pathListToCairoPathT++withCairoPathT :: CairoPathT -> (Ptr CairoPathT -> IO a) -> IO a+withCairoPathT (CairoPathT_ fpth) = withForeignPtr fpth++mkCairoPathT :: Ptr CairoPathT -> IO CairoPathT+mkCairoPathT p =+	CairoPathT_ <$> newForeignPtr p (c_cairo_path_destroy p)+		<* (cairoStatusToThrowError =<< cairoPathTStatus p)++foreign import ccall "cairo_path_destroy" c_cairo_path_destroy ::+	Ptr CairoPathT -> IO ()++cairoPathTStatus :: Ptr CairoPathT -> IO #{type cairo_status_t}+cairoPathTStatus = #{peek cairo_path_t, status}++cairoPathTData ::Ptr CairoPathT -> IO (Ptr CairoPathDataT)+cairoPathTData = #{peek cairo_path_t, data}++cairoPathTNumData :: Ptr CairoPathT -> IO CInt+cairoPathTNumData = #{peek cairo_path_t, num_data}++newtype CairoPathDataT = CairoPathDataT (Ptr CairoPathDataT) deriving Show++nextPtr :: Ptr a -> Int -> Int -> Ptr a+nextPtr p sz al = alignPtr (plusPtr p sz) al++nextCairoPathDataT :: Ptr CairoPathDataT -> Ptr CairoPathDataT+nextCairoPathDataT p = nextPtr p #{size cairo_path_data_t} #{alignment cairo_path_data_t}++nextByLength :: Ptr CairoPathDataT -> CInt -> Ptr CairoPathDataT+nextByLength p n | n < 1 = p+nextByLength p n = nextCairoPathDataT $ nextByLength p (n - 1)++cairoPathDataTHeaderType :: Ptr CairoPathDataT -> IO #{type cairo_path_data_type_t}+cairoPathDataTHeaderType = #{peek cairo_path_data_t, header.type}++cairoPathDataTHeaderLength :: Ptr CairoPathDataT -> IO CInt+cairoPathDataTHeaderLength = #{peek cairo_path_data_t, header.length}++cairoPathDataTPointX, cairoPathDataTPointY :: Ptr CairoPathDataT -> IO CDouble+cairoPathDataTPointX = #{peek cairo_path_data_t, point.x}+cairoPathDataTPointY = #{peek cairo_path_data_t, point.y}++data Path+	= PathMoveTo CDouble CDouble+	| PathLineTo CDouble CDouble+	| PathCurveTo CDouble CDouble CDouble CDouble CDouble CDouble+	| PathClosePath+	deriving Show++cairoPathTPathList :: CairoPathT -> IO [Path]+cairoPathTPathList (CairoPathT_ fp) = withForeignPtr fp \p -> do+	d <- cairoPathTData p+	n <- cairoPathTNumData p+	cairoPathDataTPathList d n++cairoPathDataTPathList :: Ptr CairoPathDataT -> CInt -> IO [Path]+cairoPathDataTPathList _ n | n < 1 = pure []+cairoPathDataTPathList p n = unsafeInterleaveIO do+	pth <- unsafeInterleaveIO $ cairoPathDataTHeaderType p >>= \case+		#{const CAIRO_PATH_MOVE_TO} -> PathMoveTo+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+		#{const CAIRO_PATH_LINE_TO} -> PathLineTo+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+		#{const CAIRO_PATH_CURVE_TO} -> PathCurveTo+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+			<*> cairoPathDataTPointX p2 <*> cairoPathDataTPointY p2+			<*> cairoPathDataTPointX p3 <*> cairoPathDataTPointY p3+		#{const CAIRO_PATH_CLOSE_PATH} -> pure PathClosePath+		_ -> error "no such path"+	ln <- cairoPathDataTHeaderLength p+	(pth :) <$> cairoPathDataTPathList (nextByLength p ln) (n - ln)+	where+	p1 = nextByLength p 1+	p2 = nextByLength p 2+	p3 = nextByLength p 3++pathToNumData :: Path -> Int+pathToNumData = \case+	PathMoveTo _ _ -> 2; PathLineTo _ _ -> 2; PathCurveTo _ _ _ _ _ _ -> 4; PathClosePath -> 1++pathToCairoPathData :: Ptr CairoPathDataT -> Path -> IO ()+pathToCairoPathData p = \case+	PathMoveTo x y -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_MOVE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (2 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x+		#{poke cairo_path_data_t, point.y} p1 y+	PathLineTo x y -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_LINE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (2 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x+		#{poke cairo_path_data_t, point.y} p1 y+	PathCurveTo x1 y1 x2 y2 x3 y3 -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_CURVE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (4 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x1+		#{poke cairo_path_data_t, point.y} p1 y1+		#{poke cairo_path_data_t, point.x} p2 x2+		#{poke cairo_path_data_t, point.y} p2 y2+		#{poke cairo_path_data_t, point.x} p3 x3+		#{poke cairo_path_data_t, point.y} p3 y3+	PathClosePath -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_CLOSE_PATH} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (1 :: CInt)+	where+	p1 = nextByLength p 1+	p2 = nextByLength p 2+	p3 = nextByLength p 3++calcAlignedSize :: Int -> Int -> Int+calcAlignedSize sz al = (sz `div` al + signum (sz `mod` al)) * al++cairoPathDataTSize :: Int+cairoPathDataTSize = calcAlignedSize #{size cairo_path_data_t} #{alignment cairo_path_data_t}++pathListToCairoPathT :: [Path] -> IO CairoPathT+pathListToCairoPathT pths = CairoPathT_ <$> do+	pd <- mallocBytes $ sum (pathToNumData <$> pths) * cairoPathDataTSize+	pathListToCairoPathDataT pd pths+	p <- mallocBytes #{size cairo_path_t}+	#{poke cairo_path_t, status} p (#{const CAIRO_STATUS_SUCCESS} :: #{type cairo_status_t})+	#{poke cairo_path_t, data} p pd+	#{poke cairo_path_t, num_data} p $ sum (pathToNumData <$> pths)+	newForeignPtr p $ free pd >> free p++pathListToCairoPathDataT :: Ptr CairoPathDataT -> [Path] -> IO ()+pathListToCairoPathDataT pd = \case+	[] -> pure ()+	pth : pths -> pathToCairoPathData pd pth >> pathListToCairoPathDataT (pd `plusPtr` (cairoPathDataTSize * pathToNumData pth)) pths++cairoPathTCheckPaths :: CairoPathT -> [#{type cairo_path_data_type_t} -> Bool] -> IO Bool+cairoPathTCheckPaths (CairoPathT_ fpth) ts = withForeignPtr fpth \ppth -> do+	d <- cairoPathTData ppth+	n <- cairoPathTNumData ppth+	cairoPathDataCheckPaths d ts n++cairoPathDataCheckPaths :: Ptr CairoPathDataT -> [#{type cairo_path_data_type_t} -> Bool] -> CInt -> IO Bool+cairoPathDataCheckPaths _ [] 0 = pure True+cairoPathDataCheckPaths _ [] _ = pure False+cairoPathDataCheckPaths _ _ 0 = pure False+cairoPathDataCheckPaths p (t : ts) n = do+	b <- t <$> cairoPathDataTHeaderType p+	ln <- cairoPathDataTHeaderLength p+	(b &&) <$> unsafeInterleaveIO (cairoPathDataCheckPaths (nextByLength p ln) ts (n - ln))++cairoPathTGetGoal :: CairoPathT -> Int -> IO (Maybe (CDouble, CDouble))+cairoPathTGetGoal (CairoPathT_ fpth) i = withForeignPtr fpth \ppth -> do+	d <- cairoPathTData ppth+	n <- cairoPathTNumData ppth+	cairoPathDataTGetGoal d i n++cairoPathDataTGetGoal :: Ptr CairoPathDataT -> Int -> CInt -> IO (Maybe (CDouble, CDouble))+cairoPathDataTGetGoal _ _ n | n < 1 = pure Nothing+cairoPathDataTGetGoal p 0 _ = unsafeInterleaveIO do+	cairoPathDataTHeaderType p >>= \case+		#{const CAIRO_PATH_MOVE_TO} -> (\x y -> Just (x, y))+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+		#{const CAIRO_PATH_LINE_TO} -> (\x y -> Just (x, y))+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+		#{const CAIRO_PATH_CURVE_TO} -> (\x y -> Just (x, y))+			<$> cairoPathDataTPointX p3 <*> cairoPathDataTPointY p3+		#{const CAIRO_PATH_CLOSE_PATH} -> pure Nothing+		_ -> error "no such path"+	where p1 = nextByLength p 1; p3 = nextByLength p 3+cairoPathDataTGetGoal p i n = do+	ln <- cairoPathDataTHeaderLength p+	cairoPathDataTGetGoal (nextByLength p ln) (i - 1) (n - ln)++lineOrCurve :: #{type cairo_path_data_type_t} -> Bool+lineOrCurve = (||) <$> (== #{const CAIRO_PATH_LINE_TO}) <*> (== #{const CAIRO_PATH_CURVE_TO})++isCairoPatchPath :: CairoPathT -> IO Bool+isCairoPatchPath pth = do+	b1 <- cairoPathTCheckPaths pth [+		(== #{const CAIRO_PATH_MOVE_TO}), lineOrCurve, lineOrCurve, lineOrCurve,+		(== #{const CAIRO_PATH_CLOSE_PATH}) ]+	b2 <- cairoPathTCheckPaths pth [+		(== #{const CAIRO_PATH_MOVE_TO}), lineOrCurve, lineOrCurve, lineOrCurve, lineOrCurve ]+	b3 <- cairoPathTGetGoal pth 0 >>= \case+		Nothing -> pure False+		Just (x0, y0) -> cairoPathTGetGoal pth 4 >>= \case+			Nothing -> pure False+			Just (xc, yc) -> pure $ xc == x0 && yc == y0+	pure $ b1 || (b2 && b3)++newtype CairoPatchPathT = CairoPatchPathT_ (ForeignPtr CairoPathT) deriving Show++mkCairoPatchPathT :: Ptr CairoPathT -> IO CairoPatchPathT+mkCairoPatchPathT p =+	CairoPatchPathT_ <$> newForeignPtr p (c_cairo_path_destroy p)+		<* (cairoStatusToThrowError =<< cairoPathTStatus p)++pattern CairoPathTPatch :: CairoPatchPathT -> CairoPathT+pattern CairoPathTPatch ppth <- (unsafePerformIO . cairoPathTPatch -> Just ppth) where+	CairoPathTPatch (CairoPatchPathT_ fpth) = CairoPathT_ fpth++cairoPathTPatch :: CairoPathT -> IO (Maybe CairoPatchPathT)+cairoPathTPatch pth@(CairoPathT_ fpth) =+	bool Nothing (Just $ CairoPatchPathT_ fpth) <$> isCairoPatchPath pth++data MoveTo = MoveTo CDouble CDouble deriving Show++data LineCurveTo+	= LineTo CDouble CDouble+	| CurveTo CDouble CDouble CDouble CDouble CDouble CDouble+	deriving Show++data CloseTo+	= CloseLineTo+	| CloseCurveTo CDouble CDouble CDouble CDouble+	deriving Show++pattern CairoPatchPathT :: MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo -> CairoPatchPathT+pattern CairoPatchPathT mt lct1 lct2 lct3 cls <- (unsafePerformIO . drawFromCairoPatchPathT -> (mt, lct1, lct2, lct3, cls)) where+	CairoPatchPathT mt lct1 lct2 lct3 cls = unsafePerformIO $ patchPathsToCairoPatchPathT mt lct1 lct2 lct3 cls++drawFromCairoPatchPathT :: CairoPatchPathT -> IO (MoveTo, LineCurveTo, LineCurveTo, LineCurveTo, CloseTo)+drawFromCairoPatchPathT (CairoPatchPathT_ fpth) = withForeignPtr fpth \ppth -> do+	d <- cairoPathTData ppth+	n <- cairoPathTNumData ppth+	drawFromCairoPathDataT d n >>= \case+		(Just r, 0) -> pure r+		_ -> error "badbadbad"+		+drawFromCairoPathDataT :: Ptr CairoPathDataT -> CInt ->+	IO (Maybe (MoveTo, LineCurveTo, LineCurveTo, LineCurveTo, CloseTo), CInt)+drawFromCairoPathDataT p0 n0 = do+	(mmt, pn1) <- drawMoveToFromCairoPathDataT p0 n0+	(mlct1, pn2) <- uncurry drawLineCurveToFromCairoPathDataT pn1+	(mlct2, pn3) <- uncurry drawLineCurveToFromCairoPathDataT pn2+	(mlct3, pn4) <- uncurry drawLineCurveToFromCairoPathDataT pn3+	(mcls_, (_p5, n5)) <- uncurry drawCloseToFromCairoPathDataT pn4+	let	mcls = case mmt of+			Nothing -> error "bad"+			Just (MoveTo x0 y0) -> case mcls_ of+				Nothing -> error "bad"+				Just (m, Nothing) -> Just m+				Just (m, Just (x1, y1))+					| x0 == x1 && y0 == y1 -> Just m+					| otherwise -> error "bad"+	if n5 /= 0 then error "bad" else pure +		. (, n5) $ (,,,,) <$> mmt <*> mlct1 <*> mlct2 <*> mlct3 <*> mcls++drawMoveToFromCairoPathDataT :: Ptr CairoPathDataT -> CInt -> IO (Maybe MoveTo, (Ptr CairoPathDataT, CInt))+drawMoveToFromCairoPathDataT p n = do+	mt <- cairoPathDataTHeaderType p >>= \case+		#{const CAIRO_PATH_MOVE_TO} -> Just+			<$> (MoveTo <$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1)+		_ -> pure Nothing+	ln <- cairoPathDataTHeaderLength p+	if n - ln < 0 then error "bad" else pure (mt, (nextByLength p ln, n - ln))+	where p1 = nextByLength p 1++drawLineCurveToFromCairoPathDataT :: Ptr CairoPathDataT -> CInt -> IO (Maybe LineCurveTo, (Ptr CairoPathDataT, CInt))+drawLineCurveToFromCairoPathDataT p n = do+	lct <- cairoPathDataTHeaderType p >>= \case+		#{const CAIRO_PATH_LINE_TO} -> Just+			<$> (LineTo <$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1)+		#{const CAIRO_PATH_CURVE_TO} -> (Just <$>) $ CurveTo+			<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+			<*> cairoPathDataTPointX p2 <*> cairoPathDataTPointY p2+			<*> cairoPathDataTPointX p3 <*> cairoPathDataTPointY p3+		_ -> pure Nothing+	ln <- cairoPathDataTHeaderLength p+	if n - ln < 0 then error "bad" else pure (lct, (nextByLength p ln, n - ln))+	where p1 = nextByLength p 1; p2 = nextByLength p 2; p3 = nextByLength p 3++drawCloseToFromCairoPathDataT :: Ptr CairoPathDataT -> CInt -> IO (Maybe (CloseTo, Maybe (CDouble, CDouble)), (Ptr CairoPathDataT, CInt))+drawCloseToFromCairoPathDataT p n = do+	ctgl <- cairoPathDataTHeaderType p >>= \case+		#{const CAIRO_PATH_LINE_TO} -> (Just <$>) $ ((CloseLineTo ,) . Just <$>) $+			(,) <$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+		#{const CAIRO_PATH_CURVE_TO} -> (Just <$>) $ (,)+			<$> (CloseCurveTo+				<$> cairoPathDataTPointX p1 <*> cairoPathDataTPointY p1+				<*> cairoPathDataTPointX p2 <*> cairoPathDataTPointY p2)+			<*> (Just <$> ((,) <$> cairoPathDataTPointX p3 <*> cairoPathDataTPointY p3))+		#{const CAIRO_PATH_CLOSE_PATH} -> pure $ Just (CloseLineTo, Nothing)+		_ -> pure Nothing+	ln <- cairoPathDataTHeaderLength p+	if n - ln < 0 then error "bad" else pure (ctgl, (nextByLength p ln, n - ln))+	where [p1, p2, p3] = nextByLength p <$> [1, 2, 3]++patchPathsToCairoPatchPathT ::+	MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo -> IO CairoPatchPathT+patchPathsToCairoPatchPathT mt lct1 lct2 lct3 cls = CairoPatchPathT_ <$> do+	pd <- mallocBytes $ patchPathSize mt lct1 lct2 lct3 cls * cairoPathDataTSize+	patchPathsToCairoPathDataT pd mt lct1 lct2 lct3 cls+	p <- mallocBytes #{size cairo_path_t}+	#{poke cairo_path_t, status} p (#{const CAIRO_STATUS_SUCCESS} :: #{type cairo_status_t})+	#{poke cairo_path_t, data} p pd+	#{poke cairo_path_t, num_data} p $ patchPathSize mt lct1 lct2 lct3 cls+	newForeignPtr p $ free pd >> free p++patchPathSize :: MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo -> Int+patchPathSize _mt lct1 lct2 lct3 cls =+	2 + sum (lineCurveToSize <$> [lct1, lct2, lct3]) + closeToSize cls++lineCurveToSize :: LineCurveTo -> Int+lineCurveToSize (LineTo _ _) = 2+lineCurveToSize (CurveTo _ _ _ _ _ _) = 4++closeToSize :: CloseTo -> Int+closeToSize CloseLineTo = 1+closeToSize (CloseCurveTo _ _ _ _) = 4++patchPathsToCairoPathDataT :: Ptr CairoPathDataT ->+	MoveTo -> LineCurveTo -> LineCurveTo -> LineCurveTo -> CloseTo -> IO ()+patchPathsToCairoPathDataT pd mt lct1 lct2 lct3 cls = do+	pd1 <- moveToToCairoPathDataT pd mt+	pd2 <- lineCurveToToCairoPathDataT pd1 lct1+	pd3 <- lineCurveToToCairoPathDataT pd2 lct2+	pd4 <- lineCurveToToCairoPathDataT pd3 lct3+	_ <- closeToToCairoPathDataT pd4 mt cls+	pure ()++moveToToCairoPathDataT :: Ptr CairoPathDataT -> MoveTo -> IO (Ptr CairoPathDataT)+moveToToCairoPathDataT p (MoveTo x y) = do+	#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_MOVE_TO} :: #{type cairo_path_data_type_t})+	#{poke cairo_path_data_t, header.length} p (2 :: CInt)+	#{poke cairo_path_data_t, point.x} p1 x+	#{poke cairo_path_data_t, point.y} p1 y+	pure $ p `plusPtr` (cairoPathDataTSize * 2)+	where p1 = nextByLength p 1++lineCurveToToCairoPathDataT :: Ptr CairoPathDataT -> LineCurveTo -> IO (Ptr CairoPathDataT)+lineCurveToToCairoPathDataT p = \case+	LineTo x y -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_LINE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (2 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x+		#{poke cairo_path_data_t, point.y} p1 y+		pure $ p `plusPtr` (cairoPathDataTSize * 2)+	CurveTo x1 y1 x2 y2 x3 y3 -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_CURVE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (4 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x1+		#{poke cairo_path_data_t, point.y} p1 y1+		#{poke cairo_path_data_t, point.x} p2 x2+		#{poke cairo_path_data_t, point.y} p2 y2+		#{poke cairo_path_data_t, point.x} p3 x3+		#{poke cairo_path_data_t, point.y} p3 y3+		pure $ p `plusPtr` (cairoPathDataTSize * 4)+	where p1 = nextByLength p 1; p2 = nextByLength p 2; p3 = nextByLength p 3++closeToToCairoPathDataT :: Ptr CairoPathDataT -> MoveTo -> CloseTo -> IO (Ptr CairoPathDataT)+closeToToCairoPathDataT p (MoveTo x0 y0) = \case+	CloseLineTo -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_CLOSE_PATH} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (1 :: CInt)+		pure $ p `plusPtr` cairoPathDataTSize+	CloseCurveTo x1 y1 x2 y2 -> do+		#{poke cairo_path_data_t, header.type} p (#{const CAIRO_PATH_CURVE_TO} :: #{type cairo_path_data_type_t})+		#{poke cairo_path_data_t, header.length} p (4 :: CInt)+		#{poke cairo_path_data_t, point.x} p1 x1+		#{poke cairo_path_data_t, point.y} p1 y1+		#{poke cairo_path_data_t, point.x} p2 x2+		#{poke cairo_path_data_t, point.y} p2 y2+		#{poke cairo_path_data_t, point.x} p3 x0+		#{poke cairo_path_data_t, point.y} p3 y0+		pure $ p `plusPtr` (cairoPathDataTSize * 4)+	where p1 = nextByLength p 1; p2 = nextByLength p 2; p3 = nextByLength p 3
+ src/Graphics/Cairo/Drawing/Paths/CopyAppend.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Paths.CopyAppend where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Primitive+import Data.CairoContext+import Graphics.Cairo.Drawing.Paths.CairoPathT++cairoCopyPath :: PrimMonad m => CairoT r (PrimState m) -> m CairoPathT+cairoCopyPath (CairoT fcr) = unsafeIOToPrim+	$ withForeignPtr fcr \pcr -> mkCairoPathT =<< c_cairo_copy_path pcr++foreign import ccall "cairo_copy_path" c_cairo_copy_path ::+	Ptr (CairoT r s) -> IO (Ptr CairoPathT)++cairoCopyPathFlat :: PrimMonad m => CairoT r (PrimState m) -> m CairoPathT+cairoCopyPathFlat (CairoT fcr) = unsafeIOToPrim+	$ withForeignPtr fcr \pcr -> mkCairoPathT =<< c_cairo_copy_path_flat pcr++foreign import ccall "cairo_copy_path_flat" c_cairo_copy_path_flat ::+	Ptr (CairoT r s) -> IO (Ptr CairoPathT)++cairoAppendPath :: PrimMonad m =>+	CairoT r (PrimState m) -> CairoPathT -> m ()+cairoAppendPath (CairoT fcr) pth = unsafeIOToPrim+	$ withForeignPtr fcr \pcr -> withCairoPathT pth \ppth ->+		c_cairo_append_path pcr ppth++foreign import ccall "cairo_append_path" c_cairo_append_path ::+	Ptr (CairoT r s) -> Ptr CairoPathT -> IO ()
+ src/Graphics/Cairo/Drawing/Paths/Relative.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Paths.Relative where++import Foreign.Ptr+import Foreign.C.Types+import Control.Monad.Primitive+import Data.CairoContext+import Graphics.Cairo.Exception++cairoRelMoveTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoRelMoveTo cr dx dy = do+	withCairoT cr \pcr -> c_cairo_rel_move_to pcr dx dy+	unsafeIOToPrim $ raiseIfError cr++foreign import ccall "cairo_rel_move_to" c_cairo_rel_move_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoRelLineTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoRelLineTo cr x y = do+	withCairoT cr \pcr -> c_cairo_rel_line_to pcr x y+	unsafeIOToPrim $ raiseIfError cr++foreign import ccall "cairo_rel_line_to" c_cairo_rel_line_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoRelCurveTo :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> CDouble ->+	CDouble -> CDouble ->+	CDouble -> CDouble -> m ()+cairoRelCurveTo cr dx1 dy1 dx2 dy2 dx3 dy3 = do+	withCairoT cr \pcr -> c_cairo_rel_curve_to pcr dx1 dy1 dx2 dy2 dx3 dy3+	unsafeIOToPrim $ raiseIfError cr++foreign import ccall "cairo_rel_curve_to" c_cairo_rel_curve_to ::+	Ptr (CairoT r s) -> CDouble -> CDouble ->+		CDouble -> CDouble ->+		CDouble -> CDouble -> IO ()
+ src/Graphics/Cairo/Drawing/Regions.hs-boot view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Regions where++import Foreign.ForeignPtr++newtype CairoRegionT s = CairoRegionT (ForeignPtr (CairoRegionT s))
+ src/Graphics/Cairo/Drawing/Regions.hsc view
@@ -0,0 +1,57 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Regions where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.C.Types+import Control.Monad.Primitive++import Graphics.Cairo.Exception+import Graphics.Cairo.Utilities.Types++#include <cairo.h>++newtype CairoRegionT s = CairoRegionT (ForeignPtr (CairoRegionT s)) deriving Show++makeCairoRegionT :: Ptr (CairoRegionT s) -> IO (CairoRegionT s)+makeCairoRegionT p = CairoRegionT <$> newForeignPtr p (c_cairo_region_destroy p)++foreign import ccall "cairo_region_destroy" c_cairo_region_destroy ::+	Ptr (CairoRegionT s) -> IO ()++foreign import ccall "cairo_region_create" c_cairo_region_create :: IO (Ptr (CairoRegionT s))++cairoRegionCreate :: PrimMonad m => m (CairoRegionT (PrimState m))+cairoRegionCreate = unsafeIOToPrim do+	r <- makeCairoRegionT =<< c_cairo_region_create+	r <$ raiseIfErrorRegion r++foreign import ccall "cairo_region_create_rectangle" c_cairo_region_create_rectangle ::+	Ptr CairoRectangleIntT -> IO (Ptr (CairoRegionT s))++cairoRegionCreateRectangle :: PrimMonad m => CairoRectangleIntT -> m (CairoRegionT (PrimState m))+cairoRegionCreateRectangle (CairoRectangleIntT_ fr) = unsafeIOToPrim $ withForeignPtr fr \prct -> do+	r <- makeCairoRegionT =<< c_cairo_region_create_rectangle prct+	r <$ raiseIfErrorRegion r++cairoRegionNumRectangles :: PrimMonad m => CairoRegionT (PrimState m) -> m CInt+cairoRegionNumRectangles (CairoRegionT frg) =+	unsafeIOToPrim $ withForeignPtr frg c_cairo_region_num_rectangles++foreign import ccall "cairo_region_num_rectangles"+	c_cairo_region_num_rectangles :: Ptr (CairoRegionT s) -> IO CInt++cairoRegionGetRectangle :: PrimMonad m => CairoRegionT (PrimState m) -> CInt ->+	CairoRectangleIntTPrim (PrimState m) -> m ()+cairoRegionGetRectangle rg@(CairoRegionT frg) n (CairoRectangleIntTPrim frc) =+	unsafeIOToPrim+		$ withForeignPtr frg \prg -> withForeignPtr frc \prc -> do+			c_cairo_region_get_rectangle prg n prc+			raiseIfErrorRegion rg++foreign import ccall "cairo_region_get_rectangle"+	c_cairo_region_get_rectangle ::+		Ptr (CairoRegionT s) -> CInt -> Ptr CairoRectangleIntT -> IO ()
+ src/Graphics/Cairo/Drawing/TagsAndLinks.hsc view
@@ -0,0 +1,72 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.TagsAndLinks where++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.String+import Control.Monad.Primitive+import Data.CairoContext++import Graphics.Cairo.Exception++#include <cairo.h>++cairoTagLinkInternal :: PrimMonad m =>+	CairoT r (PrimState m) -> Name -> m a -> m a+cairoTagLinkInternal cr d = cairoTagLinkInternalDestPage cr $ Left d++cairoTagLinkInternalDestPage :: PrimMonad m => CairoT r (PrimState m) ->+	Either Name (Int, Maybe (Double, Double)) -> m a -> m a+cairoTagLinkInternalDestPage cr@(CairoT fcr) d m = do+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> do+		tl <- newCString #{const_str CAIRO_TAG_LINK}+		internalAttributes d $ c_cairo_tag_begin pcr tl+	m <* unsafeIOToPrim do+		withForeignPtr fcr \pcr -> c_cairo_tag_end pcr+			=<< newCString #{const_str CAIRO_TAG_LINK}+		raiseIfError cr++internalAttributes :: Either Name (Int, Maybe (Double, Double)) -> (CString -> IO a) -> IO a+internalAttributes = \case+	Left n -> withCString $ "dest='" ++ escape n ++ "'"+	Right (p, Nothing) -> withCString $ "page=" ++ show p+	Right (p, Just (x, y)) -> withCString $ "page=" ++ show p ++ " pos=[" ++ show x ++ " " ++ show y ++ "]"++cairoTagLinkUri :: PrimMonad m => CairoT r (PrimState m) -> Uri -> m a -> m a+cairoTagLinkUri cr@(CairoT fcr) u m = do+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> do+		tl <- newCString #{const_str CAIRO_TAG_LINK}+		c_cairo_tag_begin pcr tl =<< newCString ("uri='" ++ escape u ++ "'")+	m <* unsafeIOToPrim do+		withForeignPtr fcr \pcr -> c_cairo_tag_end pcr+			=<< newCString #{const_str CAIRO_TAG_LINK}+		raiseIfError cr++type Uri = String++cairoTagDestination :: PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a+cairoTagDestination cr@(CairoT fcr) n m = do+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> do+		td <- newCString #{const_str CAIRO_TAG_DEST}+		c_cairo_tag_begin pcr td =<< newCString ("name='" ++ escape n ++ "'")+	m <* unsafeIOToPrim do+		withForeignPtr fcr \pcr -> c_cairo_tag_end pcr+			=<< newCString #{const_str CAIRO_TAG_DEST}+		raiseIfError cr++type Name = String++foreign import ccall "cairo_tag_begin" c_cairo_tag_begin ::+	Ptr (CairoT r s) -> CString -> CString -> IO ()++foreign import ccall "cairo_tag_end" c_cairo_tag_end ::+	Ptr (CairoT r s) -> CString -> IO ()++escape :: String -> String+escape = \case+	"" -> ""+	'\'' : cs -> "\\'" ++ escape cs+	'\\' : cs -> "\\\\" ++ escape cs+	c : cs -> c : escape cs
+ src/Graphics/Cairo/Drawing/Text.hsc view
@@ -0,0 +1,56 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Text (+	cairoSelectFontFace, cairoSetFontSize, cairoShowText, cairoTextExtents+	) where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C+import Control.Monad.Primitive+import Data.Word++import qualified Data.ByteString as BS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++import Graphics.Cairo.Types+import Graphics.Cairo.Values++import Data.CairoContext++#include <cairo.h>++foreign import ccall "cairo_select_font_face" c_cairo_select_font_face ::+	Ptr (CairoT r s) -> CString ->+	#{type cairo_font_slant_t} -> #{type cairo_font_weight_t} -> IO ()++cairoSelectFontFace :: PrimMonad m =>+	CairoT r (PrimState m) -> T.Text -> CairoFontSlantT -> CairoFontWeightT -> m ()+cairoSelectFontFace cr ff (CairoFontSlantT sl) (CairoFontWeightT wt) =+	withCairoT cr \pcr -> encode ff \cs ->+		c_cairo_select_font_face pcr cs sl wt++foreign import ccall "cairo_set_font_size" c_cairo_set_font_size ::+	Ptr (CairoT r s) -> #{type double} -> IO ()++cairoSetFontSize :: PrimMonad m => CairoT r (PrimState m) -> #{type double} -> m ()+cairoSetFontSize cr fs = withCairoT cr \pcr -> c_cairo_set_font_size pcr fs++foreign import ccall "cairo_text_extents" c_cairo_text_extents ::+	Ptr (CairoT r s) -> CString -> Ptr CairoTextExtentsT -> IO ()++cairoTextExtents :: PrimMonad m => CairoT r (PrimState m) -> T.Text -> m CairoTextExtentsT+cairoTextExtents cr t = withCairoT cr \pcr ->+	encode t \cs -> alloca \p -> c_cairo_text_extents pcr cs p *> peek p++encode :: T.Text -> (CString -> IO a) -> IO a+encode t = BS.useAsCString $ T.encodeUtf8 t++foreign import ccall "cairo_show_text" c_cairo_show_text ::+	Ptr (CairoT r s) -> CString -> IO ()++cairoShowText :: PrimMonad m => CairoT r (PrimState m) -> T.Text -> m ()+cairoShowText cr t = withCairoT cr \pcr -> encode t \cs -> c_cairo_show_text pcr cs
+ src/Graphics/Cairo/Drawing/Transformations.hsc view
@@ -0,0 +1,121 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Drawing.Transformations where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Storable+import Foreign.C.Types+import Foreign.Marshal+import Control.Monad+import Control.Monad.Primitive++import Data.CairoContext++import Graphics.Cairo.Utilities.CairoMatrixT.Internal++#include <cairo.h>++cairoTranslate :: PrimMonad m =>+	CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoTranslate (CairoT fcr) tx ty =+	unsafeIOToPrim $ withForeignPtr fcr \cr -> c_cairo_translate cr tx ty++foreign import ccall "cairo_translate" c_cairo_translate ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoScale :: PrimMonad m =>+	CairoT r (PrimState m) -> CDouble -> CDouble -> m ()+cairoScale (CairoT fcr) sx sy =+	unsafeIOToPrim $ withForeignPtr fcr \cr -> c_cairo_scale cr sx sy++foreign import ccall "cairo_scale" c_cairo_scale ::+	Ptr (CairoT r s) -> CDouble -> CDouble -> IO ()++cairoRotate :: PrimMonad m => CairoT r (PrimState m) -> CDouble -> m ()+cairoRotate (CairoT fcr) a =+	unsafeIOToPrim $ withForeignPtr fcr \cr -> c_cairo_rotate cr a++foreign import ccall "cairo_rotate" c_cairo_rotate ::+	Ptr (CairoT r s) -> CDouble -> IO ()++cairoTransform :: (PrimMonad m, IsCairoMatrixT mtx) =>+	CairoT r (PrimState m) -> mtx (PrimState m) -> m ()+cairoTransform (CairoT fcr) (toCairoMatrixT -> CairoMatrixT fmtx) =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> withForeignPtr fmtx \pmtx ->+		c_cairo_transform pcr pmtx++foreign import ccall "cairo_transform" c_cairo_transform ::+	Ptr (CairoT r s) -> Ptr (CairoMatrixT s) -> IO ()++cairoSetMatrix :: (PrimMonad m, IsCairoMatrixT mtx) =>+	CairoT r (PrimState m) -> mtx (PrimState m) -> m ()+cairoSetMatrix (CairoT fcr) (toCairoMatrixT -> CairoMatrixT fmtx) =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> withForeignPtr fmtx \pmtx ->+		c_cairo_set_matrix pcr pmtx++cairoGetMatrix :: PrimMonad m => CairoT r (PrimState m) -> m (CairoMatrixT (PrimState m))+cairoGetMatrix (CairoT fcr) = unsafeIOToPrim+	$ CairoMatrixT <$> withForeignPtr fcr \pcr -> do+		p <- mallocBytes #{size cairo_matrix_t}+		c_cairo_get_matrix pcr p+		newForeignPtr p (free p)++foreign import ccall "cairo_set_matrix" c_cairo_set_matrix ::+	Ptr (CairoT r s) -> Ptr (CairoMatrixT s) -> IO ()++foreign import ccall "cairo_get_matrix" c_cairo_get_matrix ::+	Ptr (CairoT r s) -> Ptr (CairoMatrixT s) -> IO ()++cairoIdentityMatrix :: PrimMonad m => CairoT r (PrimState m) -> m ()+cairoIdentityMatrix (CairoT fcr) =+	unsafeIOToPrim $ withForeignPtr fcr c_cairo_identity_matrix++foreign import ccall "cairo_identity_matrix" c_cairo_identity_matrix :: Ptr (CairoT r s) -> IO ()++cairoUserToDevice :: PrimMonad m =>+	CairoT r (PrimState m) -> CDouble -> CDouble -> m (CDouble, CDouble)+cairoUserToDevice (CairoT fcr) x y =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> alloca \px -> alloca \py -> do+		zipWithM_ poke [px, py] [x, y]+		c_cairo_user_to_device pcr px py+		(,) <$> peek px <*> peek py++foreign import ccall "cairo_user_to_device" c_cairo_user_to_device ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoUserToDeviceDistance :: PrimMonad m =>+	CairoT r (PrimState m) -> CDouble -> CDouble -> m (CDouble, CDouble)+cairoUserToDeviceDistance (CairoT fcr) dx dy =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> alloca \px -> alloca \py -> do+		zipWithM_ poke [px, py] [dx, dy]+		c_cairo_user_to_device_distance pcr px py+		(,) <$> peek px <*> peek py++foreign import ccall "cairo_user_to_device_distance" c_cairo_user_to_device_distance ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoDeviceToUser :: PrimMonad m =>+	(CairoT r (PrimState m)) -> CDouble -> CDouble -> m (CDouble, CDouble)+cairoDeviceToUser (CairoT fcr) x y =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> alloca \px -> alloca \py -> do+		zipWithM_ poke [px, py] [x, y]+		c_cairo_device_to_user pcr px py+		(,) <$> peek px <*> peek py++foreign import ccall "cairo_device_to_user" c_cairo_device_to_user ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoDeviceToUserDistance :: PrimMonad m =>+	(CairoT r (PrimState m)) -> CDouble -> CDouble -> m (CDouble, CDouble)+cairoDeviceToUserDistance (CairoT fcr) dx dy =+	unsafeIOToPrim $ withForeignPtr fcr \pcr -> alloca \px -> alloca \py -> do+		zipWithM_ poke [px, py] [dx, dy]+		c_cairo_device_to_user_distance pcr px py+		(,) <$> peek px <*> peek py++foreign import ccall "cairo_device_to_user_distance" c_cairo_device_to_user_distance ::+	Ptr (CairoT r s) -> Ptr CDouble -> Ptr CDouble -> IO ()
+ src/Graphics/Cairo/Exception.hsc view
@@ -0,0 +1,119 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Exception where++import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Exception+import Control.Exception.Hierarchy+import Data.Word++import Data.CairoContext++import {-# SOURCE #-} Graphics.Cairo.Drawing.Regions+import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal++#include <cairo.h>++data CairoStatusNoMemory = CairoStatusNoMemory deriving Show+data CairoStatusInvalidRestore = CairoStatusInvalidRestore deriving Show+data CairoStatusInvalidPopGroup = CairoStatusInvalidPopGroup deriving Show+data CairoStatusNoCurrentPoint = CairoStatusNoCurrentPoint deriving Show+data CairoStatusInvalidMatrix = CairoStatusInvalidMatrix deriving Show+data CairoStatusInvalidStatus = CairoStatusInvalidStatus deriving Show+data CairoStatusNullPointer = CairoStatusNullPointer deriving Show+data CairoStatusInvalidString = CairoStatusInvalidString deriving Show+data CairoStatusInvalidPathData = CairoStatusInvalidPathData deriving Show+data CairoStatusReadError = CairoStatusReadError deriving Show+data CairoStatusWriteError = CairoStatusWriteError deriving Show+data CairoStatusFileNotFound = CairoStatusFileNotFound deriving Show+data CairoStatusInvalidDash = CairoStatusInvalidDash deriving Show+data CairoStatusInvalidMeshConstruction = CairoStatusInvalidMeshConstruction deriving Show+data CairoStatusOthers = CairoStatusOthers #{type cairo_status_t} deriving Show++exceptionHierarchy Nothing $ ExNode "CairoStatus" [+	ExType ''CairoStatusNoMemory,+	ExType ''CairoStatusInvalidRestore,+	ExType ''CairoStatusInvalidPopGroup,+	ExType ''CairoStatusNoCurrentPoint,+	ExType ''CairoStatusInvalidMatrix,+	ExType ''CairoStatusInvalidStatus,+	ExType ''CairoStatusNullPointer,+	ExType ''CairoStatusInvalidString,+	ExType ''CairoStatusInvalidPathData,+	ExType ''CairoStatusReadError,+	ExType ''CairoStatusWriteError,+	ExType ''CairoStatusFileNotFound,+	ExType ''CairoStatusInvalidDash,+	ExType ''CairoStatusInvalidMeshConstruction,+	ExType ''CairoStatusOthers+	]++newtype CairoStatusT = CairoStatusT #{type cairo_status_t} deriving (Show, Eq)++foreign import ccall "cairo_status" c_cairo_status :: Ptr (CairoT r s) -> IO #type cairo_status_t++raiseIfError :: CairoT r s -> IO ()+raiseIfError (CairoT fcr) = withForeignPtr fcr \pcr -> cairoStatusToThrowError =<< c_cairo_status pcr++raiseIfErrorRegion :: CairoRegionT s -> IO ()+raiseIfErrorRegion (CairoRegionT fr) = withForeignPtr fr \r -> cairoStatusToThrowError =<< c_cairo_region_status r++foreign import ccall "cairo_region_status" c_cairo_region_status ::+	Ptr (CairoRegionT s) -> IO #type cairo_status_t++foreign import ccall "cairo_surface_status" c_cairo_surface_status :: Ptr (CairoSurfaceT s ps) -> IO #type cairo_status_t++raiseIfErrorSurface :: CairoSurfaceT s ps -> IO ()+raiseIfErrorSurface (CairoSurfaceT fsr) = withForeignPtr fsr \sr -> cairoStatusToThrowError =<< c_cairo_surface_status sr++raiseIfErrorPtrSurface :: Ptr (CairoSurfaceT s ps) -> IO ()+raiseIfErrorPtrSurface sr = cairoStatusToThrowError =<< c_cairo_surface_status sr++cairoStatusToThrowError :: #{type cairo_status_t} -> IO ()+cairoStatusToThrowError = \case+	#{const CAIRO_STATUS_SUCCESS} -> pure ()+	#{const CAIRO_STATUS_NO_MEMORY} -> throw CairoStatusNoMemory+	#{const CAIRO_STATUS_INVALID_RESTORE} -> throw CairoStatusInvalidRestore+	#{const CAIRO_STATUS_INVALID_POP_GROUP} -> throw CairoStatusInvalidPopGroup+	#{const CAIRO_STATUS_NO_CURRENT_POINT} -> throw CairoStatusNoCurrentPoint+	#{const CAIRO_STATUS_INVALID_MATRIX} -> throw CairoStatusInvalidMatrix+	#{const CAIRO_STATUS_INVALID_STATUS} -> throw CairoStatusInvalidStatus+	#{const CAIRO_STATUS_NULL_POINTER} -> throw CairoStatusNullPointer+	#{const CAIRO_STATUS_INVALID_STRING} -> throw CairoStatusInvalidString+	#{const CAIRO_STATUS_INVALID_PATH_DATA} -> throw CairoStatusInvalidPathData+	#{const CAIRO_STATUS_READ_ERROR} -> throw CairoStatusReadError+	#{const CAIRO_STATUS_WRITE_ERROR} -> throw CairoStatusWriteError+	#{const CAIRO_STATUS_FILE_NOT_FOUND} -> throw CairoStatusFileNotFound+	#{const CAIRO_STATUS_INVALID_DASH} -> throw CairoStatusInvalidDash+	#{const CAIRO_STATUS_INVALID_MESH_CONSTRUCTION} -> throw CairoStatusInvalidMeshConstruction+	st -> throw $ CairoStatusOthers st++#enum CairoStatusT, CairoStatusT, CAIRO_STATUS_SUCCESS, \+	CAIRO_STATUS_NO_MEMORY, CAIRO_STATUS_INVALID_RESTORE, \+	CAIRO_STATUS_INVALID_POP_GROUP, CAIRO_STATUS_NO_CURRENT_POINT++tryCairoWriteFunc :: IO a -> IO #{type cairo_status_t}+tryCairoWriteFunc io = (<$> try io) \case+	Left CairoStatusWriteError -> #{const CAIRO_STATUS_WRITE_ERROR}+	Right _ -> #{const CAIRO_STATUS_SUCCESS}++{-+pattern CairoStatusSuccess :: CairoStatusT+pattern CairoStatusSuccess = CairoStatusT #const CAIRO_STATUS_SUCCESS++pattern CairoStatusNoMemory :: CairoStatusT+pattern CairoStatusNoMemory = CairoStatusT #const CAIRO_STATUS_NO_MEMORY++pattern CairoStatusInvalidRestore :: CairoStatusT+pattern CairoStatusInvalidRestore = CairoStatusT #const CAIRO_STATUS_INVALID_RESTORE++pattern CairoStatusInvalidPopGroup :: CairoStatusT+pattern CairoStatusInvalidPopGroup = CairoStatusT #const CAIRO_STATUS_INVALID_POP_GROUP++pattern CairoStatusNoCurrentPoint :: CairoStatusT+pattern CairoStatusNoCurrentPoint = CairoStatusT #const CAIRO_STATUS_NO_CURRENT_POINT+	-}
+ src/Graphics/Cairo/Surfaces/CairoSurfaceT.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.CairoSurfaceT (+	IsCairoSurfaceT, CairoSurfaceT,+	cairoSurfaceGetType, cairoSurfaceGetContent,+	cairoSurfaceFlush ) where++import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal
+ src/Graphics/Cairo/Surfaces/CairoSurfaceT/Internal.hsc view
@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.CairoSurfaceT.Internal where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Control.Monad.Primitive+import Control.Concurrent.STM+import Data.Word+import System.IO.Unsafe++import Graphics.Cairo.Surfaces.CairoSurfaceTypeT++import Graphics.Cairo.Template++#include <cairo.h>++class IsCairoSurfaceT sr where+	toCairoSurfaceT :: sr s ps -> CairoSurfaceT s ps+	cairoSurfaceTFinishChecker :: sr s ps -> STM (TChan ())++	cairoSurfaceTFinishChecker _ = newTChan >>= \c -> c <$ writeTChan c ()++instance IsCairoSurfaceT CairoSurfaceT where toCairoSurfaceT = id++newtype CairoSurfaceT s ps = CairoSurfaceT (ForeignPtr (CairoSurfaceT s ps)) deriving Show++mkCairoSurfaceT :: Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceT s ps)+mkCairoSurfaceT p = CairoSurfaceT <$> newForeignPtr p (c_cairo_surface_destroy p)++foreign import ccall "cairo_surface_destroy" c_cairo_surface_destroy ::+	Ptr (CairoSurfaceT s ps) -> IO ()++foreign import ccall "cairo_surface_finish" c_cairo_surface_finish ::+	Ptr (CairoSurfaceT s ps) -> IO ()++cairoSurfaceFlush :: (IsCairoSurfaceT sr, PrimMonad m) => sr s (PrimState m) -> m ()+cairoSurfaceFlush (toCairoSurfaceT -> CairoSurfaceT fsr) = unsafeIOToPrim+	$ withForeignPtr fsr c_cairo_surface_flush++foreign import ccall "cairo_surface_flush" c_cairo_surface_flush ::+	Ptr (CairoSurfaceT s ps) -> IO ()++cairoSurfaceGetType :: IsCairoSurfaceT sr => sr s ps -> CairoSurfaceTypeT+cairoSurfaceGetType (toCairoSurfaceT -> CairoSurfaceT fsr) = unsafePerformIO+	$ CairoSurfaceTypeT <$> withForeignPtr fsr c_cairo_surface_get_type++foreign import ccall "cairo_surface_get_type" c_cairo_surface_get_type ::+	Ptr (CairoSurfaceT s ps) -> IO #{type cairo_surface_type_t}++cairoSurfaceGetContent :: IsCairoSurfaceT sr => sr s ps -> CairoContentT+cairoSurfaceGetContent (toCairoSurfaceT -> CairoSurfaceT fsr) = unsafePerformIO+	$ CairoContentT <$> withForeignPtr fsr c_cairo_surface_get_content++foreign import ccall "cairo_surface_get_content" c_cairo_surface_get_content ::+	Ptr (CairoSurfaceT s ps) -> IO #{type cairo_content_t}++newtype CairoContentT = CairoContentT #{type cairo_content_t} deriving Show++mkMemberGen ''CairoContentT 'CairoContentT "CairoContentColor" #{const CAIRO_CONTENT_COLOR}+mkMemberGen ''CairoContentT 'CairoContentT "CairoContentAlpha" #{const CAIRO_CONTENT_ALPHA}+mkMemberGen ''CairoContentT 'CairoContentT "CairoContentColorAlpha" #{const CAIRO_CONTENT_COLOR_ALPHA}
+ src/Graphics/Cairo/Surfaces/CairoSurfaceTypeT.hsc view
@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.CairoSurfaceTypeT (+	CairoSurfaceTypeT(..),+	module Graphics.Cairo.Surfaces.CairoSurfaceTypeT+	) where++import Graphics.Cairo.Surfaces.CairoSurfaceTypeT.Template++#include <cairo.h>++mkMember "CairoSurfaceTypeImage" #{const CAIRO_SURFACE_TYPE_IMAGE}+mkMember "CairoSurfaceTypePdf" #{const CAIRO_SURFACE_TYPE_PDF}+mkMember "CairoSurfaceTypePs" #{const CAIRO_SURFACE_TYPE_PS}+mkMember "CairoSurfaceTypeXlib" #{const CAIRO_SURFACE_TYPE_XLIB}+mkMember "CairoSurfaceTypeXcb" #{const CAIRO_SURFACE_TYPE_XCB}+mkMember "CairoSurfaceTypeGlitz" #{const CAIRO_SURFACE_TYPE_GLITZ}+mkMember "CairoSurfaceTypeQuartz" #{const CAIRO_SURFACE_TYPE_QUARTZ}+mkMember "CairoSurfaceTypeWin32" #{const CAIRO_SURFACE_TYPE_WIN32}+mkMember "CairoSurfaceTypeBeos" #{const CAIRO_SURFACE_TYPE_DIRECTFB}+mkMember "CairoSurfaceTypeSvg" #{const CAIRO_SURFACE_TYPE_SVG}+mkMember "CairoSurfaceTypeOs2" #{const CAIRO_SURFACE_TYPE_OS2}+mkMember "CairoSurfaceTypeWin32Printing"+	#{const CAIRO_SURFACE_TYPE_WIN32_PRINTING}+mkMember "CairoSurfaceTypeQuartzImage" #{const CAIRO_SURFACE_TYPE_QUARTZ_IMAGE}+mkMember "CairoSurfaceTypeScript" #{const CAIRO_SURFACE_TYPE_SCRIPT}+mkMember "CairoSurfaceTypeQt" #{const CAIRO_SURFACE_TYPE_QT}+mkMember "CairoSurfaceTypeRecording" #{const CAIRO_SURFACE_TYPE_RECORDING}+mkMember "CairoSurfaceTypeVg" #{const CAIRO_SURFACE_TYPE_VG}+mkMember "CairoSurfaceTypeGl" #{const CAIRO_SURFACE_TYPE_GL}+mkMember "CairoSurfaceTypeDrm" #{const CAIRO_SURFACE_TYPE_DRM}+mkMember "CairoSurfaceTypeTee" #{const CAIRO_SURFACE_TYPE_TEE}+mkMember "CairoSurfaceTypeXml" #{const CAIRO_SURFACE_TYPE_XML}+mkMember "CairoSurafceTypeSkia" #{const CAIRO_SURFACE_TYPE_SKIA}+mkMember "CairoSurfaceTypeSubsurface" #{const CAIRO_SURFACE_TYPE_SUBSURFACE}+mkMember "CairoSurfaceTypeCogl" #{const CAIRO_SURFACE_TYPE_COGL}
+ src/Graphics/Cairo/Surfaces/CairoSurfaceTypeT/Template.hsc view
@@ -0,0 +1,16 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.CairoSurfaceTypeT.Template where++import Language.Haskell.TH+import Data.Word++import Graphics.Cairo.Template++#include <cairo.h>++newtype CairoSurfaceTypeT = CairoSurfaceTypeT #{type cairo_surface_type_t} deriving Show++mkMember :: String -> Integer -> DecsQ+mkMember = mkMemberGen ''CairoSurfaceTypeT 'CairoSurfaceTypeT
+ src/Graphics/Cairo/Surfaces/CairoWriteFuncT.hsc view
@@ -0,0 +1,50 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.CairoWriteFuncT where++import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.String+import Control.Monad.Primitive+import Data.Word++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++import qualified Data.ByteString as BS++#include <cairo.h>++data WriteResult = WriteFailure | WriteSuccess deriving Show++writeResultToCairoStatusT :: WriteResult -> #{type cairo_status_t}+writeResultToCairoStatusT = \case+	WriteFailure -> #{const CAIRO_STATUS_WRITE_ERROR}+	WriteSuccess -> #{const CAIRO_STATUS_SUCCESS}++foreign import ccall "wrapper" c_wrap_cairo_write_func_t ::+	(Ptr a -> CString -> CInt -> IO #{type cairo_status_t}) ->+	IO (FunPtr (Ptr a -> CString -> CInt -> IO #{type cairo_status_t}))++wrapCairoWriteFuncTText :: PrimBase m => (Ptr a -> T.Text -> m WriteResult) ->+	IO (FunPtr (Ptr a -> CString -> CInt -> IO #{type cairo_status_t}))+wrapCairoWriteFuncTText wf = c_wrap_cairo_write_func_t $ convertCairoWriteFuncTText wf++wrapCairoWriteFuncTByteString :: PrimBase m => (Ptr a -> BS.ByteString -> m WriteResult) ->+	IO (FunPtr (Ptr a -> CString -> CInt -> IO #{type cairo_status_t}))+wrapCairoWriteFuncTByteString = c_wrap_cairo_write_func_t . convertCairoWriteFuncTByteString++convertCairoWriteFuncT :: (Ptr a -> String -> IO #{type cairo_status_t}) ->+	Ptr a -> CString -> CInt -> IO #{type cairo_status_t}+convertCairoWriteFuncT wf p cs ln = peekCStringLen (cs, fromIntegral ln) >>= \s -> wf p s++convertCairoWriteFuncTText :: PrimBase m => (Ptr a -> T.Text -> m WriteResult) ->+	Ptr a -> CString -> CInt -> IO #{type cairo_status_t}+convertCairoWriteFuncTText wf p cs ln = writeResultToCairoStatusT+	<$> (T.peekCStringLen (cs, fromIntegral ln) >>= \t -> unsafePrimToIO $ wf p t)++convertCairoWriteFuncTByteString :: PrimBase m => (Ptr a -> BS.ByteString -> m WriteResult) ->+	Ptr a -> CString -> CInt -> IO #{type cairo_status_t}+convertCairoWriteFuncTByteString wf p cs ln = writeResultToCairoStatusT+	<$> (BS.packCStringLen (cs, fromIntegral ln) >>= \bs -> unsafePrimToIO $ wf p bs)
+ src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc view
@@ -0,0 +1,149 @@+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.ImageSurfaces (+	CairoSurfaceImageT,+	pattern CairoSurfaceTImage,++	cairoImageSurfaceCreate,++	cairoImageSurfaceCreateForCairoImage,+	cairoImageSurfaceCreateForCairoImageMut,++	cairoImageSurfaceGetCairoImage,+	cairoImageSurfaceGetCairoImageMut,++	cairoImageSurfaceGetWidth,+	cairoImageSurfaceGetHeight,+	cairoImageSurfaceGetStride,++	mkCairoSurfaceImageT+	) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Control.Monad.Primitive+import Data.Word+import Data.Int++import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+import Graphics.Cairo.Surfaces.CairoSurfaceTypeT++import Data.CairoImage.Internal hiding (Argb32, pixelAt, Image, Pixel)++#include <cairo.h>++newtype CairoSurfaceImageT s ps = CairoSurfaceImageT (ForeignPtr (CairoSurfaceT s ps)) deriving Show++pattern CairoSurfaceTImage :: CairoSurfaceImageT s ps -> CairoSurfaceT s ps+pattern CairoSurfaceTImage sr <- (cairoSurfaceTImage -> Just sr) where+	CairoSurfaceTImage = toCairoSurfaceT++cairoSurfaceTImage :: CairoSurfaceT s ps -> Maybe (CairoSurfaceImageT s ps)+cairoSurfaceTImage sr@(CairoSurfaceT fsr) = case cairoSurfaceGetType sr of+	CairoSurfaceTypeImage -> Just $ CairoSurfaceImageT fsr+	_ -> Nothing++instance IsCairoSurfaceT CairoSurfaceImageT where+	toCairoSurfaceT (CairoSurfaceImageT fsr) = CairoSurfaceT fsr++cairoImageSurfaceCreate :: PrimMonad m => CairoFormatT -> #{type int} -> #{type int} -> m (CairoSurfaceImageT s (PrimState m))+cairoImageSurfaceCreate (CairoFormatT f) w h =+	returnCairoSurfaceT $ c_cairo_image_surface_create f w h++foreign import ccall "cairo_image_surface_create" c_cairo_image_surface_create ::+	#{type cairo_format_t} -> #{type int} -> #{type int} -> IO (Ptr (CairoSurfaceT s ps))++foreign import ccall "cairo_image_surface_get_format" c_cairo_image_surface_get_format ::+	Ptr (CairoSurfaceT s ps) -> IO #type cairo_format_t++foreign import ccall "cairo_image_surface_get_stride" c_cairo_image_surface_get_stride ::+	Ptr (CairoSurfaceT s ps) -> IO #type int++foreign import ccall "cairo_image_surface_get_width" c_cairo_image_surface_get_width ::+	Ptr (CairoSurfaceT s ps) -> IO #type int++foreign import ccall "cairo_image_surface_get_height" c_cairo_image_surface_get_height ::+	Ptr (CairoSurfaceT s ps) -> IO #type int++cairoImageSurfaceGetCairoImage :: PrimMonad m => CairoSurfaceImageT s (PrimState m) -> m CairoImage+cairoImageSurfaceGetCairoImage = argCairoSurfaceT \sfc -> do+	d <- c_cairo_image_surface_get_data sfc+	f <- c_cairo_image_surface_get_format sfc+	w <- c_cairo_image_surface_get_width sfc+	h <- c_cairo_image_surface_get_height sfc+	s <- c_cairo_image_surface_get_stride sfc+	p <- mallocBytes . fromIntegral $ s * h+	copyBytes p d . fromIntegral $ s * h+	fd <- newForeignPtr (castPtr p) $ free (castPtr p)+	pure $ CairoImage (CairoFormatT f) (fromIntegral w) (fromIntegral h) (fromIntegral s) fd++cairoImageSurfaceGetCairoImageMut :: PrimMonad m => CairoSurfaceImageT s (PrimState m) -> m (CairoImageMut (PrimState m))+cairoImageSurfaceGetCairoImageMut = argCairoSurfaceT \sfc -> do+	d <- c_cairo_image_surface_get_data sfc+	f <- c_cairo_image_surface_get_format sfc+	w <- c_cairo_image_surface_get_width sfc+	h <- c_cairo_image_surface_get_height sfc+	s <- c_cairo_image_surface_get_stride sfc+	p <- mallocBytes . fromIntegral $ s * h+	copyBytes p d . fromIntegral $ s * h+	fd <- newForeignPtr (castPtr p) $ free (castPtr p)+	pure $ CairoImageMut (CairoFormatT f) (fromIntegral w) (fromIntegral h) (fromIntegral s) fd++newtype Argb32 = Argb32 Word32 deriving (Show, Storable)++foreign import ccall "cairo_image_surface_create_for_data" c_cairo_image_surface_create_for_data ::+	Ptr #{type unsigned char} -> #{type cairo_format_t} -> #{type int} -> #{type int} -> #{type int} -> IO (Ptr (CairoSurfaceT s ps))++cairoImageSurfaceCreateForCairoImage ::+	PrimMonad m => CairoImage -> m (CairoSurfaceImageT s (PrimState m))+cairoImageSurfaceCreateForCairoImage (CairoImage (CairoFormatT f) w h s d) = unsafeIOToPrim do+	p <- mallocBytes n+	withForeignPtr d \pd -> copyBytes p pd n+	sp <- c_cairo_image_surface_create_for_data (castPtr p) f (fromIntegral w) (fromIntegral h) (fromIntegral s)+	mkCairoSurfaceImageT' sp p+	where n = fromIntegral $ s * h++cairoImageSurfaceCreateForCairoImageMut ::+	PrimMonad m => CairoImageMut (PrimState m) -> m (CairoSurfaceImageT s (PrimState m))+cairoImageSurfaceCreateForCairoImageMut (CairoImageMut (CairoFormatT f) w h s d) = unsafeIOToPrim do+	p <- mallocBytes n+	withForeignPtr d \pd -> copyBytes p pd n+	sp <- c_cairo_image_surface_create_for_data (castPtr p) f (fromIntegral w) (fromIntegral h) (fromIntegral s)+	mkCairoSurfaceImageT' sp p+	where n = fromIntegral $ s * h++foreign import ccall "cairo_image_surface_get_data" c_cairo_image_surface_get_data ::+	Ptr (CairoSurfaceT s ps) -> IO (Ptr #{type unsigned char})++argCairoSurfaceT :: PrimMonad m => (Ptr (CairoSurfaceT s (PrimState m)) -> IO a) -> CairoSurfaceImageT s (PrimState m) -> m a+argCairoSurfaceT io (CairoSurfaceImageT fs) = unsafeIOToPrim $ withForeignPtr fs io++returnCairoSurfaceT :: PrimMonad m => IO (Ptr (CairoSurfaceT s (PrimState m))) -> m (CairoSurfaceImageT s (PrimState m))+returnCairoSurfaceT io = unsafeIOToPrim $ mkCairoSurfaceImageT =<< io++mkCairoSurfaceImageT :: Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)+mkCairoSurfaceImageT p = CairoSurfaceImageT <$> newForeignPtr p (c_cairo_surface_destroy p)++mkCairoSurfaceImageT' :: Ptr (CairoSurfaceT s ps) -> Ptr a -> IO (CairoSurfaceImageT s ps)+mkCairoSurfaceImageT' ps p = CairoSurfaceImageT <$> newForeignPtr ps (free p >> c_cairo_surface_destroy ps)++cairoImageSurfaceGetWidth :: PrimMonad m =>+	CairoSurfaceImageT s (PrimState m) -> m #{type int}+cairoImageSurfaceGetWidth = argCairoSurfaceT \sfc ->+	c_cairo_image_surface_get_width sfc++cairoImageSurfaceGetHeight :: PrimMonad m =>+	CairoSurfaceImageT s (PrimState m) -> m #{type int}+cairoImageSurfaceGetHeight = argCairoSurfaceT \sfc ->+	c_cairo_image_surface_get_height sfc++cairoImageSurfaceGetStride :: PrimMonad m =>+	CairoSurfaceImageT s (PrimState m) -> m #{type int}+cairoImageSurfaceGetStride = argCairoSurfaceT \sfc ->+	c_cairo_image_surface_get_stride sfc
+ src/Graphics/Cairo/Surfaces/PdfSurfaces.hsc view
@@ -0,0 +1,203 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.PdfSurfaces where++import GHC.Foreign hiding (peekCString)+import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String hiding (withCString)+import Control.Monad.Primitive+import Control.Concurrent.STM+import Data.Bits+import Data.Word+import System.IO++import Graphics.Cairo.Exception+import Graphics.Cairo.Surfaces.CairoWriteFuncT+import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+import Graphics.Cairo.Surfaces.CairoSurfaceTypeT+import Graphics.Cairo.Drawing.TagsAndLinks++import Graphics.Cairo.Surfaces.PdfSurfaces.Template++import qualified Data.ByteString as BS++#include <cairo.h>+#include <cairo-pdf.h>++data CairoSurfacePdfT s ps = CairoSurfacePdfT (ForeignPtr (CairoSurfaceT s ps)) (STM (TChan ()))++pattern CairoSurfaceTPdf :: CairoSurfacePdfT s ps -> CairoSurfaceT s ps+pattern CairoSurfaceTPdf sr <- (cairoSurfaceTPdf -> Just sr) where+	CairoSurfaceTPdf = toCairoSurfaceT++cairoSurfaceTPdf :: CairoSurfaceT s ps -> Maybe (CairoSurfacePdfT s ps)+cairoSurfaceTPdf sr@(CairoSurfaceT fsr) = case cairoSurfaceGetType sr of+	CairoSurfaceTypePdf -> Just $ CairoSurfacePdfT fsr newTChan+	_ -> Nothing++instance IsCairoSurfaceT CairoSurfacePdfT where+	toCairoSurfaceT (CairoSurfacePdfT fsr _) = CairoSurfaceT fsr+	cairoSurfaceTFinishChecker (CairoSurfacePdfT _ ck) = ck++cairoPdfSurfaceWith :: FilePath -> CDouble -> CDouble ->+	(forall s . CairoSurfacePdfT s RealWorld -> IO a) -> IO a+cairoPdfSurfaceWith fp w h f = do+	sr@(CairoSurfacePdfT fsr mck) <- cairoPdfSurfaceCreateNoGC fp w h+	ck <- atomically mck+	f sr <* withForeignPtr fsr+		(\psr -> do+			c_cairo_surface_finish psr+			c_cairo_surface_destroy psr+			putStrLn "PDF Surface destroyed"+			atomically (writeTChan ck ())+			putStrLn "writeTChan ck () finished")++cairoPdfSurfaceCreate :: FilePath -> CDouble -> CDouble -> IO (CairoSurfacePdfT s RealWorld)+cairoPdfSurfaceCreate fp w h = do+	ck <- atomically newTChan+	(`CairoSurfacePdfT` pure ck) <$> withCString utf8 fp \cstr -> do+		p <- c_cairo_pdf_surface_create cstr w h+		newForeignPtr p (c_cairo_surface_destroy p) <* raiseIfErrorPtrSurface p++cairoPdfSurfaceCreateNoGC :: FilePath -> CDouble -> CDouble -> IO (CairoSurfacePdfT s RealWorld)+cairoPdfSurfaceCreateNoGC fp w h = do+	ck <- atomically newTChan+	(`CairoSurfacePdfT` pure ck) <$> withCString utf8 fp \cstr -> do+		p <- c_cairo_pdf_surface_create cstr w h+		newForeignPtr p (pure ()) <* raiseIfErrorPtrSurface p++foreign import ccall "cairo_pdf_surface_create" c_cairo_pdf_surface_create ::+	CString -> CDouble -> CDouble -> IO (Ptr (CairoSurfaceT s ps))++unsafeCairoSurfaceFinish :: CairoSurfaceT s RealWorld -> IO ()+unsafeCairoSurfaceFinish (CairoSurfaceT fsr) =+	withForeignPtr fsr c_cairo_surface_finish++cairoPdfSurfaceWithForStream :: PrimBase m =>+	(Ptr a -> BS.ByteString -> m WriteResult) -> Ptr a -> CDouble -> CDouble ->+	(forall s . CairoSurfacePdfT s (PrimState m) -> m a) -> m a+cairoPdfSurfaceWithForStream wf cl w h f = do+	sr@(CairoSurfacePdfT fsr mck) <- cairoPdfSurfaceCreateForStreamNoGC wf cl w h+	ck <- unsafeIOToPrim $ atomically mck+	f sr <* unsafeIOToPrim (withForeignPtr fsr $+		\psr -> c_cairo_surface_finish psr >> atomically (writeTChan ck ()) >> c_cairo_surface_destroy psr)++cairoPdfSurfaceCreateForStream :: PrimBase m =>+	(Ptr a -> BS.ByteString -> m WriteResult) -> Ptr a -> CDouble -> CDouble ->+	m (CairoSurfacePdfT s (PrimState m))+cairoPdfSurfaceCreateForStream wf cl w h = do+	ck <- unsafeIOToPrim $ atomically newTChan+	(`CairoSurfacePdfT` pure ck) <$> unsafeIOToPrim do+		p <- (wrapCairoWriteFuncTByteString wf >>= \pwf ->+			c_cairo_pdf_surface_create_for_stream pwf cl w h)+		newForeignPtr p (c_cairo_surface_destroy p) <* raiseIfErrorPtrSurface p++cairoPdfSurfaceCreateForStreamNoGC :: PrimBase m =>+	(Ptr a -> BS.ByteString -> m WriteResult) -> Ptr a -> CDouble -> CDouble ->+	m (CairoSurfacePdfT s (PrimState m))+cairoPdfSurfaceCreateForStreamNoGC wf cl w h = do+	ck <- unsafeIOToPrim $ atomically newTChan+	(`CairoSurfacePdfT` pure ck) <$> unsafeIOToPrim do+		p <- (wrapCairoWriteFuncTByteString wf >>= \pwf ->+			c_cairo_pdf_surface_create_for_stream pwf cl w h)+		newForeignPtr p (pure ()) <* raiseIfErrorPtrSurface p++foreign import ccall "cairo_pdf_surface_create_for_stream"+	c_cairo_pdf_surface_create_for_stream ::+	FunPtr (Ptr a -> CString -> CInt -> IO #{type cairo_status_t}) ->+	Ptr a -> CDouble -> CDouble -> IO (Ptr (CairoSurfaceT s ps))++newtype CairoPdfOutlineT = CairoPdfOutlineT CInt deriving Show++pattern CairoPdfOutlineRoot :: CairoPdfOutlineT+pattern CairoPdfOutlineRoot <- CairoPdfOutlineT #{const CAIRO_PDF_OUTLINE_ROOT} where+	CairoPdfOutlineRoot = CairoPdfOutlineT #{const CAIRO_PDF_OUTLINE_ROOT}++mkOFlag "CairoPdfOutlineFlagOpen" #{const CAIRO_PDF_OUTLINE_FLAG_OPEN}+mkOFlag "CairoPdfOutlineFlagBold" #{const CAIRO_PDF_OUTLINE_FLAG_BOLD}+mkOFlag "CairoPdfOutlineFlagItalic" #{const CAIRO_PDF_OUTLINE_FLAG_ITALIC}++join :: CairoPdfOutlineFlagsT -> CairoPdfOutlineFlagsT -> CairoPdfOutlineFlagsT+join (CairoPdfOutlineFlagsT f1) (CairoPdfOutlineFlagsT f2) = CairoPdfOutlineFlagsT $ f1 .|. f2++cairoPdfSurfaceAddOutline :: PrimMonad m =>+	CairoSurfacePdfT s (PrimState m) -> CairoPdfOutlineT -> Name ->+	Either Name (Int, Maybe (Double, Double)) -> [CairoPdfOutlineFlagsT] -> m CairoPdfOutlineT+cairoPdfSurfaceAddOutline (CairoSurfacePdfT fsr _) (CairoPdfOutlineT pid) nm d fs = unsafeIOToPrim+	$ CairoPdfOutlineT <$> withForeignPtr fsr \psr -> withCString utf8 nm \cnm -> internalAttributes d \cd ->+		c_cairo_pdf_surface_add_outline psr pid cnm cd f+	where+	CairoPdfOutlineFlagsT f = foldr join (CairoPdfOutlineFlagsT 0) fs++foreign import ccall "cairo_pdf_surface_add_outline" c_cairo_pdf_surface_add_outline ::+	Ptr (CairoSurfaceT s ps) -> CInt -> CString -> CString -> #{type cairo_pdf_outline_flags_t} -> IO CInt++cairoPdfSurfaceSetSize :: PrimMonad m =>+	CairoSurfacePdfT s (PrimState m) -> CDouble -> CDouble -> m ()+cairoPdfSurfaceSetSize (CairoSurfacePdfT fsr _) w h =+	unsafeIOToPrim $ withForeignPtr fsr \psr -> c_cairo_pdf_surface_set_size psr w h++foreign import ccall "cairo_pdf_surface_set_size" c_cairo_pdf_surface_set_size ::+	Ptr (CairoSurfaceT s ps) -> CDouble -> CDouble -> IO ()++mkMeta "CairoPdfMetadataTitle" #{const CAIRO_PDF_METADATA_TITLE}+mkMeta "CairoPdfMetadataAuthor" #{const CAIRO_PDF_METADATA_AUTHOR}+mkMeta "CairoPdfMetadataSubject" #{const CAIRO_PDF_METADATA_SUBJECT}+mkMeta "CairoPdfMetadataKeywords" #{const CAIRO_PDF_METADATA_KEYWORDS}+mkMeta "CairoPdfMetadataCreator" #{const CAIRO_PDF_METADATA_CREATOR}+mkMeta "CairoPdfMetadataCreateDate" #{const CAIRO_PDF_METADATA_CREATE_DATE}+mkMeta "CairoPdfMetadataModDate" #{const CAIRO_PDF_METADATA_MOD_DATE}++cairoPdfSurfaceSetMetadata :: PrimMonad m =>+	CairoSurfacePdfT s (PrimState m) -> CairoPdfMetadataT -> String -> m ()+cairoPdfSurfaceSetMetadata (CairoSurfacePdfT fsr _) (CairoPdfMetadataT md) v =+	unsafeIOToPrim $ withForeignPtr fsr \psr -> withCString utf8 v \cv ->+		c_cairo_pdf_surface_set_metadata psr md cv++foreign import ccall "cairo_pdf_surface_set_metadata" c_cairo_pdf_surface_set_metadata ::+	Ptr (CairoSurfaceT s ps) -> #{type cairo_pdf_metadata_t} -> CString -> IO ()++cairoPdfSurfaceSetPageLabel :: PrimMonad m =>+	CairoSurfacePdfT s (PrimState m) -> String -> m ()+cairoPdfSurfaceSetPageLabel (CairoSurfacePdfT fsr _) pl =+	unsafeIOToPrim $ withForeignPtr fsr \psr -> withCString utf8 pl \cpl ->+		c_cairo_pdf_surface_set_page_label psr cpl++foreign import ccall "cairo_pdf_surface_set_page_label" c_cairo_pdf_surface_set_page_label ::+	Ptr (CairoSurfaceT s ps) -> CString -> IO ()++mkVersion "CairoPdfVersion1_4" #{const CAIRO_PDF_VERSION_1_4}+mkVersion "CairoPdfVersion1_5" #{const CAIRO_PDF_VERSION_1_5}++cairoPdfSurfaceRestrictToVersion :: PrimMonad m =>+	CairoSurfacePdfT s (PrimState m) -> CairoPdfVersionT -> m ()+cairoPdfSurfaceRestrictToVersion (CairoSurfacePdfT fsr _) (CairoPdfVersionT v) =+	unsafeIOToPrim $ withForeignPtr fsr \psr ->+		c_cairo_pdf_surface_restrict_to_version psr v++foreign import ccall "cairo_pdf_surface_restrict_to_version" c_cairo_pdf_surface_restrict_to_version ::+	Ptr (CairoSurfaceT s ps) -> #{type cairo_pdf_version_t} -> IO ()++cairoPdfGetVersions :: IO [CairoPdfVersionT]+cairoPdfGetVersions = (CairoPdfVersionT <$>) <$> alloca \ppv -> alloca \pn -> do+	c_cairo_pdf_get_versions ppv pn+	n <- peek pn+	peekArray (fromIntegral n) =<< peek ppv++foreign import ccall "cairo_pdf_get_versions" c_cairo_pdf_get_versions ::+	Ptr (Ptr #{type cairo_pdf_version_t}) -> Ptr CInt -> IO ()++cairoPdfVersionToString :: CairoPdfVersionT -> IO String+cairoPdfVersionToString (CairoPdfVersionT v) = peekCString =<< c_cairo_pdf_version_to_string v++foreign import ccall "cairo_pdf_version_to_string" c_cairo_pdf_version_to_string ::+	#{type cairo_pdf_version_t} -> IO CString
+ src/Graphics/Cairo/Surfaces/PdfSurfaces/Template.hsc view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.PdfSurfaces.Template where++import Language.Haskell.TH+import Data.Word+import Graphics.Cairo.Template++#include <cairo-pdf.h>++newtype CairoPdfOutlineFlagsT = CairoPdfOutlineFlagsT #{type cairo_pdf_outline_flags_t} deriving Show++mkOFlag :: String -> Integer -> DecsQ+mkOFlag = mkMemberGen ''CairoPdfOutlineFlagsT 'CairoPdfOutlineFlagsT++newtype CairoPdfMetadataT = CairoPdfMetadataT #{type cairo_pdf_metadata_t} deriving Show++mkMeta :: String -> Integer -> DecsQ+mkMeta = mkMemberGen ''CairoPdfMetadataT 'CairoPdfMetadataT++newtype CairoPdfVersionT = CairoPdfVersionT #{type cairo_pdf_version_t} deriving Show++mkVersion :: String -> Integer -> DecsQ+mkVersion = mkMemberGen ''CairoPdfVersionT 'CairoPdfVersionT
+ src/Graphics/Cairo/Surfaces/PngSupport.hsc view
@@ -0,0 +1,71 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.PngSupport (+	cairoSurfaceCreateFromPng, cairoSurfaceCreateFromPngByteString,+	cairoSurfaceWriteToPng+	) where++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal.Utils+import Foreign.C+import Control.Monad.Primitive+import Control.Concurrent.STM+import Data.Word+import Data.ByteString qualified as BS+import Data.ByteString.Internal qualified as BS++import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+import Graphics.Cairo.Exception++import Graphics.Cairo.Surfaces.ImageSurfaces++#include <cairo.h>++foreign import ccall "cairo_surface_write_to_png" c_cairo_surface_write_to_png ::+	Ptr (CairoSurfaceT s ps) -> CString -> IO #type cairo_status_t++cairoSurfaceWriteToPng :: IsCairoSurfaceT sfc => sfc s ps -> FilePath -> IO CairoStatusT+cairoSurfaceWriteToPng (toCairoSurfaceT -> CairoSurfaceT s) fp = withCString fp \cs -> CairoStatusT+	<$> (withForeignPtr s \p -> c_cairo_surface_write_to_png p cs)++foreign import ccall "cairo_image_surface_create_from_png" c_cairo_surface_create_from_png ::+	CString -> IO (Ptr (CairoSurfaceT s ps))++cairoSurfaceCreateFromPng :: FilePath -> IO (CairoSurfaceImageT s ps)+cairoSurfaceCreateFromPng fp = withCString fp \cs ->+	mkCairoSurfaceImageT =<< c_cairo_surface_create_from_png cs++cairoSurfaceCreateFromPngByteString :: PrimMonad m =>+	BS.ByteString -> m (CairoSurfaceImageT s (PrimState m))+cairoSurfaceCreateFromPngByteString bs = unsafeIOToPrim do+	tbs <- atomically $ newTVar bs+	fn <- c_cairo_read_func_t $ byteStringToCCairoReadFunc tbs+	mkCairoSurfaceImageT+		=<< c_cairo_image_surface_create_from_png_stream fn nullPtr++foreign import ccall "cairo_image_surface_create_from_png_stream"+	c_cairo_image_surface_create_from_png_stream ::+	FunPtr (CCairoReadFunc a) -> Ptr a -> IO (Ptr (CairoSurfaceT s ps))++type CCairoReadFunc a = Ptr a -> CString -> #{type unsigned int} -> IO #{type cairo_status_t}++foreign import ccall "wrapper" c_cairo_read_func_t ::+	CCairoReadFunc a -> IO (FunPtr (CCairoReadFunc a))++byteStringToCCairoReadFunc :: TVar BS.ByteString -> CCairoReadFunc a+byteStringToCCairoReadFunc tbs _cls dt ln = do+	bs <- atomically $ readTVar tbs+	if BS.length bs < (fromIntegral ln) then+		pure #{const CAIRO_STATUS_READ_ERROR} else do+		tx' <- atomically do+			let	(tx, bs') = BS.splitAt (fromIntegral ln) bs+			writeTVar tbs bs'+			pure tx+		let	(fptr, ln') = BS.toForeignPtr0 tx'+		withForeignPtr fptr \ptr -> do+			copyBytes dt (castPtr ptr) ln'+			pure #{const CAIRO_STATUS_SUCCESS}
+ src/Graphics/Cairo/Surfaces/SvgSurfaces.hsc view
@@ -0,0 +1,131 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.SvgSurfaces where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Control.Monad.Primitive+import Data.Word+import System.IO.Unsafe+import Graphics.Cairo.Exception+import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal+import Graphics.Cairo.Surfaces.CairoSurfaceTypeT++import qualified Data.Text as T++import Graphics.Cairo.Surfaces.CairoWriteFuncT+import Graphics.Cairo.Surfaces.SvgSurfaces.Template++#include <cairo.h>+#include <cairo-svg.h>++newtype CairoSurfaceSvgT s ps = CairoSurfaceSvgT (ForeignPtr (CairoSurfaceT s ps)) deriving Show++pattern CairoSurfaceTSvg :: CairoSurfaceSvgT s ps -> CairoSurfaceT s ps+pattern CairoSurfaceTSvg sr <- (cairoSurfaceTSvg -> Just sr) where+	CairoSurfaceTSvg = toCairoSurfaceT++cairoSurfaceTSvg :: CairoSurfaceT s ps -> Maybe (CairoSurfaceSvgT s ps)+cairoSurfaceTSvg sr@(CairoSurfaceT fsr) = case cairoSurfaceGetType sr of+	CairoSurfaceTypeSvg -> Just $ CairoSurfaceSvgT fsr+	_ -> Nothing++instance IsCairoSurfaceT CairoSurfaceSvgT where+	toCairoSurfaceT (CairoSurfaceSvgT fsr) = CairoSurfaceT fsr++foreign import ccall "cairo_svg_surface_create" c_cairo_svg_surface_create ::+	CString -> CDouble -> CDouble -> IO (Ptr (CairoSurfaceT s ps))++cairoSvgSurfaceWith :: FilePath -> CDouble -> CDouble -> (forall s . CairoSurfaceSvgT s RealWorld -> IO a) -> IO a+cairoSvgSurfaceWith fp w h f = do+	sr@(CairoSurfaceSvgT fsr) <- cairoSvgSurfaceCreate fp w h+	f sr <* withForeignPtr fsr c_cairo_surface_finish+	++cairoSvgSurfaceCreate :: FilePath -> CDouble -> CDouble -> IO (CairoSurfaceSvgT s RealWorld)+cairoSvgSurfaceCreate fp w h = withCString fp \cs -> do+	p <- c_cairo_svg_surface_create cs w h+	mkCairoSurfaceSvgT p <* raiseIfErrorPtrSurface p++foreign import ccall "cairo_svg_surface_create_for_stream" c_cairo_svg_surface_create_for_stream ::+	FunPtr (Ptr a -> CString -> CInt -> IO #{type cairo_status_t}) -> Ptr a -> CDouble -> CDouble -> IO (Ptr (CairoSurfaceT s ps))++cairoSvgSurfaceWithForStream :: PrimBase m => (Ptr a -> T.Text -> m WriteResult) -> Ptr a -> CDouble -> CDouble ->+	(forall s . CairoSurfaceSvgT s (PrimState m) -> m a) -> m a+cairoSvgSurfaceWithForStream wf cl w h f = do+	sr@(CairoSurfaceSvgT fsr) <- cairoSvgSurfaceCreateForStream wf cl w h+	f sr <* unsafeIOToPrim (withForeignPtr fsr c_cairo_surface_finish)++cairoSvgSurfaceCreateForStream :: PrimBase m =>+	(Ptr a -> T.Text -> m WriteResult) -> Ptr a -> CDouble -> CDouble -> m (CairoSurfaceSvgT s (PrimState m))+cairoSvgSurfaceCreateForStream wf cl w h = unsafeIOToPrim do+	p <- (wrapCairoWriteFuncTText wf >>= \pwf ->+		c_cairo_svg_surface_create_for_stream pwf cl w h)+	sr <- mkCairoSurfaceSvgT p+	sr <$ raiseIfErrorPtrSurface p++mkCairoSurfaceSvgT :: Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceSvgT s ps)+mkCairoSurfaceSvgT p = CairoSurfaceSvgT <$> newForeignPtr p (c_cairo_surface_destroy p)++mkUnitMember "CairoSvgUnitUser" #{const CAIRO_SVG_UNIT_USER}+mkUnitMember "CairoSvgUnitEm" #{const CAIRO_SVG_UNIT_EM}+mkUnitMember "CairoSvgUnitEx" #{const CAIRO_SVG_UNIT_EX}+mkUnitMember "CairoSvgUnitPx" #{const CAIRO_SVG_UNIT_PX}+mkUnitMember "CairoSvgUnitIn" #{const CAIRO_SVG_UNIT_IN}+mkUnitMember "CairoSvgUnitCm" #{const CAIRO_SVG_UNIT_CM}+mkUnitMember "CairoSvgUnitMm" #{const CAIRO_SVG_UNIT_MM}+mkUnitMember "CairoSvgUnitPt" #{const CAIRO_SVG_UNIT_PT}+mkUnitMember "CairoSvgUnitPc" #{const CAIRO_SVG_UNIT_PC}+mkUnitMember "CAiroSvgUnitPercent" #{const CAIRO_SVG_UNIT_PERCENT}++cairoSvgSurfaceGetDocumentUnit :: PrimMonad m =>+	CairoSurfaceSvgT s (PrimState m) -> m CairoSvgUnitT+cairoSvgSurfaceGetDocumentUnit (CairoSurfaceSvgT fsr) = unsafeIOToPrim+	$ CairoSvgUnitT <$> withForeignPtr fsr c_cairo_svg_surface_get_document_unit++foreign import ccall "cairo_svg_surface_get_document_unit" c_cairo_svg_surface_get_document_unit ::+	Ptr (CairoSurfaceT s ps) -> IO #{type cairo_svg_unit_t}++cairoSvgSurfaceSetDocumentUnit :: PrimMonad m =>+	CairoSurfaceSvgT s (PrimState m) -> CairoSvgUnitT -> m ()+cairoSvgSurfaceSetDocumentUnit (CairoSurfaceSvgT fsr) (CairoSvgUnitT u) =+	unsafeIOToPrim $ withForeignPtr fsr \psr -> c_cairo_svg_surface_set_document_unit psr u++foreign import ccall "cairo_svg_surface_set_document_unit" c_cairo_svg_surface_set_document_unit ::+	Ptr (CairoSurfaceT s ps) -> #{type cairo_svg_unit_t} -> IO ()++mkVersionMember "CairoSvgVersion1_1" #{const CAIRO_SVG_VERSION_1_1}+mkVersionMember "CairoSvgVersion1_2" #{const CAIRO_SVG_VERSION_1_2}++cairoSvgSurfaceRestrictToVersion :: PrimMonad m =>+	CairoSurfaceSvgT s (PrimState m) -> CairoSvgVersionT -> m ()+cairoSvgSurfaceRestrictToVersion (CairoSurfaceSvgT fsr) (CairoSvgVersionT v) =+	unsafeIOToPrim $ withForeignPtr fsr \psr -> c_cairo_svg_surface_restrict_to_version psr v++foreign import ccall "cairo_svg_surface_restrict_to_version" c_cairo_svg_surface_restrict_to_version ::+	Ptr (CairoSurfaceT s ps) -> #{type cairo_svg_version_t} -> IO ()++cairoSvgGetVersions :: IO [CairoSvgVersionT]+cairoSvgGetVersions = (CairoSvgVersionT <$>) <$> alloca \pvs -> alloca \pn -> do+	c_cairo_svg_surface_get_versions pvs pn+	n <- peek pn+	peekArray (fromIntegral n) =<< peek pvs++foreign import ccall "cairo_svg_get_versions" c_cairo_svg_surface_get_versions ::+	Ptr (Ptr #{type cairo_svg_version_t}) -> Ptr CInt -> IO ()++cairoSvgVersionToString :: CairoSvgVersionT -> String+cairoSvgVersionToString (CairoSvgVersionT v) = unsafePerformIO do+	peekCString =<< c_cairo_svg_version_to_string v++foreign import ccall "cairo_svg_version_to_string" c_cairo_svg_version_to_string ::+	#{type  cairo_svg_version_t} -> IO CString
+ src/Graphics/Cairo/Surfaces/SvgSurfaces/Template.hsc view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Surfaces.SvgSurfaces.Template where++import Language.Haskell.TH+import Data.Word+import Graphics.Cairo.Template++#include <cairo-svg.h>++newtype CairoSvgUnitT = CairoSvgUnitT #{type cairo_svg_unit_t} deriving Show++mkUnitMember :: String -> Integer -> DecsQ+mkUnitMember = mkMemberGen ''CairoSvgUnitT 'CairoSvgUnitT++newtype CairoSvgVersionT = CairoSvgVersionT #{type cairo_svg_version_t}+	deriving Show++mkVersionMember :: String -> Integer -> DecsQ+mkVersionMember = mkMemberGen ''CairoSvgVersionT 'CairoSvgVersionT
+ src/Graphics/Cairo/Template.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Template where++import Language.Haskell.TH++mkMemberGen :: Name -> Name -> String -> Integer -> DecsQ+mkMemberGen t c n v = sequence [+	patSynSigD (mkName n) (conT t),+	patSynD (mkName n) (prefixPatSyn [])+		(explBidir [clause [] (normalB (conE c `appE` litE (IntegerL v))) []])+		(conP c [litP (IntegerL v)])+	]
+ src/Graphics/Cairo/Types.hsc view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Types where++import Foreign.Storable+import Data.Int++#include <cairo.h>++data CairoTextExtentsT = CairoTextExtentsT {+	cairoTextExtentsTXBearing :: #{type double},+	cairoTextExtentsTYBearing :: #{type double},+	cairoTextExtentsTWidth :: #{type double},+	cairoTextExtentsTHeight :: #{type double},+	cairoTextExtentsTXAdvance :: #{type double},+	cairoTextExtentsTYAdvance :: #{type double} } deriving Show++instance Storable CairoTextExtentsT where+	sizeOf _ = #{size cairo_text_extents_t}+	alignment _ = #{alignment cairo_text_extents_t}+	peek p = CairoTextExtentsT+		<$> #{peek cairo_text_extents_t, x_bearing} p+		<*> #{peek cairo_text_extents_t, y_bearing} p+		<*> #{peek cairo_text_extents_t, width} p+		<*> #{peek cairo_text_extents_t, height} p+		<*> #{peek cairo_text_extents_t, x_advance} p+		<*> #{peek cairo_text_extents_t, y_advance} p+	poke p (CairoTextExtentsT xb yb w h xa ya) = do+		#{poke cairo_text_extents_t, x_bearing} p xb+		#{poke cairo_text_extents_t, y_bearing} p yb+		#{poke cairo_text_extents_t, width} p w+		#{poke cairo_text_extents_t, height} p h+		#{poke cairo_text_extents_t, x_advance} p xa+		#{poke cairo_text_extents_t, y_advance} p ya
+ src/Graphics/Cairo/Utilities/CairoMatrixT.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Utilities.CairoMatrixT (+	Matrix(..), IsCairoMatrixT, CairoMatrixT, CairoMatrixRegularT,+	cairoMatrixGet, cairoMatrixCopyFromRegular,+	cairoMatrixNew, cairoMatrixRegularNew, cairoMatrixNewIdentity,+	cairoMatrixNewTranslate,+	cairoMatrixNewScale, cairoMatrixRegularNewScale, cairoMatrixNewRotate,+	cairoMatrixTranslate, cairoMatrixScale, cairoMatrixRotate, cairoMatrixInvert,+	cairoMatrixMultiply,+	Distance(..), cairoMatrixTransformDistance,+	Point(..), cairoMatrixTransformPoint ) where++import Graphics.Cairo.Utilities.CairoMatrixT.Internal
+ src/Graphics/Cairo/Utilities/CairoMatrixT/Internal.hsc view
@@ -0,0 +1,211 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeApplications, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Utilities.CairoMatrixT.Internal (+	Matrix(..), IsCairoMatrixT(..),+	CairoMatrixT(..), CairoMatrixRegularT, cairoMatrixCopyFromRegular,+	cairoMatrixAlloc, cairoMatrixGet,+	cairoMatrixNew, cairoMatrixRegularNew,+	cairoMatrixNewIdentity,+	cairoMatrixNewTranslate,+	cairoMatrixNewScale, cairoMatrixRegularNewScale, cairoMatrixNewRotate,+	cairoMatrixTranslate, cairoMatrixScale, cairoMatrixRotate, cairoMatrixInvert,+	cairoMatrixMultiply,+	Distance(..), cairoMatrixTransformDistance,+	Point(..), cairoMatrixTransformPoint ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad+import Control.Monad.Primitive+import Data.Word++import Graphics.Cairo.Exception++#include <cairo.h>++class IsCairoMatrixT mtx where+	toCairoMatrixT :: mtx s -> CairoMatrixT s+	fromCairoMatrixT :: CairoMatrixT s -> mtx s++withCairoMatrixT :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> (Ptr (CairoMatrixT (PrimState m)) -> IO a) -> m a+withCairoMatrixT (toCairoMatrixT -> CairoMatrixT fmtx) = unsafeIOToPrim . withForeignPtr fmtx++newtype CairoMatrixT s = CairoMatrixT (ForeignPtr (CairoMatrixT s)) deriving Show++instance IsCairoMatrixT CairoMatrixT where+	toCairoMatrixT = id+	fromCairoMatrixT = id++newtype CairoMatrixRegularT s = CairoMatrixRegularT (ForeignPtr (CairoMatrixT s)) deriving Show++instance IsCairoMatrixT CairoMatrixRegularT where+	toCairoMatrixT (CairoMatrixRegularT f) = CairoMatrixT f+	fromCairoMatrixT (CairoMatrixT f) = CairoMatrixRegularT f++cairoMatrixAlloc :: PrimMonad m =>+	(Ptr (CairoMatrixT (PrimState m)) -> IO a) ->+	m (ForeignPtr (CairoMatrixT (PrimState m)))+cairoMatrixAlloc f = unsafeIOToPrim do+	p <- mallocBytes #{size cairo_matrix_t}+	(($) <$> newForeignPtr <*> free $ p) <* f p++data Matrix = Matrix CDouble CDouble CDouble CDouble CDouble CDouble deriving Show++cairoMatrixGet :: (PrimMonad m, IsCairoMatrixT mtx) => mtx (PrimState m) -> m Matrix+cairoMatrixGet mtx = withCairoMatrixT mtx \p -> Matrix+	<$> #{peek cairo_matrix_t, xx} p <*> #{peek cairo_matrix_t, yx} p+	<*> #{peek cairo_matrix_t, xy} p <*> #{peek cairo_matrix_t, yy} p+	<*> #{peek cairo_matrix_t, x0} p <*> #{peek cairo_matrix_t, y0} p++cairoMatrixNew :: PrimMonad m =>+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> +	m (CairoMatrixT (PrimState m))+cairoMatrixNew xx yx xy yy x0 y0 = CairoMatrixT+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init p xx yx xy yy x0 y0++cairoMatrixRegularNew :: PrimMonad m =>+	CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> +	m (Either (CairoMatrixT (PrimState m)) (CairoMatrixRegularT (PrimState m)))+cairoMatrixRegularNew xx yx xy yy x0 y0 = mk+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init p xx yx xy yy x0 y0+	where mk = case xx * yy - yx * xy of+		0 -> Left . CairoMatrixT; _ -> Right . CairoMatrixRegularT++foreign import ccall "cairo_matrix_init" c_cairo_matrix_init ::+	Ptr (CairoMatrixT s) -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++cairoMatrixNewIdentity :: (PrimMonad m, IsCairoMatrixT mtx) => m (mtx (PrimState m))+cairoMatrixNewIdentity = fromCairoMatrixT . CairoMatrixT+	<$> cairoMatrixAlloc c_cairo_matrix_init_identity++foreign import ccall "cairo_matrix_init_identity" c_cairo_matrix_init_identity ::+	Ptr (CairoMatrixT s) -> IO ()++cairoMatrixNewTranslate :: (PrimMonad m, IsCairoMatrixT mtx) =>+	CDouble -> CDouble -> m (mtx (PrimState m))+cairoMatrixNewTranslate tx ty = fromCairoMatrixT . CairoMatrixT+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init_translate p tx ty++foreign import ccall "cairo_matrix_init_translate" c_cairo_matrix_init_translate ::+	Ptr (CairoMatrixT s) -> CDouble -> CDouble -> IO ()++cairoMatrixNewScale :: PrimMonad m =>+	CDouble -> CDouble -> m (CairoMatrixT (PrimState m))+cairoMatrixNewScale sx sy = CairoMatrixT+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init_scale p sx sy++cairoMatrixRegularNewScale :: PrimMonad m =>+	CDouble -> CDouble ->+	m (Either (CairoMatrixT (PrimState m)) (CairoMatrixRegularT (PrimState m)))+cairoMatrixRegularNewScale sx sy = mk+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init_scale p sx sy+	where mk = case (sx, sy) of+		(_, 0) -> Left . CairoMatrixT+		(0, _) -> Left . CairoMatrixT+		_ -> Right . CairoMatrixRegularT++foreign import ccall "cairo_matrix_init_scale" c_cairo_matrix_init_scale ::+	Ptr (CairoMatrixT s) -> CDouble -> CDouble -> IO ()++cairoMatrixNewRotate :: (PrimMonad m, IsCairoMatrixT mtx) => CDouble -> m (mtx (PrimState m))+cairoMatrixNewRotate rad = fromCairoMatrixT . CairoMatrixT+	<$> cairoMatrixAlloc \p -> c_cairo_matrix_init_rotate p rad++foreign import ccall "cairo_matrix_init_rotate" c_cairo_matrix_init_rotate ::+	Ptr (CairoMatrixT s) -> CDouble -> IO ()++cairoMatrixTranslate :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> CDouble -> CDouble -> m ()+cairoMatrixTranslate mtx tx ty =+	withCairoMatrixT mtx \p -> c_cairo_matrix_translate p tx ty++foreign import ccall "cairo_matrix_translate" c_cairo_matrix_translate ::+	Ptr (CairoMatrixT s) -> CDouble -> CDouble -> IO ()++cairoMatrixScale :: PrimMonad m =>+	CairoMatrixT (PrimState m) -> CDouble -> CDouble -> m ()+cairoMatrixScale mtx sx sy =+	withCairoMatrixT mtx \p -> c_cairo_matrix_scale p sx sy++foreign import ccall "cairo_matrix_scale" c_cairo_matrix_scale ::+	Ptr (CairoMatrixT s) -> CDouble -> CDouble -> IO ()++cairoMatrixRotate :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> CDouble -> m ()+cairoMatrixRotate mtx rad =+	withCairoMatrixT mtx \p -> c_cairo_matrix_rotate p rad++foreign import ccall "cairo_matrix_rotate" c_cairo_matrix_rotate ::+	Ptr (CairoMatrixT s) -> CDouble -> IO ()++cairoMatrixInvert :: PrimMonad m =>+	CairoMatrixRegularT (PrimState m) -> m ()+cairoMatrixInvert (CairoMatrixRegularT fmtx) =+	unsafeIOToPrim $ withForeignPtr fmtx \pmtx ->+		cairoStatusToThrowError =<< c_cairo_matrix_invert pmtx++foreign import ccall "cairo_matrix_invert" c_cairo_matrix_invert ::+	Ptr (CairoMatrixT s) -> IO #{type cairo_status_t}++cairoMatrixMultiply :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> mtx (PrimState m) -> mtx (PrimState m) -> m ()+cairoMatrixMultiply+	(toCairoMatrixT -> CairoMatrixT fr)+	(toCairoMatrixT -> CairoMatrixT fa)+	(toCairoMatrixT -> CairoMatrixT fb) = unsafeIOToPrim+	$ withForeignPtr fr \pr -> withForeignPtr fa \pa -> withForeignPtr fb \pb ->+		c_cairo_matrix_multiply pr pa pb++foreign import ccall "cairo_matrix_multiply" c_cairo_matrix_multiply ::+	Ptr (CairoMatrixT s) -> Ptr (CairoMatrixT s) -> Ptr (CairoMatrixT s) -> IO ()++data Distance = Distance CDouble CDouble deriving Show++cairoMatrixTransformDistance :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> Distance -> m Distance+cairoMatrixTransformDistance mtx (Distance dx dy) =+	withCairoMatrixT mtx \pmtx -> alloca \pdx -> alloca \pdy -> do+		zipWithM_ poke [pdx, pdy] [dx, dy]+		c_cairo_matrix_transform_distance pmtx pdx pdy+		Distance <$> peek pdx <*> peek pdy++foreign import ccall "cairo_matrix_transform_distance" c_cairo_matrix_transform_distance ::+	Ptr (CairoMatrixT s) -> Ptr CDouble -> Ptr CDouble -> IO ()++data Point = Point CDouble CDouble deriving Show++cairoMatrixTransformPoint :: (PrimMonad m, IsCairoMatrixT mtx) =>+	mtx (PrimState m) -> Point -> m Point+cairoMatrixTransformPoint mtx (Point x y) =+	withCairoMatrixT mtx \pmtx -> alloca \px -> alloca \py -> do+		zipWithM_ poke [px, py] [x, y]+		c_cairo_matrix_transform_point pmtx px py+		Point <$> peek px <*> peek py++foreign import ccall "cairo_matrix_transform_point" c_cairo_matrix_transform_point ::+	Ptr (CairoMatrixT s) -> Ptr CDouble -> Ptr CDouble -> IO ()++cairoMatrixCopyFromRegular :: PrimMonad m =>+	CairoMatrixRegularT (PrimState m) -> m (CairoMatrixT (PrimState m))+cairoMatrixCopyFromRegular (CairoMatrixRegularT fmtx) = unsafeIOToPrim+	$ CairoMatrixT <$> withForeignPtr fmtx \pmtx -> do+		p <- cairoMatrixCopy pmtx+		newForeignPtr p (free p)++cairoMatrixCopy :: Ptr (CairoMatrixT s) -> IO (Ptr (CairoMatrixT s))+cairoMatrixCopy p0 = do+	p <- mallocBytes #{size cairo_matrix_t}+	#{poke cairo_matrix_t, xx} p =<< (#{peek cairo_matrix_t, xx} p0 :: IO CDouble)+	#{poke cairo_matrix_t, yx} p =<< (#{peek cairo_matrix_t, yx} p0 :: IO CDouble)+	#{poke cairo_matrix_t, xy} p =<< (#{peek cairo_matrix_t, xy} p0 :: IO CDouble)+	#{poke cairo_matrix_t, yy} p =<< (#{peek cairo_matrix_t, yy} p0 :: IO CDouble)+	#{poke cairo_matrix_t, x0} p =<< (#{peek cairo_matrix_t, x0} p0 :: IO CDouble)+	#{poke cairo_matrix_t, y0} p =<< (#{peek cairo_matrix_t, y0} p0 :: IO CDouble)+	pure p
+ src/Graphics/Cairo/Utilities/Types.hsc view
@@ -0,0 +1,45 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Utilities.Types where++import Foreign.Ptr+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.Struct+import Control.Monad.Primitive++#include <cairo.h>++struct "CairoRectangleIntT" #{size cairo_rectangle_int_t}+		#{alignment cairo_rectangle_int_t}+	[	("x", ''CInt, [| #{peek cairo_rectangle_int_t, x} |],+			[| #{poke cairo_rectangle_int_t, x} |]),+		("y", ''CInt, [| #{peek cairo_rectangle_int_t, y} |],+			[| #{poke cairo_rectangle_int_t, y} |]),+		("width", ''CInt, [| #{peek cairo_rectangle_int_t, width} |],+			[| #{poke cairo_rectangle_int_t, width} |]),+		("height", ''CInt, [| #{peek cairo_rectangle_int_t, height} |],+			[| #{poke cairo_rectangle_int_t, height} |]) ]+	[''Show]++c_cairo_rectangle_int_t_copy ::+	Ptr CairoRectangleIntT -> IO (Ptr CairoRectangleIntT)+c_cairo_rectangle_int_t_copy s = do+	d <- mallocBytes #{size cairo_rectangle_int_t}+	d <$ copyBytes d s #{size cairo_rectangle_int_t}++c_cairo_rectangle_int_t_free :: Ptr CairoRectangleIntT -> IO ()+c_cairo_rectangle_int_t_free = free++structPrim "CairoRectangleIntT"+	'c_cairo_rectangle_int_t_copy 'c_cairo_rectangle_int_t_free [''Show]++cairoRectangleIntTNew :: PrimMonad m => m (CairoRectangleIntTPrim (PrimState m))+cairoRectangleIntTNew = CairoRectangleIntTPrim <$> unsafeIOToPrim do+	p <- mallocBytes #{size cairo_rectangle_int_t}+	newForeignPtr p $ free p
+ src/Graphics/Cairo/Values.hsc view
@@ -0,0 +1,25 @@+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Cairo.Values where++import Data.Word+import Data.Int++#include <cairo.h>++newtype CairoFontSlantT = CairoFontSlantT #{type cairo_font_slant_t} deriving Show++#enum CairoFontSlantT, CairoFontSlantT, CAIRO_FONT_SLANT_NORMAL, \+	CAIRO_FONT_SLANT_ITALIC, CAIRO_FONT_SLANT_OBLIQUE++newtype CairoFontWeightT = CairoFontWeightT #{type cairo_font_weight_t} deriving Show++#enum CairoFontWeightT, CairoFontWeightT, \+	CAIRO_FONT_WEIGHT_NORMAL, CAIRO_FONT_WEIGHT_BOLD++newtype CairoFormatT = CairoFormatT #{type cairo_format_t} deriving Show++#enum CairoFormatT, CairoFormatT, CAIRO_FORMAT_INVALID, CAIRO_FORMAT_ARGB32, \+	CAIRO_FORMAT_RGB24, CAIRO_FORMAT_A8, CAIRO_FORMAT_A1, \+	CAIRO_FORMAT_RGB16_565, CAIRO_FORMAT_RGB30
+ test/Title.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Title where++import Data.Char++titleWidth :: Int+titleWidth = 80++titleWidthHalf1, titleWidthHalf2 :: Int+titleWidthHalf1 = titleWidth `div` 2+titleWidthHalf2 = titleWidth - titleWidthHalf1++mkTitle :: String -> String+mkTitle ttl =+	replicate titleWidth '*' ++ "\n" +++	"*" ++ replicate (titleWidthHalf1 - 1 - s2) ' ' +++		ttl' ++ replicate (titleWidthHalf2 - 1 - s1) ' ' ++ "*\n" ++ +	replicate titleWidth '*' ++ "\n"+	where+	ttl' = toUpper <$> ttl+	s = length ttl; s1 = s `div` 2; s2 = s - s1
+ test/cairo-image-test.hs view
@@ -0,0 +1,17 @@+{-# OPTIOnS_GHC -Wall -fno-warn-tabs #-}++module Main where++import Data.Word+import Data.CairoImage++main :: IO ()+main = do+	let	pxl = PixelArgb32 0x01 0x02 0x03 0x04+		PixelArgb32 a r g b = pxl+	print pxl+	print (a, r, g, b)++foo :: (Word8, Word8, Word8, Word8)+foo = case PixelArgb32 0x01 0x02 0x03 0x04 of+	PixelArgb32 a r g b -> (a, r, g, b)
+ test/exception.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++import Graphics.Cairo.Values+import Graphics.Cairo.Drawing.CairoT+import Graphics.Cairo.Drawing.Paths+import Graphics.Cairo.Surfaces.ImageSurfaces+import Graphics.Cairo.Monad++main :: IO ()+main = do+	s <- cairoImageSurfaceCreate cairoFormatArgb32 500 500+	cr <- cairoCreate s+	cairoLineTo cr 100 100+	cairoNewPath cr+	cairoLineTo cr 0 0+	cairoStroke cr+	cairoPopGroupToSource cr+	print =<< cairoImageSurfaceGetData s
+ test/test-rotate.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++import Graphics.Cairo.Exception+import Graphics.Cairo.Values+import Graphics.Cairo.Drawing.CairoT+import Graphics.Cairo.Drawing.CairoPatternT+import Graphics.Cairo.Drawing.Transformations+import Graphics.Cairo.Surfaces.ImageSurfaces+import Graphics.Cairo.Surfaces.PngSupport++import Paths_simple_cairo++main :: IO ()+main = do+	putStrLn "*** TEST ROTATE BEGIN ***"+	sfc0 <- cairoImageSurfaceCreate cairoFormatArgb32 256 256+	cr <- cairoCreate sfc0+	sfc <- cairoSurfaceCreateFromPng =<< getDataFileName "HaskellLogo.png"+	ptn <- cairoPatternCreateForSurface sfc+	cairoTranslate cr 128 ((256 - sqrt 2 * 128) / 2)+	cairoRotate cr (pi / 4)+	cairoSetSource cr ptn+	cairoPaint cr+	cairoStatusToThrowError . (\(CairoStatusT w) -> w) =<< cairoSurfaceWriteToPng sfc0 "HaskellLogoRotated.png"+	putStrLn "*** TEST ROTATE END ***"+