cairo-0.13.1.0/0000755000000000000000000000000012474505512011222 5ustar0000000000000000cairo-0.13.1.0/cairo-gtk2hs.h0000644000000000000000000000046612474505512013676 0ustar0000000000000000#include #define CAIRO_CHECK_VERSION(major,minor,micro) \ (CAIRO_VERSION >= CAIRO_VERSION_ENCODE(major,minor,micro)) #ifdef CAIRO_HAS_PDF_SURFACE #include #endif #ifdef CAIRO_HAS_PS_SURFACE #include #endif #ifdef CAIRO_HAS_SVG_SURFACE #include #endif cairo-0.13.1.0/cairo.cabal0000644000000000000000000000700312474505512013303 0ustar0000000000000000Name: cairo Version: 0.13.1.0 License: BSD3 License-file: COPYRIGHT Copyright: (c) 2001-2010 The Gtk2Hs Team, (c) Paolo Martini 2005, (c) Abraham Egnor 2003, 2004, (c) Aetion Technologies LLC 2004 Author: Axel Simon, Duncan Coutts Maintainer: gtk2hs-users@lists.sourceforge.net Build-Type: Custom Cabal-Version: >= 1.18 Stability: stable homepage: http://projects.haskell.org/gtk2hs/ bug-reports: https://github.com/gtk2hs/gtk2hs/issues Synopsis: Binding to the Cairo library. Description: Cairo is a library to render high quality vector graphics. There exist various backends that allows rendering to Gtk windows, PDF, PS, PNG and SVG documents, amongst others. Category: Graphics Tested-With: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.1 extra-source-files: cairo-gtk2hs.h SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs Data-Dir: demo Data-Files: cairo-clock-icon.png CairoGhci.hs Clock.hs Drawing2.hs Drawing.hs Graph.hs Makefile StarAndRing.hs Text.hs Source-Repository head type: git location: https://github.com/gtk2hs/gtk2hs subdir: cairo Flag cairo_pdf Description: Build the PDF backend of Cairo. Flag cairo_ps Description: Build the PostScript backend of Cairo. Flag cairo_svg Description: Build the Scalable Vector Graphics (SVG) backend of Cairo. Library build-depends: base >= 4 && < 5, utf8-string >= 0.2 && < 1.1, text >= 1.0.0.0 && < 1.3, bytestring, mtl, array build-tools: gtk2hsC2hs >= 0.13.12 exposed-modules: Graphics.Rendering.Cairo Graphics.Rendering.Cairo.Matrix Graphics.Rendering.Cairo.Types -- this module is only meant to be used by other -- modules implementing a Cairo interface Graphics.Rendering.Cairo.Internal other-modules: Graphics.Rendering.Cairo.Internal.Drawing.Cairo Graphics.Rendering.Cairo.Internal.Drawing.Paths Graphics.Rendering.Cairo.Internal.Drawing.Patterns Graphics.Rendering.Cairo.Internal.Drawing.Text Graphics.Rendering.Cairo.Internal.Drawing.Transformations Graphics.Rendering.Cairo.Internal.Fonts.FontOptions Graphics.Rendering.Cairo.Internal.Surfaces.Image Graphics.Rendering.Cairo.Internal.Surfaces.PNG Graphics.Rendering.Cairo.Internal.Surfaces.Surface Graphics.Rendering.Cairo.Internal.Utilities Graphics.Rendering.Cairo.Internal.Surfaces.PDF Graphics.Rendering.Cairo.Internal.Surfaces.PS Graphics.Rendering.Cairo.Internal.Surfaces.SVG Graphics.Rendering.Cairo.Internal.Region default-language: Haskell98 default-extensions: ForeignFunctionInterface Include-dirs: . x-c2hs-Header: cairo-gtk2hs.h pkgconfig-depends: cairo >= 1.2.0 if flag(cairo_pdf) pkgconfig-depends: cairo-pdf if flag(cairo_ps) pkgconfig-depends: cairo-ps if flag(cairo_svg) pkgconfig-depends: cairo-svg cairo-0.13.1.0/COPYRIGHT0000644000000000000000000000266712474505512012530 0ustar0000000000000000All content in this archive is under the BSD License (follows), except where explicitly noted otherwise. Copyright (c) Paolo Martini 2005, (c) Abraham Egnor 2003, 2004, (c) Aetion Technologies LLC 2004 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. 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. cairo-0.13.1.0/Gtk2HsSetup.hs0000644000000000000000000005460612474505512013714 0ustar0000000000000000{-# LANGUAGE CPP, ViewPatterns #-} #ifndef CABAL_VERSION_CHECK #error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file #endif -- | Build a Gtk2hs package. -- module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages, checkGtk2hsBuildtools, typeGenProgram, signalGenProgram, c2hsLocal ) where import Distribution.Simple import Distribution.Simple.PreProcess import Distribution.InstalledPackageInfo ( importDirs, showInstalledPackageInfo, libraryDirs, extraLibraries, extraGHCiLibraries ) import Distribution.Simple.PackageIndex ( lookupInstalledPackageId ) import Distribution.PackageDescription as PD ( PackageDescription(..), updatePackageDescription, BuildInfo(..), emptyBuildInfo, allBuildInfo, Library(..), libModules, hasLibs) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms), InstallDirs(..), componentPackageDeps, absoluteInstallDirs) import Distribution.Simple.Compiler ( Compiler(..) ) import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), rawSystemProgramConf, rawSystemProgramStdoutConf, programName, programPath, c2hsProgram, pkgConfigProgram, gccProgram, requireProgram, ghcPkgProgram, simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) import Distribution.ModuleName ( ModuleName, components, toFilePath ) import Distribution.Simple.Utils import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..), defaultCopyFlags, ConfigFlags(configVerbosity), fromFlag, toFlag, RegisterFlags(..), flagToMaybe, fromFlagOrDefault, defaultRegisterFlags) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Install ( install ) import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) import Distribution.Text ( simpleParse, display ) import System.FilePath import System.Exit (exitFailure) import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist ) import Distribution.Version (Version(..)) import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList, catMaybes ) import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy, stripPrefix, tails ) import Data.Ord as Ord (comparing) import Data.Char (isAlpha, isNumber) import qualified Data.Map as M import qualified Data.Set as S import qualified Distribution.Simple.LocalBuildInfo as LBI import Distribution.Simple.Compiler (compilerVersion) import Control.Applicative ((<$>)) #if CABAL_VERSION_CHECK(1,17,0) import Distribution.Simple.Program.Find ( defaultProgramSearchPath ) onDefaultSearchPath f a b = f a b defaultProgramSearchPath libraryConfig lbi = case [clbi | (LBI.CLibName, clbi, _) <- LBI.componentsConfigs lbi] of [clbi] -> Just clbi _ -> Nothing #else onDefaultSearchPath = id libraryConfig = LBI.libraryConfig #endif -- the name of the c2hs pre-compiled header file precompFile = "precompchs.bin" gtk2hsUserHooks = simpleUserHooks { hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], hookedPreProcessors = [("chs", ourC2hs)], confHook = \pd cf -> (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)), postConf = \args cf pd lbi -> do genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi postConf simpleUserHooks args cf pd lbi, buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> buildHook simpleUserHooks pd lbi uh bf, copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >> installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), instHook = \pd lbi uh flags -> #if defined(mingw32_HOST_OS) || defined(__MINGW32__) installHook pd lbi uh flags >> installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest, regHook = registerHook #else instHook simpleUserHooks pd lbi uh flags >> installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest #endif } ------------------------------------------------------------------------------ -- Lots of stuff for windows ghci support ------------------------------------------------------------------------------ getDlls :: [FilePath] -> IO [FilePath] getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$> mapM getDirectoryContents dirs fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> case filter (isLib lib) dlls of dlls@(_:_) -> [dropExtension (pickDll dlls)] _ -> if lib == "z" then [] else [lib] where -- If there are several .dll files matching the one we're after then we -- just have to guess. For example for recent Windows cairo builds we get -- libcairo-2.dll libcairo-gobject-2.dll libcairo-script-interpreter-2.dll -- Our heuristic is to pick the one with the shortest name. -- Yes this is a hack but the proper solution is hard: we would need to -- parse the .a file and see which .dll file(s) it needed to link to. pickDll = minimumBy (Ord.comparing length) isLib lib dll = case stripPrefix ("lib"++lib) dll of Just ('.':_) -> True Just ('-':n:_) | isNumber n -> True _ -> False -- The following code is a big copy-and-paste job from the sources of -- Cabal 1.8 just to be able to fix a field in the package file. Yuck. installHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () installHook pkg_descr localbuildinfo _ flags = do let copyFlags = defaultCopyFlags { copyDistPref = installDistPref flags, copyDest = toFlag NoCopyDest, copyVerbosity = installVerbosity flags } install pkg_descr localbuildinfo copyFlags let registerFlags = defaultRegisterFlags { regDistPref = installDistPref flags, regInPlace = installInPlace flags, regPackageDB = installPackageDB flags, regVerbosity = installVerbosity flags } when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags registerHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO () registerHook pkg_descr localbuildinfo _ flags = if hasLibs pkg_descr then register pkg_descr localbuildinfo flags else setupMessage verbosity "Package contains no library to register:" (packageId pkg_descr) where verbosity = fromFlag (regVerbosity flags) register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () register pkg@PackageDescription { library = Just lib } lbi regFlags = do let clbi = LBI.getComponentLocalBuildInfo lbi LBI.CLibName installedPkgInfoRaw <- generateRegistrationInfo #if CABAL_VERSION_CHECK(1,22,0) verbosity pkg lib lbi clbi inplace False distPref packageDb #else verbosity pkg lib lbi clbi inplace distPref #endif dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw) installedPkgInfo = installedPkgInfoRaw { extraGHCiLibraries = libs } -- Three different modes: case () of _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo | modeGenerateRegScript -> die "Generate Reg Script not supported" | otherwise -> registerPackage verbosity installedPkgInfo pkg lbi inplace #if CABAL_VERSION_CHECK(1,10,0) packageDbs #else packageDb #endif where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) regFile = fromMaybe (display (packageId pkg) <.> "conf") (fromFlag (regGenPkgConf regFlags)) modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) packageDbs = nub $ withPackageDB lbi ++ maybeToList (flagToMaybe (regPackageDB regFlags)) packageDb = registrationPackageDB packageDbs distPref = fromFlag (regDistPref regFlags) verbosity = fromFlag (regVerbosity regFlags) writeRegistrationFile installedPkgInfo = do notice verbosity ("Creating package registration file: " ++ regFile) writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo) register _ _ regFlags = notice verbosity "No package to register" where verbosity = fromFlag (regVerbosity regFlags) ------------------------------------------------------------------------------ -- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later ------------------------------------------------------------------------------ adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo adjustLocalBuildInfo lbi = let extra = (Just libBi, []) libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi , buildDir lbi ] } in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) } ------------------------------------------------------------------------------ -- Processing .chs files with our local c2hs. ------------------------------------------------------------------------------ ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor ourC2hs bi lbi = PreProcessor { platformIndependent = False, runPreProcessor = runC2HS bi lbi } runC2HS :: BuildInfo -> LocalBuildInfo -> (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do -- have the header file name if we don't have the precompiled header yet header <- case lookup "x-c2hs-header" (customFieldsBI bi) of Just h -> return h Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++ "that sets the C header file to process .chs.pp files.") -- c2hs will output files in out dir, removing any leading path of the input file. -- Thus, append the dir of the input file to the output dir. let (outFileDir, newOutFile) = splitFileName outFile let newOutDir = outDir outFileDir -- additional .chi files might be needed that other packages have installed; -- we assume that these are installed in the same place as .hi files let chiDirs = [ dir | ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi), dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ] (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $ map ("--include=" ++) (outDir:chiDirs) ++ [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi] ++ ["--output-dir=" ++ newOutDir, "--output=" ++ newOutFile, "--precomp=" ++ buildDir lbi precompFile, header, inDir inFile] getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] getCppOptions bi lbi = nub $ ["-I" ++ dir | dir <- PD.includeDirs bi] ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] ++ ["-D__GLASGOW_HASKELL__="++show (ghcDefine . ghcVersion . compilerId $ LBI.compiler lbi)] where ghcDefine (v1:v2:_) = v1 * 100 + v2 ghcDefine _ = __GLASGOW_HASKELL__ ghcVersion :: CompilerId -> [Int] -- This version is nicer, but we need to know the Cabal version that includes the new CompilerId -- #if CABAL_VERSION_CHECK(1,19,2) -- ghcVersion (CompilerId GHC v _) = versionBranch v -- ghcVersion (CompilerId _ _ (Just c)) = ghcVersion c -- #else -- ghcVersion (CompilerId GHC v) = versionBranch v -- #endif -- ghcVersion _ = [] -- This version should work fine for now ghcVersion = concat . take 1 . map (read . (++"]") . takeWhile (/=']')) . catMaybes . map (stripPrefix "CompilerId GHC (Version {versionBranch = ") . tails . show installCHI :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step -> Verbosity -> CopyDest -- ^flags sent to copy or install -> IO () installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest -- cannot use the recommended 'findModuleFiles' since it fails if there exists -- a modules that does not have a .chi file mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) (PD.libModules lib) let files = [ f | Just f <- mFiles ] installOrdinaryFiles verbosity libPref files installCHI _ _ _ _ = return () ------------------------------------------------------------------------------ -- Generating the type hierarchy and signal callback .hs files. ------------------------------------------------------------------------------ typeGenProgram :: Program typeGenProgram = simpleProgram "gtk2hsTypeGen" signalGenProgram :: Program signalGenProgram = simpleProgram "gtk2hsHookGenerator" c2hsLocal :: Program c2hsLocal = (simpleProgram "gtk2hsC2hs") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "gtk2hsC2hs --version" gives a string like: -- C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004 case words str of (_:_:_:ver:_) -> ver _ -> "" } genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do cPkgs <- getPkgConfigPackages verb lbi pd let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) ++customFieldsPD pd typeOpts :: String -> [ProgArg] typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field ++ '=':val) (words content) | (field,content) <- xList, tag `isPrefixOf` field, field /= (tag++"file")] ++ [ "--tag=" ++ tag | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs , let name' = filter isAlpha (display name) , tag <- name' :[ name' ++ "-" ++ show maj ++ "." ++ show d2 | (maj, d2) <- [(maj, d2) | maj <- [0..(major-1)], d2 <- [0,2..20]] ++ [(major, d2) | d2 <- [0,2..minor]] ] ] signalsOpts :: [ProgArg] signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content) | (field,content) <- xList, "x-signals-" `isPrefixOf` field, field /= "x-signals-file"] genFile :: Program -> [ProgArg] -> FilePath -> IO () genFile prog args outFile = do res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args rewriteFile outFile res forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ \(fileTag, f) -> do let tag = reverse (drop 4 (reverse fileTag)) info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") genFile typeGenProgram (typeOpts tag) f case lookup "x-signals-file" xList of Nothing -> return () Just f -> do info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") genFile signalGenProgram signalsOpts f writeFile "gtk2hs_macros.h" $ generateMacros cPkgs -- Based on Cabal/Distribution/Simple/Build/Macros.hs generateMacros :: [PackageId] -> String generateMacros cPkgs = concat $ "/* DO NOT EDIT: This file is automatically generated by Gtk2HsSetup.hs */\n\n" : [ concat ["/* package ",display pkgid," */\n" ,"#define VERSION_",pkgname," ",show (display version),"\n" ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n" ," (major1) < ",major1," || \\\n" ," (major1) == ",major1," && (major2) < ",major2," || \\\n" ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" ,"\n\n" ] | pkgid@(PackageIdentifier name version) <- cPkgs , let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) pkgname = map fixchar (display name) ] where fixchar '-' = '_' fixchar '.' = '_' fixchar c = c --FIXME: Cabal should tell us the selected pkg-config package versions in the -- LocalBuildInfo or equivalent. -- In the mean time, ask pkg-config again. getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId] getPkgConfigPackages verbosity lbi pkg = sequence [ do version <- pkgconfig ["--modversion", display pkgname] case simpleParse version of Nothing -> die "parsing output of pkg-config --modversion failed" Just v -> return (PackageIdentifier pkgname v) | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ] where pkgconfig = rawSystemProgramStdoutConf verbosity pkgConfigProgram (withPrograms lbi) ------------------------------------------------------------------------------ -- Dependency calculation amongst .chs files. ------------------------------------------------------------------------------ -- Given all files of the package, find those that end in .chs and extract the -- .chs files they depend upon. Then return the PackageDescription with these -- files rearranged so that they are built in a sequence that files that are -- needed by other files are built first. fixDeps :: PackageDescription -> IO PackageDescription fixDeps pd@PD.PackageDescription { PD.library = Just lib@PD.Library { PD.exposedModules = expMods, PD.libBuildInfo = bi@PD.BuildInfo { PD.hsSourceDirs = srcDirs, PD.otherModules = othMods }}} = do let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs (joinPath (components m)) mExpFiles <- mapM findModule expMods mOthFiles <- mapM findModule othMods -- tag all exposed files with True so we throw an error if we need to build -- an exposed module before an internal modules (we cannot express this) let modDeps = zipWith (ModDep True []) expMods mExpFiles++ zipWith (ModDep False []) othMods mOthFiles modDeps <- mapM extractDeps modDeps let (expMods, othMods) = span mdExposed $ sortTopological modDeps badOther = map (fromMaybe "" . mdLocation) $ filter (not . mdExposed) expMods unless (null badOther) $ die ("internal chs modules "++intercalate "," badOther++ " depend on exposed chs modules; cabal needs to build internal modules first") return pd { PD.library = Just lib { PD.exposedModules = map mdOriginal expMods, PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods } }} data ModDep = ModDep { mdExposed :: Bool, mdRequires :: [ModuleName], mdOriginal :: ModuleName, mdLocation :: Maybe FilePath } instance Show ModDep where show x = show (mdLocation x) instance Eq ModDep where ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2 instance Ord ModDep where compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2 -- Extract the dependencies of this file. This is intentionally rather naive as it -- ignores CPP conditionals. We just require everything which means that the -- existance of a .chs module may not depend on some CPP condition. extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of ('i':'m':'p':'o':'r':'t':' ':ys) -> case simpleParse (takeWhile ('#' /=) ys) of Just m -> findImports (m:acc) xxs Nothing -> die ("cannot parse chs import in "++f++":\n"++ "offending line is {#"++xs) -- no more imports after the first non-import hook _ -> return acc findImports acc (_:xxs) = findImports acc xxs findImports acc [] = return acc mods <- findImports [] (lines con) return md { mdRequires = mods } -- Find a total order of the set of modules that are partially sorted by their -- dependencies on each other. The function returns the sorted list of modules -- together with a list of modules that are required but not supplied by this -- in the input set of modules. sortTopological :: [ModDep] -> [ModDep] sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms) where set = M.fromList (map (\m -> (mdOriginal m, m)) ms) visit (out,visited) m | m `S.member` visited = (out,visited) | otherwise = case m `M.lookup` set of Nothing -> (out, m `S.insert` visited) Just md -> (md:out', visited') where (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) -- Check user whether install gtk2hs-buildtools correctly. checkGtk2hsBuildtools :: [Program] -> IO () checkGtk2hsBuildtools programs = do programInfos <- mapM (\ prog -> do location <- onDefaultSearchPath programFindLocation prog normal return (programName prog, location) ) programs let printError name = do putStrLn $ "Cannot find " ++ name ++ "\n" ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." exitFailure forM_ programInfos $ \ (name, location) -> when (isNothing location) (printError name) cairo-0.13.1.0/Setup.hs0000644000000000000000000000050412474505512012655 0ustar0000000000000000-- Standard setup file for a Gtk2Hs module. -- -- See also: -- * SetupMain.hs : the real Setup script for this package -- * Gtk2HsSetup.hs : Gtk2Hs-specific boilerplate -- * SetupWrapper.hs : wrapper for compat with various ghc/cabal versions import SetupWrapper ( setupWrapper ) main = setupWrapper "SetupMain.hs" cairo-0.13.1.0/SetupMain.hs0000644000000000000000000000100712474505512013461 0ustar0000000000000000-- The real Setup file for a Gtk2Hs package (invoked via the SetupWrapper). -- It contains only adjustments specific to this package, -- all Gtk2Hs-specific boilerplate is kept in Gtk2HsSetup.hs -- which should be kept identical across all packages. -- import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools, typeGenProgram, signalGenProgram, c2hsLocal) import Distribution.Simple ( defaultMainWithHooks ) main = do checkGtk2hsBuildtools [c2hsLocal] defaultMainWithHooks gtk2hsUserHooks cairo-0.13.1.0/SetupWrapper.hs0000644000000000000000000001542212474505512014223 0ustar0000000000000000-- A wrapper script for Cabal Setup.hs scripts. Allows compiling the real Setup -- conditionally depending on the Cabal version. module SetupWrapper (setupWrapper) where import Distribution.Package import Distribution.Compiler import Distribution.Simple.Utils import Distribution.Simple.Program import Distribution.Simple.Compiler import Distribution.Simple.BuildPaths (exeExtension) import Distribution.Simple.Configure (configCompilerEx) import Distribution.Simple.GHC (getInstalledPackages) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Version import Distribution.Verbosity import Distribution.Text import System.Environment import System.Process import System.Exit (ExitCode(..), exitWith) import System.FilePath import System.Directory import qualified Control.Exception as Exception import System.IO.Error (isDoesNotExistError) import Data.List import Data.Char import Control.Monad -- moreRecentFile is implemented in Distribution.Simple.Utils, but only in -- Cabal >= 1.18. For backwards-compatibility, we implement a copy with a new -- name here. Some desirable alternate strategies don't work: -- * We can't use CPP to check which version of Cabal we're up against because -- this is the file that's generating the macros for doing that. -- * We can't use the name moreRecentFiles and use -- import D.S.U hiding (moreRecentFiles) -- because on old GHC's (and according to the Report) hiding a name that -- doesn't exist is an error. moreRecentFile' :: FilePath -> FilePath -> IO Bool moreRecentFile' a b = do exists <- doesFileExist b if not exists then return True else do tb <- getModificationTime b ta <- getModificationTime a return (ta > tb) setupWrapper :: FilePath -> IO () setupWrapper setupHsFile = do args <- getArgs createDirectoryIfMissingVerbose verbosity True setupDir compileSetupExecutable invokeSetupScript args where setupDir = "dist/setup-wrapper" setupVersionFile = setupDir "setup" <.> "version" setupProgFile = setupDir "setup" <.> exeExtension setupMacroFile = setupDir "wrapper-macros.h" useCabalVersion = Version [1,8] [] usePackageDB = [GlobalPackageDB, UserPackageDB] verbosity = normal cabalLibVersionToUse comp conf = do savedVersion <- savedCabalVersion case savedVersion of Just version -> return version _ -> do version <- installedCabalVersion comp conf writeFile setupVersionFile (show version ++ "\n") return version savedCabalVersion = do versionString <- readFile setupVersionFile `Exception.catch` \e -> if isDoesNotExistError e then return "" else Exception.throwIO e case reads versionString of [(version,s)] | all isSpace s -> return (Just version) _ -> return Nothing installedCabalVersion comp conf = do index <- getInstalledPackages verbosity usePackageDB conf let cabalDep = Dependency (PackageName "Cabal") (orLaterVersion useCabalVersion) case PackageIndex.lookupDependency index cabalDep of [] -> die $ "The package requires Cabal library version " ++ display useCabalVersion ++ " but no suitable version is installed." pkgs -> return $ bestVersion (map fst pkgs) where bestVersion = maximumBy (comparing preference) preference version = (sameVersion, sameMajorVersion ,stableVersion, latestVersion) where sameVersion = version == cabalVersion sameMajorVersion = majorVersion version == majorVersion cabalVersion majorVersion = take 2 . versionBranch stableVersion = case versionBranch version of (_:x:_) -> even x _ -> False latestVersion = version -- | If the Setup.hs is out of date wrt the executable then recompile it. -- Currently this is GHC only. It should really be generalised. -- compileSetupExecutable = do setupHsNewer <- setupHsFile `moreRecentFile'` setupProgFile cabalVersionNewer <- setupVersionFile `moreRecentFile'` setupProgFile let outOfDate = setupHsNewer || cabalVersionNewer when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." (comp, _, conf) <- configCompilerEx (Just GHC) Nothing Nothing defaultProgramConfiguration verbosity cabalLibVersion <- cabalLibVersionToUse comp conf let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion writeFile setupMacroFile (generateVersionMacro cabalLibVersion) rawSystemProgramConf verbosity ghcProgram conf $ ["--make", setupHsFile, "-o", setupProgFile] ++ ghcPackageDbOptions usePackageDB ++ ["-package", display cabalPkgid ,"-cpp", "-optP-include", "-optP" ++ setupMacroFile ,"-odir", setupDir, "-hidir", setupDir] where ghcPackageDbOptions dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs (GlobalPackageDB:dbs) -> "-no-user-package-conf" : concatMap specific dbs _ -> ierror where specific (SpecificPackageDB db) = [ "-package-conf", db ] specific _ = ierror ierror = error "internal error: unexpected package db stack" generateVersionMacro :: Version -> String generateVersionMacro version = concat ["/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ,"#define CABAL_VERSION_CHECK(major1,major2,minor) (\\\n" ," (major1) < ",major1," || \\\n" ," (major1) == ",major1," && (major2) < ",major2," || \\\n" ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" ,"\n\n" ] where (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) invokeSetupScript :: [String] -> IO () invokeSetupScript args = do info verbosity $ unwords (setupProgFile : args) process <- runProcess (currentDir setupProgFile) args Nothing Nothing Nothing Nothing Nothing exitCode <- waitForProcess process unless (exitCode == ExitSuccess) $ exitWith exitCode cairo-0.13.1.0/demo/0000755000000000000000000000000012474505512012146 5ustar0000000000000000cairo-0.13.1.0/demo/cairo-clock-icon.png0000644000000000000000000001044012474505512015767 0ustar0000000000000000PNG  IHDR00WbKGD pHYs  tIME26ՆEIDAThŚ{\}?׼vfvfޗmy?%А`C[9-1DH?"TiW%ԨM+7QZ(\b^"CLY;ݝy{wY$!!팎<~>7 ̩)h4RjppP?:E133y&` Zg@x[qa={s{all̪T*[ q˲0M!J)<ϣhPi4&xq]ڵ}MT*Nd cYV$(}zN\faa2ӞB|07Yҗue}^\.֚ifff(`B`H2-D"N2$Hb~~sεhvBP6}_ڵKj㫃Az{{ɓLOOc6TdX}۶Qyh4$tT2IPĉŐZ>/i~y۶m۷nv7M_{zz_zu]^{5ffgAA:ymL4 Z6PO#E>ɓ[zEJ?5;v{FGGf||1X"N:&Ag.OggljaZ&aP.gdZkz4ujrbsy(o!뮻.s=X;׮]K?/cD"7 IOpB!kI:C>399S)w}+ɸgx瘞&LCo_/"#ql0R l4- 4 + iHN?˲X,jܲe 333 Z&&&=66Z_8{'}}}4 2 t |62иjDVh<@i}J[IJ,X,''Nm6bZաC(JcxILBk8vZ6 !B/'| ovo+0RrqEK%n)Z5$}o:Ny&&&PJNe_O6#Ցjv!@4ӗw1F#NHCbY6n@(+[n(Gd>L&C<ٳH JH&H&@.2Z7h*T|.Jѽ!0Ld2i8"\UV:ŋ# ~4JR,..RqDX,i6l!M C!i Jw.Z7Q a_ͱaÆyGR7 1B ˃p45h"h빑c;MmS(Yvm|t߾}o, q()ұ1L'ƙh mh)Zi>S ҭpZӠT*300eEi`_J9eZHk)+LLm4@ j < I:.#]u&'j{Zy LÎ>A]%AͯpZ5'O&BRSXUJ)sf sm):qA*=im kUtB/sjII\p =99)0cҷT*@ ki|>GWW@+?Qw9Z늅i_! ,OB-Ұ,DR Jp)l`gYTssh +VО:Cn/ 仺h<_DuˇޢiPME{w1 BP(Q)IR-EWb1RJwׇaV" Q_a[B4)+l ’+Msz4W_}U[͡5cYNvWR:lBiKR!LP_f(l(\"q|uZm 24ـ󊪫/K)E^}4Nj'۷blVczz\gu1 mB?i**!.-:͊fff5W;;v,nڼysC֚/b&i&MN_Ӭ^ ؕ8T,TU Z/1ۤV;rݻBRVQ9 S_ a2fYK<a5=)PVah翘^328ȫJ#lG^SJq)8 fićox##ìz-/2]~e{۷ǟ^xYZ\dpER )M|u/Ze TyTU.{oO5CT5֬\"/bt`#=Е*>/k⥗^;+T*atF%=΍5QUe w^\ K뮻3bŊ7G[MգkH'ʘțGF+? *JHQˆJGZ%sݺ<LMM=ǟ?{f?QJmF}RLqaX,Ҋcbje]*a~ky.##xGV%ӑ wÏ~P 0[cccƍXQ(8w6l (C)EV#Ymk\@@qHZ2MVNo}W^y%])yO?o~>O)tY*I$(CktJRceU&eq5{ebb"oowĴcǎ~?e~muVf sL92eJQhXdfzuE'tVH&Z?ygTC_J)ԧ>_dz>r]φfٺu+7x#sL ejV+T*ͦn*ҩ;?ϹsڗaqS;w`YxY*Bkpy"`Æ lڴQ,ˢZQը(cxd"NNNrQ|MڗYB|Ŷ'?Yu'b9CZiK&q4 wߥV]:+xZoݻ5xG}^}UW)桛Nm)忯^^`x9p@ZnZoZor}>0#⇶miӦ;8qUV{zJk-k(q\˲֬YZJ_M]\į`0IENDB`cairo-0.13.1.0/demo/CairoGhci.hs0000644000000000000000000000333512474505512014336 0ustar0000000000000000-- Example of an drawing graphics onto a canvas. import Graphics.UI.Gtk import Graphics.Rendering.Cairo import Control.Monad.Trans ( liftIO ) import Graphics.UI.Gtk.Gdk.EventM run :: Render () -> IO () run act = do initGUI dia <- dialogNew dialogAddButton dia stockClose ResponseClose contain <- dialogGetUpper dia canvas <- drawingAreaNew canvas `onSizeRequest` return (Requisition 250 250) canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas act boxPackStartDefaults contain canvas widgetShow canvas dialogRun dia widgetDestroy dia -- Flush all commands that are waiting to be sent to the graphics server. -- This ensures that the window is actually closed before ghci displays the -- prompt again. flush where updateCanvas :: DrawingArea -> Render () -> EventM EExpose () updateCanvas canvas act = liftIO $ do win <- widgetGetDrawWindow canvas renderWithDrawable win act setRed :: Render () setRed = do setSourceRGB 1 0 0 setFat :: Render () setFat = do setLineWidth 20 setLineCap LineCapRound drawSquare :: Double -> Double -> Render () drawSquare width height = do (x,y) <- getCurrentPoint lineTo (x+width) y lineTo (x+width) (y+height) lineTo x (y+height) closePath stroke drawHCirc :: Double -> Double -> Double -> Render () drawHCirc x y radius = do arc x y radius 0 pi stroke drawStr :: String -> Render () drawStr txt = do lay <- createLayout txt showLayout lay drawStr_ :: String -> Render () drawStr_ txt = do lay <- liftIO $ do ctxt <- cairoCreateContext Nothing descr <- contextGetFontDescription ctxt descr `fontDescriptionSetSize` 20 ctxt `contextSetFontDescription` descr layoutText ctxt txt showLayout lay cairo-0.13.1.0/demo/Clock.hs0000644000000000000000000002426612474505512013547 0ustar0000000000000000-- original author: -- Mirco "MacSlow" Mueller -- -- created: -- 10.1.2006 (or so) -- -- http://www.gnu.org/licenses/licenses.html#GPL -- -- ported to Haskell by: -- Duncan Coutts -- import Graphics.Rendering.Cairo import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.EventM import System.Time import Control.Monad (when) import Data.Maybe (isJust) import Data.IORef drawClockBackground :: Bool -> Int -> Int -> Render () drawClockBackground quality width height = do save scale (fromIntegral width) (fromIntegral height) save setOperator OperatorOver when quality drawDropShadow drawClockFace quality restore translate 0.5 0.5 scale 0.4 0.4 setSourceRGB 0.16 0.18 0.19 setLineWidth (1.5/60) setLineCap LineCapRound setLineJoin LineJoinRound drawHourMarks restore drawClockHands :: Bool -> Int -> Int -> Render () drawClockHands quality width height = do save scale (fromIntegral width) (fromIntegral height) translate 0.5 0.5 scale 0.4 0.4 setSourceRGB 0.16 0.18 0.19 setLineWidth (1.5/60) setLineCap LineCapRound setLineJoin LineJoinRound time <- liftIO (getClockTime >>= toCalendarTime) let hours = fromIntegral (if ctHour time >= 12 then ctHour time - 12 else ctHour time) minutes = fromIntegral (ctMin time) seconds = fromIntegral (ctSec time) drawHourHand quality hours minutes seconds drawMinuteHand quality minutes seconds drawSecondHand quality seconds restore drawClockForeground :: Bool -> Int -> Int -> Render () drawClockForeground quality width height = do scale (fromIntegral width) (fromIntegral height) save translate 0.5 0.5 scale 0.4 0.4 setSourceRGB 0.16 0.18 0.19 setLineWidth (1.5/60) setLineCap LineCapRound setLineJoin LineJoinRound when quality drawInnerShadow when quality drawReflection drawFrame quality restore drawDropShadow = withRadialPattern 0.55 0.55 0.25 0.5 0.5 0.525 $ \pattern -> do patternAddColorStopRGBA pattern 0 0 0 0 0.811 patternAddColorStopRGBA pattern 0.64 0.345 0.345 0.345 0.317 patternAddColorStopRGBA pattern 0.84 0.713 0.713 0.713 0.137 patternAddColorStopRGBA pattern 1 1 1 1 0 patternSetFilter pattern FilterFast setSource pattern arc 0.5 0.5 (142/150) 0 (pi*2) fill drawClockFace True = withLinearPattern 0.5 0 0.5 1 $ \pattern -> do patternAddColorStopRGB pattern 0 0.91 0.96 0.93 patternAddColorStopRGB pattern 1 0.65 0.68 0.68 patternSetFilter pattern FilterFast setSource pattern translate 0.5 0.5 arc 0 0 (60/150) 0 (pi*2) fill drawClockFace False = do setSourceRGB 0.78 0.82 0.805 translate 0.5 0.5 arc 0 0 (60/150) 0 (pi*2) fill drawHourMarks = do save forM_ [1..12] $ \_ -> do rotate (pi/6) moveTo (4.5/6) 0 lineTo (5.0/6) 0 stroke restore forM_ = flip mapM_ drawHourHand quality hours minutes seconds = do save rotate (-pi/2) setLineCap LineCapSquare setLineJoin LineJoinMiter rotate ( (pi/6) * hours + (pi/360) * minutes + (pi/21600) * seconds) -- hour hand's shadow when quality $ do setLineWidth (1.75/60) setOperator OperatorAtop setSourceRGBA 0.16 0.18 0.19 0.125 moveTo (-2/15 + 0.025) 0.025 lineTo (7/15 + 0.025) 0.025 stroke -- the hand itself setLineWidth (1/60) setOperator OperatorOver setSourceRGB 0.16 0.18 0.19 moveTo (-2/15) 0 lineTo (7/15) 0 stroke restore drawMinuteHand quality minutes seconds = do save rotate (-pi/2) setLineCap LineCapSquare setLineJoin LineJoinMiter rotate ( (pi/30) * minutes + (pi/1800) * seconds) -- minute hand's shadow when quality $ do setLineWidth (1.75/60) setOperator OperatorAtop setSourceRGBA 0.16 0.18 0.19 0.125 moveTo (-16/75 - 0.025) (-0.025) lineTo (2/3 - 0.025) (-0.025) stroke -- the minute hand itself setLineWidth (1/60) setOperator OperatorOver setSourceRGB 0.16 0.18 0.19 moveTo (-16/75) 0 lineTo (2/3) 0 stroke restore drawSecondHand quality seconds = do save rotate (-pi/2) setLineCap LineCapSquare setLineJoin LineJoinMiter rotate (seconds * pi/30); -- shadow of second hand-part when quality $ do setOperator OperatorAtop setSourceRGBA 0.16 0.18 0.19 0.125 setLineWidth (1.3125 / 60) moveTo (-1.5/5 + 0.025) 0.025 lineTo (3/5 + 0.025) 0.025 stroke -- second hand setOperator OperatorOver setSourceRGB 0.39 0.58 0.77 setLineWidth (0.75/60) moveTo (-1.5/5) 0 lineTo (3/5) 0 stroke arc 0 0 (1/20) 0 (pi*2) fill arc (63/100) 0 (1/35) 0 (pi*2) stroke setLineWidth (1/100) moveTo (10/15) 0 lineTo (12/15) 0 stroke setSourceRGB 0.31 0.31 0.31 arc 0 0 (1/25) 0 (pi*2) fill restore drawInnerShadow = do save setOperator OperatorOver arc 0 0 (142/150) 0 (pi*2) clip withRadialPattern 0.3 0.3 0.1 0 0 0.95 $ \pattern -> do patternAddColorStopRGBA pattern 0 1 1 1 0 patternAddColorStopRGBA pattern 0.64 0.713 0.713 0.713 0.137 patternAddColorStopRGBA pattern 0.84 0.345 0.345 0.345 0.317 patternAddColorStopRGBA pattern 1 0 0 0 0.811 patternSetFilter pattern FilterFast setSource pattern arc 0 0 (142/150) 0 (pi*2) fill restore drawReflection = do save arc 0 0 (142/150) 0 (pi*2) clip rotate (-75 * pi/180) setSourceRGBA 0.87 0.9 0.95 0.25 moveTo (-1) (-1) lineTo 1 (-1) lineTo 1 1 curveTo 1 0.15 (-0.15) (-1) (-1) (-1) fill moveTo (-1) (-1) lineTo (-1) 1 lineTo 1 1 curveTo (-0.5) 1 (-1) 0.5 (-1) (-1) fill restore drawFrame True = do save withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do patternAddColorStopRGB pattern 0 0.4 0.4 0.4 patternAddColorStopRGB pattern 0.2 0.95 0.95 0.95 patternSetFilter pattern FilterFast setSource pattern setLineWidth (10/75) arc 0 0 (142/150) 0 (pi*2) stroke withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do patternAddColorStopRGB pattern 0 0.9 0.9 0.9 patternAddColorStopRGB pattern 0.2 0.35 0.35 0.35 patternSetFilter pattern FilterFast setSource pattern setLineWidth (10/75) arc 0 0 (150/150) 0 (pi*2) stroke restore drawFrame False = do save setSourceRGB 0 0 0 setLineWidth (10/75) arc 0 0 1 0 (pi*2) stroke restore initialSize :: Int initialSize = 256 main = do initGUI window <- windowNew windowSetDecorated window False windowSetResizable window True windowSetPosition window WinPosCenterAlways widgetSetAppPaintable window True windowSetIconFromFile window "cairo-clock-icon.png" windowSetTitle window "Gtk2Hs Cairo Clock" windowSetDefaultSize window initialSize initialSize windowSetGeometryHints window (Just window) (Just (32, 32)) (Just (512, 512)) Nothing Nothing (Just (1,1)) let setAlpha widget = do screen <- widgetGetScreen widget colormap <- screenGetRGBAColormap screen maybe (return ()) (widgetSetColormap widget) colormap setAlpha window --TODO: also call setAlpha on alpha screen change window `on` keyPressEvent $ tryEvent $ do "Escape" <- eventKeyName liftIO mainQuit window `on` buttonPressEvent $ tryEvent $ do LeftButton <- eventButton time <- eventTime (x,y) <- eventRootCoordinates liftIO $ windowBeginMoveDrag window LeftButton (round x) (round y) time window `on` buttonPressEvent $ tryEvent $ do MiddleButton <- eventButton time <- eventTime (x,y) <- eventRootCoordinates liftIO $ windowBeginResizeDrag window WindowEdgeSouthEast MiddleButton (round x) (round y) time timeoutAdd (widgetQueueDraw window >> return True) 1000 backgroundRef <- newIORef (Just undefined) foregroundRef <- newIORef (Just undefined) let redrawStaticLayers = do (width, height) <- widgetGetSize window drawWin <- widgetGetDrawWindow window background <- createImageSurface FormatARGB32 width height foreground <- createImageSurface FormatARGB32 width height let clear = do save setOperator OperatorClear paint restore renderWith background $ do clear drawClockBackground True width height renderWith foreground $ do clear drawClockForeground True width height writeIORef backgroundRef (Just background) writeIORef foregroundRef (Just foreground) onRealize window redrawStaticLayers sizeRef <- newIORef (initialSize, initialSize) timeoutHandlerRef <- newIORef Nothing window `on` configureEvent $ do (w,h) <- eventSize liftIO $ do size <- readIORef sizeRef writeIORef sizeRef (w,h) when (size /= (w,h)) $ do background <- readIORef backgroundRef foreground <- readIORef foregroundRef maybe (return ()) surfaceFinish background maybe (return ()) surfaceFinish foreground writeIORef backgroundRef Nothing writeIORef foregroundRef Nothing timeoutHandler <- readIORef timeoutHandlerRef maybe (return ()) timeoutRemove timeoutHandler handler <- timeoutAddFull (do writeIORef timeoutHandlerRef Nothing redrawStaticLayers widgetQueueDraw window return False ) priorityDefaultIdle 300 writeIORef timeoutHandlerRef (Just handler) return False window `on` exposeEvent $ do drawWin <- eventWindow exposeRegion <- eventRegion liftIO $ do (width, height) <- drawableGetSize drawWin background <- readIORef backgroundRef foreground <- readIORef foregroundRef renderWithDrawable drawWin $ do region exposeRegion clip save setOperator OperatorSource setSourceRGBA 0 0 0 0 paint restore case background of Nothing -> drawClockBackground False width height Just background -> do setSourceSurface background 0 0 paint drawClockHands (isJust background) width height case foreground of Nothing -> drawClockForeground False width height Just foreground -> do setSourceSurface foreground 0 0 paint return True widgetShowAll window mainGUI cairo-0.13.1.0/demo/Drawing.hs0000644000000000000000000000253412474505512014101 0ustar0000000000000000-- Example of an drawing graphics onto a canvas. import Graphics.UI.Gtk import Graphics.Rendering.Cairo import Graphics.UI.Gtk.Gdk.EventM main = do initGUI dia <- dialogNew dialogAddButton dia stockOk ResponseOk contain <- dialogGetUpper dia canvas <- drawingAreaNew canvas `on` sizeRequest $ return (Requisition 40 40) ctxt <- cairoCreateContext Nothing text <- layoutEmpty ctxt text `layoutSetText` "Hello World." canvas `on` exposeEvent $ updateCanvas text boxPackStartDefaults contain canvas widgetShow canvas dialogRun dia return () updateCanvas :: PangoLayout -> EventM EExpose Bool updateCanvas text = do win <- eventWindow liftIO $ do (width',height') <- drawableGetSize win let width = realToFrac width' height = realToFrac height' -- Draw using the cairo api renderWithDrawable win $ do setSourceRGB 1 0 0 setLineWidth 20 setLineCap LineCapRound setLineJoin LineJoinRound moveTo 30 30 lineTo (width-30) (height-30) lineTo (width-30) 30 lineTo 30 (height-30) stroke setSourceRGB 1 1 0 setLineWidth 4 save translate (width / 2) (height / 2) scale (width / 2) (height / 2) arc 0 0 1 (135 * pi/180) (225 * pi/180) restore stroke setSourceRGB 0 0 0 moveTo 30 (realToFrac height / 4) rotate (pi/4) showLayout text return True cairo-0.13.1.0/demo/Drawing2.hs0000644000000000000000000001343612474505512014166 0ustar0000000000000000-- -- Author: Johan Bockgård -- -- This code is in the public domain. -- import qualified Graphics.UI.Gtk as G import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as M windowWidth, windowHeight :: Int windowWidth = 500 windowHeight = 500 -- Write image to file writePng :: IO () writePng = C.withImageSurface C.FormatARGB32 width height $ \ result -> do C.renderWith result $ example width height C.surfaceWriteToPNG result "Draw.png" where width = windowWidth height = windowHeight -- Display image in window main = do G.initGUI window <- G.windowNew canvas <- G.drawingAreaNew -- fix size -- G.windowSetResizable window False G.widgetSetSizeRequest window windowWidth windowHeight -- press any key to quit G.onKeyPress window $ const (do G.widgetDestroy window; return True) G.onDestroy window G.mainQuit G.onExpose canvas $ const (updateCanvas canvas) G.set window [G.containerChild G.:= canvas] G.widgetShowAll window G.mainGUI updateCanvas :: G.DrawingArea -> IO Bool updateCanvas canvas = do win <- G.widgetGetDrawWindow canvas (width, height) <- G.widgetGetSize canvas G.renderWithDrawable win $ example width height return True ---------------------------------------------------------------- foreach :: (Monad m) => [a] -> (a -> m b) -> m [b] foreach = flip mapM keepState render = do C.save render C.restore drawCircle x y r = do C.arc x y r 0 (2 * pi) fillStroke drawRectangle x y w h = do C.rectangle x y w h fillStroke stroke = keepState $ do C.setSourceRGBA 0 0 0 0.7 C.stroke fillStroke = do C.fillPreserve stroke ---------------------------------------------------------------- -- Example example width height = do prologue width height example1 -- Set up stuff prologue wWidth wHeight = do let width = 10 height = 10 xmax = width / 2 xmin = - xmax ymax = height / 2 ymin = - ymax scaleX = realToFrac wWidth / width scaleY = realToFrac wHeight / height -- style and color C.setLineCap C.LineCapRound C.setLineJoin C.LineJoinRound C.setLineWidth $ 1 / max scaleX scaleY C.setSourceRGBA 0.5 0.7 0.5 0.5 -- Set up user coordinates C.scale scaleX scaleY -- center origin C.translate (width / 2) (height / 2) -- positive y-axis upwards let flipY = M.Matrix 1 0 0 (-1) 0 0 C.transform flipY grid xmin xmax ymin ymax -- Grid and axes grid xmin xmax ymin ymax = keepState $ do C.setSourceRGBA 0 0 0 0.7 -- axes C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke C.moveTo xmin 0; C.lineTo xmax 0; C.stroke -- grid C.setDash [0.01, 0.99] 0 foreach [xmin .. xmax] $ \ x -> do C.moveTo x ymin C.lineTo x ymax C.stroke example1 = do -- circles drawCircle 0 0 1 drawCircle 2 2 3 -- a bunch of rectangles keepState $ foreach [1 .. 5] $ \ _ -> do drawRectangle 0 1 2 3 C.rotate (pi/8) -- some cute stuff thought apple snake thought = keepState $ do C.scale 0.04 0.04 C.translate (200) (380) C.rotate pi C.setSourceRGBA 0.5 0.5 1 0.7 C.setLineWidth 1 image fillStroke where m = C.moveTo c = C.curveTo z = C.closePath image = do m 184 327 c 176 327 170 332 168 339 c 166 333 160 329 153 329 c 147 329 141 333 138 339 c 137 339 136 338 134 338 c 125 338 118 345 118 354 c 118 363 125 371 134 371 c 137 371 140 370 142 368 c 142 368 142 368 142 369 c 142 377 149 385 158 385 c 162 385 166 383 168 381 c 171 386 176 390 183 390 c 188 390 193 387 196 383 c 198 384 201 385 204 385 c 212 385 220 378 220 369 c 222 371 225 372 228 372 c 237 372 244 364 244 355 c 244 346 237 339 228 339 c 227 339 226 339 225 340 c 223 332 217 327 209 327 c 204 327 199 330 196 333 c 193 330 189 327 184 327 z m 164 387 c 158 387 153 391 153 397 c 153 402 158 407 164 407 c 170 407 174 402 174 397 c 174 391 170 387 164 387 z m 152 408 c 149 408 146 411 146 414 c 146 417 149 420 152 420 c 155 420 158 417 158 414 c 158 411 155 408 152 408 z m 143 422 c 141 422 139 424 139 426 c 139 428 141 429 143 429 c 144 429 146 428 146 426 c 146 424 144 422 143 422 z apple = keepState $ do C.scale 0.05 0.05 C.translate (1110) (220) C.rotate pi C.setLineWidth 0.5 C.setSourceRGBA 0 0 0 0.7 image1 fillStroke C.setSourceRGBA 1 0 0 0.7 image2 fillStroke where m = C.moveTo c = C.curveTo z = C.closePath l = C.lineTo image1 = do m 1149 245 l 1156 244 l 1155 252 l 1149 245 z image2 = do m 1151 249 c 1145 249 1140 254 1140 261 c 1140 268 1145 273 1151 273 c 1152 273 1153 273 1154 272 c 1156 273 1157 273 1158 273 c 1164 273 1169 268 1169 261 c 1169 254 1164 249 1158 249 c 1157 249 1156 249 1154 250 c 1153 249 1152 249 1151 249 z snake = keepState $ do C.scale 0.04 0.04 C.translate (150) (220) C.rotate pi C.setLineWidth 0.5 C.setSourceRGBA 0.1 0.1 0 0.7 image fillStroke where m = C.moveTo c = C.curveTo z = C.closePath l = C.lineTo image = do m 146 320 c 143 308 130 314 123 319 c 115 324 108 311 100 314 c 93 317 92 319 81 318 c 76 318 60 309 60 320 c 60 328 73 321 82 323 c 94 326 98 317 106 320 c 113 323 120 330 128 323 c 133 318 142 312 146 320 l 146 320 z ---------------------------------------------------------------- cairo-0.13.1.0/demo/Graph.hs0000644000000000000000000000525612474505512013553 0ustar0000000000000000-- -- Author: Michael Sloan -- -- This code is in the public domain. -- -- Based off Johan Bockgård's Drawing2.hs -- import qualified Graphics.UI.Gtk as G import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as M f x = sin (x*5) / (x*5) main = graph f graph :: (Double -> Double) -> IO () graph f = do G.initGUI window <- G.windowNew canvas <- G.drawingAreaNew G.windowSetResizable window False G.widgetSetSizeRequest window 600 600 -- press any key to quit G.onKeyPress window $ const (do G.widgetDestroy window; return True) G.onDestroy window G.mainQuit G.onExpose canvas $ const $ render f canvas G.set window [G.containerChild G.:= canvas] G.widgetShowAll window G.mainGUI render :: (Double -> Double) -> G.DrawingArea -> IO Bool render f canvas = do win <- G.widgetGetDrawWindow canvas (width, height) <- G.widgetGetSize canvas G.renderWithDrawable win $ (prologue width height >> renderG f) return True foreach :: (Monad m) => [a] -> (a -> m b) -> m [b] foreach = flip mapM deriv :: (Double -> Double) -> Double -> Double deriv f x = ((f $ x + 0.05) - (f $ x - 0.05)) * 10 gen :: Double -> Double -> (Double -> Double) -> [Double] gen v t f | v > t = [] gen v t f = v : (gen (f v) t f) skipBy f = foldr (\x c -> if f x then c else x : c) [] falloff x = 0.25 * (x + 1.5) / ((x+0.5)^5 + 1) renderG :: (Double -> Double) -> C.Render () renderG f = do C.moveTo (-5) (f (-5)) sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) [-4.9,-4.8..5] --Adaptive attempt (falloff func is what really needs work) --sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) $ tail $ gen (-5) 5 (\x -> x + (falloff $ abs $ deriv (deriv f) x)) C.stroke -- Set up stuff prologue wWidth wHeight = do let width = 10 height = 10 xmax = width / 2 xmin = - xmax ymax = height / 2 ymin = - ymax scaleX = realToFrac wWidth / width scaleY = realToFrac wHeight / height -- style and color C.setLineCap C.LineCapRound C.setLineJoin C.LineJoinRound C.setLineWidth $ 1 / max scaleX scaleY -- Set up user coordinates C.scale scaleX scaleY -- center origin C.translate (width / 2) (height / 2) -- positive y-axis upwards let flipY = M.Matrix 1 0 0 (-1) 0 0 C.transform flipY C.setSourceRGBA 0 0 0 1 grid xmin xmax ymin ymax -- Grid and axes grid xmin xmax ymin ymax = do -- axes C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke C.moveTo xmin 0; C.lineTo xmax 0; C.stroke -- grid C.setDash [0.01, 0.99] 0 foreach [xmin .. xmax] $ \ x -> do C.moveTo x ymin C.lineTo x ymax C.stroke C.setDash [] 0 cairo-0.13.1.0/demo/Makefile0000644000000000000000000000101012474505512013576 0ustar0000000000000000 PROGS = drawing drawing2 starandring text clock graph sdldrawing SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs CairoSDL.hs all : $(PROGS) drawing : Drawing.hs $(HC_RULE) drawing2 : Drawing2.hs $(HC_RULE) starandring : StarAndRing.hs $(HC_RULE) text : Text.hs $(HC_RULE) clock : Clock.hs $(HC_RULE) graph : Graph.hs $(HC_RULE) sdldrawing : CairoSDL.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc cairo-0.13.1.0/demo/StarAndRing.hs0000644000000000000000000000637112474505512014665 0ustar0000000000000000import Graphics.Rendering.Cairo import qualified Graphics.Rendering.Cairo.Matrix as M ringPath :: Render () ringPath = do moveTo 200.86568 667.80795 curveTo 110.32266 562.62134 122.22863 403.77940 227.41524 313.23637 curveTo 332.60185 222.69334 491.42341 234.57563 581.96644 339.76224 curveTo 672.50948 444.94884 660.64756 603.79410 555.46095 694.33712 curveTo 450.27436 784.88016 291.40871 772.99456 200.86568 667.80795 closePath moveTo 272.14411 365.19927 curveTo 195.64476 431.04875 186.97911 546.57972 252.82859 623.07908 curveTo 318.67807 699.57844 434.23272 708.22370 510.73208 642.37422 curveTo 587.23144 576.52474 595.85301 460.99047 530.00354 384.49112 curveTo 464.15406 307.99176 348.64347 299.34979 272.14411 365.19927 closePath starPath :: Render () starPath = do transform (M.Matrix 0.647919 (-0.761710) 0.761710 0.647919 (-208.7977) 462.0608) moveTo 505.80857 746.23606 lineTo 335.06870 555.86488 lineTo 91.840384 635.31360 lineTo 282.21157 464.57374 lineTo 202.76285 221.34542 lineTo 373.50271 411.71660 lineTo 616.73103 332.26788 lineTo 426.35984 503.00775 lineTo 505.80857 746.23606 closePath fillRing :: Render () fillRing = do save translate (-90) (-205) ringPath setSourceRGBA 1.0 0.0 0.0 0.75 fill restore fillStar :: Render () fillStar = do save translate (-90) (-205) starPath setSourceRGBA 0.0 0.0 ((fromIntegral 0xae) / (fromIntegral 0xff)) 0.55135137 fill restore clipToTopAndBottom :: Int -> Int -> Render () clipToTopAndBottom width height = do moveTo 0 0 lineTo (fromIntegral width) 0.0 lineTo 0.0 (fromIntegral height) lineTo (fromIntegral width) (fromIntegral height) closePath clip newPath clipToLeftAndRight :: Int -> Int -> Render () clipToLeftAndRight width height = do moveTo 0 0 lineTo 0.0 (fromIntegral height) lineTo (fromIntegral width) 0.0 lineTo (fromIntegral width) (fromIntegral height) closePath clip newPath starAndRing :: Int -> Int -> Render () starAndRing width height = do setOperator OperatorClear paint setOperator OperatorAdd renderWithSimilarSurface ContentColorAlpha width height $ \ringOverStar -> do renderWith ringOverStar $ do clipToTopAndBottom width height fillStar fillRing setSourceSurface ringOverStar 0 0 paint renderWithSimilarSurface ContentColorAlpha width height $ \starOverRing -> do renderWith starOverRing $ do clipToLeftAndRight width height fillRing fillStar setSourceSurface starOverRing 0 0 paint main :: IO () main = do withImageSurface FormatARGB32 width height $ \result -> do renderWith result $ starAndRing width height surfaceWriteToPNG result "StarAndRing.png" putStrLn "wrote StarAndRing.png" withPDFSurface "StarAndRing.pdf" (fromIntegral width) (fromIntegral height) (flip renderWith $ starAndRing width height >> showPage) putStrLn "wrote StarAndRing.pdf" withPSSurface "StarAndRing.ps" (fromIntegral width) (fromIntegral height) (flip renderWith $ starAndRing width height >> showPage) putStrLn "wrote StarAndRing.ps" withSVGSurface "StarAndRing.svg" (fromIntegral width) (fromIntegral height) (flip renderWith $ starAndRing width height) putStrLn "wrote StarAndRing.svg" where width = 600 height = 600 cairo-0.13.1.0/demo/Text.hs0000644000000000000000000000271512474505512013433 0ustar0000000000000000import Graphics.Rendering.Cairo import qualified Graphics.Rendering.Cairo.Matrix as M boxText :: String -> Double -> Double -> Render () boxText text x y = do save lineWidth <- getLineWidth (TextExtents xb yb w h _ _) <- textExtents text rectangle (x + xb - lineWidth) (y + yb - lineWidth) (w + 2 * lineWidth) (h + 2 * lineWidth) stroke moveTo x y textPath text fillPreserve setSourceRGBA 0 0 1 0.5 setLineWidth 3.0 stroke restore transpSurface :: Double -> Double -> Render () transpSurface w h = do save rectangle 0 0 w h setSourceRGBA 0 0 0 0 setOperator OperatorSource fill restore width = 400 height = 300 main :: IO () main = withImageSurface FormatARGB32 width height $ \surface -> do renderWith surface $ do setSourceRGB 0.0 0.0 0.0 setLineWidth 2.0 transpSurface (fromIntegral width) (fromIntegral height) selectFontFace "sans" FontSlantNormal FontWeightNormal setFontSize 40 extents <- fontExtents let fontHeight = fontExtentsHeight extents boxText "Howdy, world!" 10 fontHeight translate 0 fontHeight save translate 10 fontHeight rotate (10.0 * pi / 180.0) boxText "Yay for Haskell!" 0 0 restore translate 0 (3 * fontHeight) save setFontMatrix $ M.rotate ((-10.0) * pi / 180.0) $ M.scale 40.0 40.0 M.identity boxText "...and Cairo!" 10 fontHeight restore surfaceWriteToPNG surface "Text.png" return () cairo-0.13.1.0/Graphics/0000755000000000000000000000000012474505512012762 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/0000755000000000000000000000000012474505512014677 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo.hs0000644000000000000000000024507212474505512016302 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances, CPP #-} -- The following is all rather brittle: We need to pre-process this file with GHC -- in order to get the __GLASGOW_HASKELL__ macro (which we should replace with a -- version test of the array package). At the same time we need to version of -- Cairo and the macros for testing it. We sneakily get the version from the -- internal cairo-version.h file but we have to define the testing macros ourselves. #include -- GTK-2.12 doesn't have cairo-version.h, but defines the appropriate VERSION -- variables in cairo-features.h instead. So only include this when necessary. #ifndef CAIRO_VERSION_MAJOR #include #endif #define CAIRO_VERSION_ENCODE(major, minor, micro) ( \ ((major) * 10000) \ + ((minor) * 100) \ + ((micro) * 1)) #define CAIRO_VERSION CAIRO_VERSION_ENCODE( \ CAIRO_VERSION_MAJOR, \ CAIRO_VERSION_MINOR, \ CAIRO_VERSION_MICRO) #define CAIRO_CHECK_VERSION(major,minor,micro) \ (CAIRO_VERSION >= CAIRO_VERSION_ENCODE(major,minor,micro)) ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo -- Copyright : (c) Paolo Martini 2005, (c) Abraham Egnor 2004, (c) Aetion Technologies LLC 2004 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- The Cairo 2D graphics library. -- -- Cairo is a 2D graphics library with support for multiple output devices. -- Currently supported output targets include the X Window System, win32, and -- image buffers. Experimental backends include OpenGL (through glitz), Quartz, -- XCB, PostScript and PDF file output. -- -- Cairo is designed to produce consistent output on all output media while -- taking advantage of display hardware acceleration when available (eg. -- through the X Render Extension). -- -- The cairo API provides operations similar to the drawing operators of -- PostScript and PDF. Operations in cairo including stroking and filling cubic -- Bezier splines, transforming and compositing translucent images, and -- antialiased text rendering. All drawing operations can be transformed by any -- affine transformation (scale, rotation, shear, etc.) -- -- Cairo is free software and is available to be redistributed and\/or modified -- under the terms of either the GNU Lesser General Public License (LGPL) -- version 2.1 or the Mozilla Public License (MPL) version 1.1. -- -- For more information see -- -- * Note the Haskell bindings do not support all the possible cairo backends -- because it would require bindings for the associated technology (eg X11, -- glitz, etc) however bindings to other backends may be implemented -- externally. For example, Gtk2Hs provides a binding to the backend for X11 -- (and win32 on Windows). ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo ( -- * Drawing renderWith , save , restore , status , withTargetSurface , pushGroup , pushGroupWithContent , popGroupToSource , setSourceRGB , setSourceRGBA , setSource , setSourceSurface , getSource , setAntialias , setDash , setFillRule , getFillRule , setLineCap , getLineCap , setLineJoin , getLineJoin , setLineWidth , getLineWidth , setMiterLimit , getMiterLimit , setOperator , getOperator , setTolerance , getTolerance , clip , clipPreserve , clipExtents , resetClip , fill , fillPreserve , fillExtents , inFill , mask , maskSurface , paint , paintWithAlpha , stroke , strokePreserve , strokeExtents , inStroke , copyPage , showPage -- ** Paths , getCurrentPoint , newPath , closePath , arc , arcNegative , curveTo , lineTo , moveTo , rectangle , textPath , relCurveTo , relLineTo , relMoveTo -- ** Patterns , withRGBPattern , withRGBAPattern , withPatternForSurface , withGroupPattern , withLinearPattern , withRadialPattern , patternAddColorStopRGB , patternAddColorStopRGBA , patternSetMatrix , patternGetMatrix , patternSetExtend , patternGetExtend , patternSetFilter , patternGetFilter -- ** Transformations , translate , scale , rotate , transform , setMatrix , getMatrix , identityMatrix , userToDevice , userToDeviceDistance , deviceToUser , deviceToUserDistance -- ** Text , selectFontFace , setFontSize , setFontMatrix , getFontMatrix , setFontOptions , showText , fontExtents , textExtents -- * Fonts -- ** Font options , fontOptionsCreate , fontOptionsCopy , fontOptionsMerge , fontOptionsHash , fontOptionsEqual , fontOptionsSetAntialias , fontOptionsGetAntialias , fontOptionsSetSubpixelOrder , fontOptionsGetSubpixelOrder , fontOptionsSetHintStyle , fontOptionsGetHintStyle , fontOptionsSetHintMetrics , fontOptionsGetHintMetrics -- * Surfaces , withSimilarSurface , createSimilarSurface , renderWithSimilarSurface , surfaceGetFontOptions , surfaceFinish , surfaceFlush , surfaceMarkDirty , surfaceMarkDirtyRectangle , surfaceSetDeviceOffset -- ** Image surfaces , withImageSurface , withImageSurfaceForData #if CAIRO_CHECK_VERSION(1,6,0) , formatStrideForWidth #endif , createImageSurfaceForData , createImageSurface , imageSurfaceGetWidth , imageSurfaceGetHeight #if CAIRO_CHECK_VERSION(1,2,0) , imageSurfaceGetFormat , imageSurfaceGetStride #if __GLASGOW_HASKELL__ >= 606 , imageSurfaceGetData #endif , SurfaceData , imageSurfaceGetPixels #endif #ifdef CAIRO_HAS_PNG_FUNCTIONS -- ** PNG support , withImageSurfaceFromPNG , imageSurfaceCreateFromPNG , surfaceWriteToPNG #endif #ifdef CAIRO_HAS_PDF_SURFACE -- ** PDF surfaces , withPDFSurface #if CAIRO_CHECK_VERSION(1,2,0) , pdfSurfaceSetSize #endif #endif #ifdef CAIRO_HAS_PS_SURFACE -- ** PS surfaces , withPSSurface #if CAIRO_CHECK_VERSION(1,2,0) , psSurfaceSetSize #endif #endif #ifdef CAIRO_HAS_SVG_SURFACE -- ** SVG surfaces , withSVGSurface #endif #if CAIRO_CHECK_VERSION(1,10,0) -- * Regions , regionCreate , regionCreateRectangle , regionCreateRectangles , regionCopy , regionGetExtents , regionNumRectangles , regionGetRectangle , regionIsEmpty , regionContainsPoint , regionContainsRectangle , regionEqual , regionTranslate , regionIntersect , regionIntersectRectangle , regionSubtract , regionSubtractRectangle , regionUnion , regionUnionRectangle , regionXor , regionXorRectangle #endif -- * Utilities , liftIO , version , versionString , CairoString -- * Types , Render , Matrix , Surface , Pattern , Status(..) , Operator(..) , Antialias(..) , FillRule(..) , LineCap(..) , LineJoin(..) , ScaledFont , FontFace , Glyph , TextExtents(..) , FontExtents(..) , FontSlant(..) , FontWeight(..) , SubpixelOrder(..) , HintStyle(..) , HintMetrics(..) , FontOptions , Path #if CAIRO_CHECK_VERSION(1,10,0) , RectangleInt(..) , RegionOverlap(..) , Region #endif , Content(..) , Format(..) , Extend(..) , Filter(..) ) where import Control.Monad (unless, when) import Control.Monad.Reader (ReaderT(runReaderT), ask, MonadIO, liftIO) import Control.Exception (bracket) import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Storable (Storable(..)) import Foreign.ForeignPtr ( touchForeignPtr ) #if __GLASGOW_HASKELL__ >= 606 import qualified Data.ByteString as BS #endif import Data.Ix -- internal module of GHC import Data.Array.Base ( MArray, newArray, newArray_, unsafeRead, unsafeWrite, #if __GLASGOW_HASKELL__ < 605 HasBounds, bounds #else getBounds #endif #if __GLASGOW_HASKELL__ >= 608 ,getNumElements #endif ) import Graphics.Rendering.Cairo.Internal (imageSurfaceCreateFromPNG) import Graphics.Rendering.Cairo.Types import Graphics.Rendering.Cairo.Internal.Utilities (CairoString(..)) import qualified Graphics.Rendering.Cairo.Internal as Internal import Graphics.Rendering.Cairo.Internal (Render(..), bracketR) liftRender0 :: (Cairo -> IO a) -> Render a liftRender0 f = ask >>= \context -> liftIO (f context) liftRender1 :: (Cairo -> a -> IO b) -> a -> Render b liftRender1 f a = ask >>= \context -> liftIO (f context a) liftRender2 :: (Cairo -> a -> b -> IO c) -> a -> b -> Render c liftRender2 f a b = ask >>= \context -> liftIO (f context a b) liftRender3 :: (Cairo -> a -> b -> c -> IO d) -> a -> b -> c -> Render d liftRender3 f a b c = ask >>= \context -> liftIO (f context a b c) liftRender4 :: (Cairo -> a -> b -> c -> d -> IO e) -> a -> b -> c -> d -> Render e liftRender4 f a b c d = ask >>= \context -> liftIO (f context a b c d) liftRender5 :: (Cairo -> a -> b -> c -> d -> e -> IO f) -> a -> b -> c -> d -> e -> Render f liftRender5 f a b c d e = ask >>= \context -> liftIO (f context a b c d e) liftRender6 :: (Cairo -> a -> b -> c -> d -> e -> f -> IO g) -> a -> b -> c -> d -> e -> f -> Render g liftRender6 f a b c d e g = ask >>= \context -> liftIO (f context a b c d e g) -- | Creates a new Render context with all graphics state parameters set to -- default values and with the given surface as a target surface. The target -- surface should be constructed with a backend-specific function such as -- 'withImageSurface' (or any other with\Surface variant). -- renderWith :: (MonadIO m) => Surface -- ^ the target surface for the Render context -> Render a -> m a renderWith surface (Render m) = liftIO $ bracket (Internal.create surface) (\context -> do status <- Internal.status context Internal.destroy context unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\context -> runReaderT m context) -- | Makes a copy of the current state and saves it on an internal stack of -- saved states. When 'restore' is called, the saved state is restored. -- Multiple calls to 'save' and 'restore' can be nested; each call to 'restore' -- restores the state from the matching paired 'save'. -- save :: Render () save = liftRender0 Internal.save -- | Restores to the state saved by a preceding call to 'save' and removes that -- state from the stack of saved states. -- restore :: Render () restore = liftRender0 Internal.restore -- | Ask for the status of the current 'Render' monad. -- status :: Render Status status = liftRender0 Internal.status -- | Gets the target surface for the Render context as passed to 'renderWith'. -- withTargetSurface :: (Surface -> Render a) -> Render a withTargetSurface f = do context <- ask surface <- liftIO $ Internal.getTarget context f surface -- | Like @pushGroupWithContent ContentColorAlpha@, but more convenient. pushGroup :: Render () pushGroup = liftRender0 Internal.pushGroup -- | Temporarily redirects drawing to an intermediate surface known as a group. -- The redirection lasts until the group is completed by a call to -- 'withGroupPattern' or 'popGroupToSource'. These calls provide the result of -- any drawing to the group as a pattern (either as an explicit object, or set -- as the source pattern). This group functionality can be convenient for -- performing intermediate compositing. One common use of a group is to render -- objects as opaque within the group (so that they occlude each other), and -- then blend the result with translucence onto the destination. -- -- Groups can be nested arbitrarily deeply by making balanced calls to -- 'pushGroupWithContent' and 'withGroupPattern'. As a side effect, -- 'pushGroupWithContent' calls 'save' and 'withGroupPattern' calls 'restore', -- so that any changes to the graphics state will not be visible outside the -- group. -- -- As an example, here is how one might fill and stroke a path with -- translucence, but without any portion of the fill being visible under the -- stroke: -- -- > pushGroup -- > setSource fillPattern -- > fillPreserve -- > setSource strokePattern -- > stroke -- > popGroupToSource -- > paintWithAlpha alpha pushGroupWithContent :: Content -> Render () pushGroupWithContent = liftRender1 Internal.pushGroupWithContent -- | Like @withGroupPattern setSource@, but more convenient. popGroupToSource :: Render () popGroupToSource = liftRender0 Internal.popGroupToSource -- | Sets the source pattern within the context to an opaque color. This opaque -- color will then be used for any subsequent drawing operation until a new source -- pattern is set. -- -- The color components are floating point numbers in the range 0 to 1. If the -- values passed in are outside that range, they will be clamped. -- setSourceRGB :: Double -- ^ red component of colour -> Double -- ^ green component of colour -> Double -- ^ blue compoment of colour -> Render () setSourceRGB = liftRender3 Internal.setSourceRGB -- | Sets the source pattern within the context to a translucent color. This -- color will then be used for any subsequent drawing operation until a new -- source pattern is set. -- -- The color and alpha components are floating point numbers in the range 0 to -- 1. If the values passed in are outside that range, they will be clamped. -- setSourceRGBA :: Double -- ^ red component of color -> Double -- ^ green component of color -> Double -- ^ blue component of color -> Double -- ^ alpha component of color -> Render () setSourceRGBA = liftRender4 Internal.setSourceRGBA -- | Sets the source pattern within the context to source. This pattern will -- then be used for any subsequent drawing operation until a new source pattern -- is set. -- -- Note: The pattern's transformation matrix will be locked to the user space -- in effect at the time of 'setSource'. This means that further -- modifications of the current transformation matrix will not affect the source -- pattern. See 'setMatrix'. -- setSource :: Pattern -- ^ a 'Pattern' to be used as the source for subsequent drawing -- operations. -> Render () setSource = liftRender1 Internal.setSource -- | This is a convenience function for creating a pattern from surface and -- setting it as the source in the context with 'setSource'. -- -- The x and y parameters give the user-space coordinate at which the surface -- origin should appear. (The surface origin is its upper-left corner before any -- transformation has been applied.) The x and y patterns are negated and then -- set as translation values in the pattern matrix. -- -- Other than the initial translation pattern matrix, as described above, all -- other pattern attributes, (such as its extend mode), are set to the default -- values as in 'patternCreateForSurface'. The resulting pattern can be queried -- with 'getSource' so that these attributes can be modified if desired, (eg. to -- create a repeating pattern with 'patternSetExtent'. -- setSourceSurface :: Surface -- ^ a surface to be used to set the source pattern -> Double -- ^ user-space X coordinate for surface origin -> Double -- ^ user-space Y coordinate for surface origin -> Render () setSourceSurface = liftRender3 Internal.setSourceSurface -- | Gets the current source pattern. -- getSource :: Render Pattern getSource = liftRender0 Internal.getSource -- | Set the antialiasing mode of the rasterizer used for drawing shapes. This -- value is a hint, and a particular backend may or may not support a particular -- value. At the current time, no backend supports 'AntialiasSubpixel' when -- drawing shapes. -- -- Note that this option does not affect text rendering, instead see -- 'fontOptionsSetAntilias'. -- setAntialias :: Antialias -- ^ the new antialiasing mode -> Render () setAntialias = liftRender1 Internal.setAntialias -- | Gets the current shape antialiasing mode, as set by 'setAntialias'. -- getAntialias :: Render Antialias getAntialias = liftRender0 Internal.getAntialias -- | Sets the dash pattern to be used by 'stroke'. A dash pattern is specified -- by dashes, a list of positive values. Each value provides the user-space -- length of altenate "on" and "off" portions of the stroke. The offset -- specifies an offset into the pattern at which the stroke begins. -- -- If @dashes@ is @[]@ then dashing is disabled. -- If @dashes@ is @[a]@ a symmetric pattern is assumed with alternating on and -- off portions of the size specified by the single value in dashes. -- If any value in @dashes@ is negative, or if all values are 0, then context -- will be put into an error state with a status of 'StatusInvalidDash'. -- setDash :: [Double] -- ^ @dashes@ a list specifying alternate lengths of on and off -- portions of the stroke -> Double -- ^ an offset into the dash pattern at which the stroke should -- start -> Render () setDash = liftRender2 Internal.setDash -- | Set the current fill rule within the cairo context. The fill rule is used -- to determine which regions are inside or outside a complex (potentially -- self-intersecting) path. The current fill rule affects both 'fill' and -- 'clip'. See 'FillRule' for details on the semantics of each available fill -- rule. -- setFillRule :: FillRule -- ^ a fill rule -> Render () setFillRule = liftRender1 Internal.setFillRule -- | Gets the current fill rule, as set by 'setFillrule'. -- getFillRule :: Render FillRule getFillRule = liftRender0 Internal.getFillRule -- | Sets the current line cap style within the cairo context. See 'LineCap' -- for details about how the available line cap styles are drawn. -- -- As with the other stroke parameters, the current line cap style is examined -- by 'stroke', 'strokeExtents', and 'strokeToPath', but does not have any -- effect during path construction. -- setLineCap :: LineCap -- ^ a line cap style -> Render () setLineCap = liftRender1 Internal.setLineCap -- | Gets the current line cap style, as set by 'setLineCap'. -- getLineCap :: Render LineCap getLineCap = liftRender0 Internal.getLineCap -- | Sets the current line join style within the cairo context. See 'LineJoin' -- for details about how the available line join styles are drawn. -- -- As with the other stroke parameters, the current line join style is examined -- by 'stroke', 'strokeExtents', and 'strokeToPath', but does not have any -- effect during path construction. -- setLineJoin :: LineJoin -- ^ a line joint style -> Render () setLineJoin = liftRender1 Internal.setLineJoin -- | Gets the current line join style, as set by 'setLineJoin'. -- getLineJoin :: Render LineJoin getLineJoin = liftRender0 Internal.getLineJoin -- | Sets the current line width within the cairo context. The line width -- specifies the diameter of a pen that is circular in user-space. -- -- As with the other stroke parameters, the current line cap style is examined -- by 'stroke', 'strokeExtents', and 'strokeToPath', but does not have any -- effect during path construction. -- setLineWidth :: Double -- ^ a line width -> Render () setLineWidth = liftRender1 Internal.setLineWidth -- | Gets the current line width, as set by 'setLineWidth'. -- getLineWidth :: Render Double getLineWidth = liftRender0 Internal.getLineWidth -- | -- setMiterLimit :: Double -- ^ - -> Render () setMiterLimit = liftRender1 Internal.setMiterLimit -- | Gets the current miter limit, as set by 'setMiterLimit'. -- getMiterLimit :: Render Double getMiterLimit = liftRender0 Internal.getMiterLimit -- | Sets the compositing operator to be used for all drawing operations. -- See 'Operator' for details on the semantics of each available compositing -- operator. -- setOperator :: Operator -- ^ a compositing operator -> Render () setOperator = liftRender1 Internal.setOperator -- | Gets the current compositing operator for a cairo context. -- getOperator :: Render Operator getOperator = liftRender0 Internal.getOperator -- | Sets the tolerance used when converting paths into trapezoids. Curved -- segments of the path will be subdivided until the maximum deviation between -- the original path and the polygonal approximation is less than tolerance. -- The default value is 0.1. A larger value will give better performance, -- a smaller value, better appearance. (Reducing the value from the default -- value of 0.1 is unlikely to improve appearance significantly.) -- setTolerance :: Double -- ^ the tolerance, in device units (typically pixels) -> Render () setTolerance = liftRender1 Internal.setTolerance -- | Gets the current tolerance value, as set by 'setTolerance'. -- getTolerance :: Render Double getTolerance = liftRender0 Internal.getTolerance -- | Establishes a new clip region by intersecting the current clip region with -- the current path as it would be filled by 'fill' and according to the current -- fill rule (see 'setFillRule'). -- -- After 'clip', the current path will be cleared from the cairo context. -- -- The current clip region affects all drawing operations by effectively masking -- out any changes to the surface that are outside the current clip region. -- -- Calling 'clip' can only make the clip region smaller, never larger. But the -- current clip is part of the graphics state, so a temporary restriction of the -- clip region can be achieved by calling 'clip' within a 'save'/'restore' pair. -- The only other means of increasing the size of the clip region is 'resetClip'. -- clip :: Render () clip = liftRender0 Internal.clip -- | Establishes a new clip region by intersecting the current clip region with -- the current path as it would be filled by 'fill' and according to the current -- fill rule (see 'setFillRule'). -- -- Unlike 'clip', cairoClipPreserve preserves the path within the cairo context. -- -- The current clip region affects all drawing operations by effectively masking -- out any changes to the surface that are outside the current clip region. -- -- Calling 'clip' can only make the clip region smaller, never larger. But the -- current clip is part of the graphics state, so a temporary restriction of the -- clip region can be achieved by calling 'clip' within a 'save'/'restore' pair. -- The only other means of increasing the size of the clip region is 'resetClip'. -- clipPreserve :: Render () clipPreserve = liftRender0 Internal.clipPreserve -- | Reset the current clip region to its original, unrestricted state. That is, -- set the clip region to an infinitely large shape containing the target -- surface. Equivalently, if infinity is too hard to grasp, one can imagine the -- clip region being reset to the exact bounds of the target surface. -- -- Note that code meant to be reusable should not call 'resetClip' as it will -- cause results unexpected by higher-level code which calls 'clip'. Consider -- using 'save' and 'restore' around 'clip' as a more robust means of -- temporarily restricting the clip region. -- resetClip :: Render () resetClip = liftRender0 Internal.resetClip -- | Computes a bounding box in user coordinates covering the area -- inside the current clip. -- clipExtents :: Render (Double,Double,Double,Double) clipExtents = liftRender0 Internal.clipExtents -- | A drawing operator that fills the current path according to the current -- fill rule, (each sub-path is implicitly closed before being filled). -- After 'fill', the current path will be cleared from the cairo context. -- -- See 'setFillRule' and 'fillPreserve'. -- fill :: Render () fill = liftRender0 Internal.fill -- | A drawing operator that fills the current path according to the current -- fill rule, (each sub-path is implicitly closed before being filled). -- Unlike 'fill', 'fillPreserve' preserves the path within the cairo context. -- -- See 'setFillRule' and 'fill'. -- fillPreserve :: Render () fillPreserve = liftRender0 Internal.fillPreserve -- | -- fillExtents :: Render (Double,Double,Double,Double) fillExtents = liftRender0 Internal.fillExtents -- | -- inFill :: Double -> Double -> Render Bool inFill = liftRender2 Internal.inFill -- | A drawing operator that paints the current source using the alpha channel -- of pattern as a mask. (Opaque areas of mask are painted with the source, -- transparent areas are not painted.) -- mask :: Pattern -- ^ a 'Pattern' -> Render () mask = liftRender1 Internal.mask -- | A drawing operator that paints the current source using the alpha channel -- of surface as a mask. (Opaque areas of surface are painted with the source, -- transparent areas are not painted.) -- maskSurface :: Surface -- ^ a 'Surface' -> Double -- ^ X coordinate at which to place the origin of surface -> Double -- ^ Y coordinate at which to place the origin of surface -> Render () maskSurface = liftRender3 Internal.maskSurface -- | A drawing operator that paints the current source everywhere within the -- current clip region. -- paint :: Render () paint = liftRender0 Internal.paint -- | A drawing operator that paints the current source everywhere within the -- current clip region using a mask of constant alpha value alpha. The effect -- is similar to 'paint', but the drawing is faded out using the alpha value. -- paintWithAlpha :: Double -- ^ alpha value, between 0 (transparent) and 1 (opaque) -> Render () paintWithAlpha = liftRender1 Internal.paintWithAlpha -- | A drawing operator that strokes the current path according to the current -- line width, line join, line cap, and dash settings. After issuing 'stroke', -- the current path will be cleared from the 'Render' monad. -- -- See 'setLineWidth', 'setLineJoin', 'setLineCap', 'setDash', and 'strokePreserve'. -- stroke :: Render () stroke = liftRender0 Internal.stroke -- | A drawing operator that strokes the current path according to the current -- line width, line join, line cap, and dash settings. Unlike 'stroke', -- 'strokePreserve' preserves the path within the 'Render' monad. -- -- See 'setLineWidth', 'setLineJoin', 'setLineCap', 'setDash', and 'strokePreserve'. -- strokePreserve :: Render () strokePreserve = liftRender0 Internal.strokePreserve -- | -- strokeExtents :: Render (Double,Double,Double,Double) strokeExtents = liftRender0 Internal.strokeExtents -- | -- inStroke :: Double -> Double -> Render Bool inStroke = liftRender2 Internal.inStroke -- | -- copyPage :: Render () copyPage = liftRender0 Internal.copyPage -- | -- showPage :: Render () showPage = liftRender0 Internal.showPage -- | Gets the current point of the current path, which is conceptually the final -- point reached by the path so far. -- -- The current point is returned in the user-space coordinate system. If there -- is no defined current point then x and y will both be set to 0.0. -- -- Most path construction functions alter the current point. See the following -- for details on how they affect the current point: 'newPath', 'moveTo', -- 'lineTo', 'curveTo', 'arc', 'relMoveTo', 'relLineTo', 'relCurveTo', -- 'arcNegative', 'textPath', 'strokeToPath'. -- getCurrentPoint :: Render (Double,Double) getCurrentPoint = liftRender0 Internal.getCurrentPoint -- | Clears the current path. After this call there will be no current point. -- newPath :: Render () newPath = liftRender0 Internal.newPath -- | Adds a line segment to the path from the current point to the beginning of -- the current subpath, (the most recent point passed to 'moveTo'), and closes -- this subpath. -- -- The behavior of 'closePath' is distinct from simply calling 'lineTo' with the -- equivalent coordinate in the case of stroking. When a closed subpath is -- stroked, there are no caps on the ends of the subpath. Instead, their is a -- line join connecting the final and initial segments of the subpath. -- closePath :: Render () closePath = liftRender0 Internal.closePath -- | Adds a circular arc of the given radius to the current path. The arc is -- centered at (@xc@, @yc@), begins at @angle1@ and proceeds in the direction of -- increasing angles to end at @angle2@. If @angle2@ is less than @angle1@ it -- will be progressively increased by @2*pi@ until it is greater than @angle1@. -- -- If there is a current point, an initial line segment will be added to the -- path to connect the current point to the beginning of the arc. -- -- Angles are measured in radians. An angle of 0 is in the direction of the -- positive X axis (in user-space). An angle of @pi/2@ radians (90 degrees) is in -- the direction of the positive Y axis (in user-space). Angles increase in the -- direction from the positive X axis toward the positive Y axis. So with the -- default transformation matrix, angles increase in a clockwise direction. -- -- (To convert from degrees to radians, use @degrees * (pi \/ 180)@.) -- -- This function gives the arc in the direction of increasing angles; see -- 'arcNegative' to get the arc in the direction of decreasing angles. -- -- The arc is circular in user-space. To achieve an elliptical arc, you can -- scale the current transformation matrix by different amounts in the X and Y -- directions. For example, to draw an ellipse in the box given by x, y, width, -- height: -- -- > save -- > translate (x + width / 2) (y + height / 2) -- > scale (1 / (height / 2.)) (1 / (width / 2)) -- > arc 0 0 1 0 (2 * pi) -- > restore -- arc :: Double -- ^ @xc@ - X position of the center of the arc -> Double -- ^ @yc@ - Y position of the center of the arc -> Double -- ^ @radius@ - the radius of the arc -> Double -- ^ @angle1@ - the start angle, in radians -> Double -- ^ @angle2@ - the end angle, in radians -> Render () arc = liftRender5 Internal.arc -- | Adds a circular arc of the given radius to the current path. The arc is -- centered at (@xc@, @yc@), begins at @angle1@ and proceeds in the direction of -- decreasing angles to end at @angle2@. If @angle2@ is greater than @angle1@ it -- will be progressively decreased by 2*@pi@ until it is greater than @angle1@. -- -- See 'arc' for more details. This function differs only in the direction of -- the arc between the two angles. -- arcNegative :: Double -- ^ @xc@ - X position of the center of the arc -> Double -- ^ @yc@ - Y position of the center of the arc -> Double -- ^ @radius@ - the radius of the arc -> Double -- ^ @angle1@ - the start angle, in radians -> Double -- ^ @angle2@ - the end angle, in radians -> Render () arcNegative = liftRender5 Internal.arcNegative -- | Adds a cubic Bezier spline to the path from the current point to position -- (@x3@, @y3@) in user-space coordinates, using (@x1@, @y1@) and (@x2@, @y2@) -- as the control points. After this call the current point will be (@x3@, @y3@). -- curveTo :: Double -- ^ @x1@ - the X coordinate of the first control point -> Double -- ^ @y1@ - the Y coordinate of the first control point -> Double -- ^ @x2@ - the X coordinate of the second control point -> Double -- ^ @y2@ - the Y coordinate of the second control point -> Double -- ^ @x3@ - the X coordinate of the end of the curve -> Double -- ^ @y3@ - the Y coordinate of the end of the curve -> Render () curveTo = liftRender6 Internal.curveTo -- | Adds a line to the path from the current point to position (@x@, @y@) in -- user-space coordinates. After this call the current point will be (@x@, @y@). -- lineTo :: Double -- ^ @x@ - the X coordinate of the end of the new line -> Double -- ^ @y@ - the Y coordinate of the end of the new line -> Render () lineTo = liftRender2 Internal.lineTo -- | If the current subpath is not empty, begin a new subpath. After this call -- the current point will be (@x@, @y@). -- moveTo :: Double -- ^ @x@ - the X coordinate of the new position -> Double -- ^ @y@ - the Y coordinate of the new position -> Render () moveTo = liftRender2 Internal.moveTo -- | Adds a closed-subpath rectangle of the given size to the current path at -- position (@x@, @y@) in user-space coordinates. -- rectangle :: Double -- ^ @x@ - the X coordinate of the top left corner of the rectangle -> Double -- ^ @y@ - the Y coordinate of the top left corner of the rectangle -> Double -- ^ @width@ - the width of the rectangle -> Double -- ^ @height@ - the height of the rectangle -> Render () rectangle = liftRender4 Internal.rectangle -- | Render text at the current path. -- -- * See 'showText' for why you should use Gtk functions. -- textPath :: CairoString string => string -- ^ - -> Render () textPath = liftRender1 Internal.textPath -- | Relative-coordinate version of 'curveTo'. All offsets are relative to the -- current point. Adds a cubic Bezier spline to the path from the current point -- to a point offset from the current point by (@dx3@, @dy3@), using points -- offset by (@dx1@, @dy1@) and (@dx2@, @dy2@) as the control points. After this -- call the current point will be offset by (@dx3@, @dy3@). -- -- Given a current point of (x, y), relCurveTo @dx1@ @dy1@ @dx2@ @dy2@ @dx3@ @dy3@ -- is logically equivalent to curveTo (x + @dx1@) (y + @dy1@) (x + @dx2@) (y + @dy2@) (x + @dx3@) (y + @dy3@). -- relCurveTo :: Double -- ^ @dx1@ - the X offset to the first control point -> Double -- ^ @dy1@ - the Y offset to the first control point -> Double -- ^ @dx2@ - the X offset to the second control point -> Double -- ^ @dy2@ - the Y offset to the second control point -> Double -- ^ @dx3@ - the X offset to the end of the curve -> Double -- ^ @dy3@ - the Y offset to the end of the curve -> Render () relCurveTo = liftRender6 Internal.relCurveTo -- | Relative-coordinate version of 'lineTo'. Adds a line to the path from the -- current point to a point that is offset from the current point by (@dx@, @dy@) -- in user space. After this call the current point will be offset by (@dx@, @dy@). -- -- Given a current point of (x, y), relLineTo @dx@ @dy@ is logically equivalent -- to lineTo (x + @dx@) (y + @dy@). -- relLineTo :: Double -- ^ @dx@ - the X offset to the end of the new line -> Double -- ^ @dy@ - the Y offset to the end of the new line -> Render () relLineTo = liftRender2 Internal.relLineTo -- | If the current subpath is not empty, begin a new subpath. After this call -- the current point will offset by (x, y). -- -- Given a current point of (x, y), relMoveTo @dx@ @dy@ is logically equivalent -- to moveTo (x + @dx@) (y + @dy@) -- relMoveTo :: Double -- ^ @dx@ - the X offset -> Double -- ^ @dy@ - the Y offset -> Render () relMoveTo = liftRender2 Internal.relMoveTo -- | Creates a new 'Pattern' corresponding to an opaque color. The color -- components are floating point numbers in the range 0 to 1. If the values -- passed in are outside that range, they will be clamped. -- -- For example to create a solid red pattern: -- -- > withRBGPattern 1 0 0 $ do -- > ... -- > ... -- withRGBPattern :: Double -- ^ red component of the color -> Double -- ^ green component of the color -> Double -- ^ blue component of the color -> (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withRGBPattern r g b f = bracketR (Internal.patternCreateRGB r g b) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\pattern -> f pattern) -- | Creates a new 'Pattern' corresponding to a translucent color. The color -- components are floating point numbers in the range 0 to 1. If the values -- passed in are outside that range, they will be clamped. -- -- For example to create a solid red pattern at 50% transparency: -- -- > withRBGPattern 1 0 0 0.5 $ do -- > ... -- > ... -- withRGBAPattern :: Double -- ^ red component of color -> Double -- ^ green component of color -> Double -- ^ blue component of color -> Double -- ^ alpha component of color -> (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withRGBAPattern r g b a f = bracketR (Internal.patternCreateRGBA r g b a) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\pattern -> f pattern) -- | Create a new 'Pattern' for the given surface. -- withPatternForSurface :: Surface -> (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withPatternForSurface surface f = bracketR (Internal.patternCreateForSurface surface) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\pattern -> f pattern) -- | Pop the current group from the group stack and use it as a pattern. The -- group should be populated first by calling 'pushGroup' or -- 'pushGroupWithContent' and doing some drawing operations. This also calls -- 'restore' to balance the 'save' called in 'pushGroup'. withGroupPattern :: (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withGroupPattern f = do context <- ask bracketR (Internal.popGroup context) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) f -- | Create a new linear gradient 'Pattern' along the line defined by @(x0, y0)@ -- and @(x1, y1)@. Before using the gradient pattern, a number of color stops -- should be defined using 'patternAddColorStopRGB' and 'patternAddColorStopRGBA'. -- -- * Note: The coordinates here are in pattern space. For a new pattern, -- pattern space is identical to user space, but the relationship between the -- spaces can be changed with 'patternSetMatrix'. -- withLinearPattern :: Double -- ^ @x0@ - x coordinate of the start point -> Double -- ^ @y0@ - y coordinate of the start point -> Double -- ^ @x1@ - x coordinate of the end point -> Double -- ^ @y1@ - y coordinate of the end point -> (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withLinearPattern x0 y0 x1 y1 f = bracketR (Internal.patternCreateLinear x0 y0 x1 y1) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\pattern -> f pattern) -- | Creates a new radial gradient 'Pattern' between the two circles defined by -- @(x0, y0, c0)@ and @(x1, y1, c0)@. Before using the gradient pattern, a -- number of color stops should be defined using 'patternAddColorStopRGB' -- or 'patternAddColorStopRGBA'. -- -- * Note: The coordinates here are in pattern space. For a new pattern, -- pattern space is identical to user space, but the relationship between the -- spaces can be changed with 'patternSetMatrix'. -- withRadialPattern :: Double -- ^ @cx0@ - x coordinate for the center of the start circle -> Double -- ^ @cy0@ - y coordinate for the center of the start circle -> Double -- ^ @radius0@ - radius of the start cirle -> Double -- ^ @cx1@ - x coordinate for the center of the end circle -> Double -- ^ @cy1@ - y coordinate for the center of the end circle -> Double -- ^ @radius1@ - radius of the end circle -> (Pattern -> Render a) -- ^ a nested render action using the pattern -> Render a withRadialPattern cx0 cy0 radius0 cx1 cy1 radius1 f = bracketR (Internal.patternCreateRadial cx0 cy0 radius0 cx1 cy1 radius1) (\pattern -> do status <- Internal.patternStatus pattern liftIO $ Internal.patternDestroy pattern unless (status == StatusSuccess) $ fail =<< Internal.statusToString status) (\pattern -> f pattern) -- | Adds an opaque color stop to a gradient pattern. The offset specifies the -- location along the gradient's control vector. For example, a linear gradient's -- control vector is from (x0,y0) to (x1,y1) while a radial gradient's control -- vector is from any point on the start circle to the corresponding point on -- the end circle. -- -- The color is specified in the same way as in 'setSourceRGB'. -- -- Note: If the pattern is not a gradient pattern, (eg. a linear or radial -- pattern), then the pattern will be put into an error status with a status of -- 'StatusPatternTypeMismatch'. -- patternAddColorStopRGB :: MonadIO m => Pattern -- ^ a 'Pattern' -> Double -- ^ an offset in the range [0.0 .. 1.0] -> Double -- ^ red component of color -> Double -- ^ green component of color -> Double -- ^ blue component of color -> m () patternAddColorStopRGB p offset r g b = liftIO $ Internal.patternAddColorStopRGB p offset r g b -- | Adds a translucent color stop to a gradient pattern. The offset specifies -- the location along the gradient's control vector. For example, a linear -- gradient's control vector is from (x0,y0) to (x1,y1) while a radial gradient's -- control vector is from any point on the start circle to the corresponding -- point on the end circle. -- -- The color is specified in the same way as in setSourceRGBA. -- -- Note: If the pattern is not a gradient pattern, (eg. a linear or radial -- pattern), then the pattern will be put into an error status with a status of -- 'StatusPatternTypeMismatch'. -- patternAddColorStopRGBA :: MonadIO m => Pattern -- ^ a 'Pattern' -> Double -- ^ an offset in the range [0.0 .. 1.0] -> Double -- ^ red component of color -> Double -- ^ green component of color -> Double -- ^ blue component of color -> Double -- ^ alpha component of color -> m () patternAddColorStopRGBA p offset r g b a = liftIO $ Internal.patternAddColorStopRGBA p offset r g b a -- | Sets the pattern's transformation matrix to matrix. This matrix is a -- transformation from user space to pattern space. -- -- When a pattern is first created it always has the identity matrix for its -- transformation matrix, which means that pattern space is initially identical -- to user space. -- -- Important: Please note that the direction of this transformation matrix is -- from user space to pattern space. This means that if you imagine the flow -- from a pattern to user space (and on to device space), then coordinates in -- that flow will be transformed by the inverse of the pattern matrix. -- -- Also, please note the discussion of the user-space locking semantics of 'setSource'. -- patternSetMatrix :: MonadIO m => Pattern -- ^ a 'Pattern' -> Matrix -- ^ a 'Matrix' -> m () patternSetMatrix p m = liftIO $ Internal.patternSetMatrix p m -- | Get the pattern's transformation matrix. -- patternGetMatrix :: MonadIO m => Pattern -- ^ a 'Pattern' -> m Matrix patternGetMatrix p = liftIO $ Internal.patternGetMatrix p -- | -- patternSetExtend :: MonadIO m => Pattern -- ^ a 'Pattern' -> Extend -- ^ an 'Extent' -> m () patternSetExtend p e = liftIO $ Internal.patternSetExtend p e -- | -- patternGetExtend :: MonadIO m => Pattern -- ^ a 'Pattern' -> m Extend patternGetExtend p = liftIO $ Internal.patternGetExtend p -- | -- patternSetFilter :: MonadIO m => Pattern -- ^ a 'Pattern' -> Filter -- ^ a 'Filter' -> m () patternSetFilter p f = liftIO $ Internal.patternSetFilter p f -- | -- patternGetFilter :: MonadIO m => Pattern -- ^ a 'Pattern' -> m Filter patternGetFilter p = liftIO $ Internal.patternGetFilter p -- | Modifies the current transformation matrix (CTM) by translating the -- user-space origin by @(tx, ty)@. This offset is interpreted as a user-space -- coordinate according to the CTM in place before the new call to 'translate'. -- In other words, the translation of the user-space origin takes place after -- any existing transformation. -- translate :: Double -- ^ @tx@ - amount to translate in the X direction -> Double -- ^ @ty@ - amount to translate in the Y direction -> Render () translate = liftRender2 Internal.translate -- | Modifies the current transformation matrix (CTM) by scaling the X and Y -- user-space axes by sx and sy respectively. The scaling of the axes takes -- place after any existing transformation of user space. -- scale :: Double -- ^ @sx@ - scale factor for the X dimension -> Double -- ^ @sy@ - scale factor for the Y dimension -> Render () scale = liftRender2 Internal.scale -- | Modifies the current transformation matrix (CTM) by rotating the user-space -- axes by @angle@ radians. The rotation of the axes takes places after any -- existing transformation of user space. The rotation direction for positive -- angles is from the positive X axis toward the positive Y axis. -- rotate :: Double -- ^ @angle@ - angle (in radians) by which the user-space axes will -- be rotated -> Render () rotate = liftRender1 Internal.rotate -- | Modifies the current transformation matrix (CTM) by applying matrix as an -- additional transformation. The new transformation of user space takes place -- after any existing transformation. -- transform :: Matrix -- ^ @matrix@ - a transformation to be applied to the user-space axes -> Render () transform = liftRender1 Internal.transform -- | Modifies the current transformation matrix (CTM) by setting it equal to -- @matrix@. setMatrix :: Matrix -- ^ @matrix@ - a transformation matrix from user space to device space -> Render () setMatrix = liftRender1 Internal.setMatrix -- | Gets the current transformation matrix, as set by 'setMatrix'. -- getMatrix :: Render Matrix getMatrix = liftRender0 Internal.getMatrix -- | Resets the current transformation matrix (CTM) by setting it equal to the -- identity matrix. That is, the user-space and device-space axes will be -- aligned and one user-space unit will transform to one device-space unit. -- identityMatrix :: Render () identityMatrix = liftRender0 Internal.identityMatrix -- | Transform a coordinate from user space to device space by multiplying the -- given point by the current transformation matrix (CTM). -- userToDevice :: Double -- ^ X value of coordinate -> Double -- ^ Y value of coordinate -> Render (Double,Double) userToDevice = liftRender2 Internal.userToDevice -- | Transform a distance vector from user space to device space. This function -- is similar to 'userToDevice' except that the translation components of the -- CTM will be ignored when transforming @(dx,dy)@. -- userToDeviceDistance :: Double -- ^ @dx@ - X component of a distance vector -> Double -- ^ @dy@ - Y component of a distance vector -> Render (Double,Double) userToDeviceDistance = liftRender2 Internal.userToDeviceDistance -- | Transform a coordinate from device space to user space by multiplying the -- given point by the inverse of the current transformation matrix (CTM). -- deviceToUser :: Double -- ^ X value of coordinate -> Double -- ^ Y value of coordinate -> Render (Double,Double) deviceToUser = liftRender2 Internal.deviceToUser -- | Transform a distance vector from device space to user space. This function -- is similar to 'deviceToUser' except that the translation components of the -- inverse CTM will be ignored when transforming @(dx,dy)@. -- deviceToUserDistance :: Double -- ^ @dx@ - X component of a distance vector -> Double -- ^ @dy@ - Y component of a distance vector -> Render (Double,Double) deviceToUserDistance = liftRender2 Internal.deviceToUserDistance -- | Selects a family and style of font from a simplified description as a -- @family@ name, @slant@ and @weight@. This function is meant to be used only -- for applications with simple font needs: Cairo doesn't provide for operations -- such as listing all available fonts on the system, and it is expected that -- most applications will need to use a more comprehensive font handling and -- text layout library in addition to cairo. -- selectFontFace :: CairoString string => string -- ^ @family@ - a font family name -> FontSlant -- ^ @slant@ - the slant for the font -> FontWeight -- ^ @weight@ - the weight of the font -> Render () selectFontFace = liftRender3 Internal.selectFontFace -- | Sets the current font matrix to a scale by a factor of @size@, replacing -- any font matrix previously set with 'setFontSize' or 'setFontMatrix'. This -- results in a font size of size user space units. (More precisely, this matrix -- will result in the font's em-square being a size by size square in user space.) -- setFontSize :: Double -- ^ @size@ - the new font size, in user space units -> Render () setFontSize = liftRender1 Internal.setFontSize -- | Sets the current font matrix to @matrix@. The font matrix gives a -- transformation from the design space of the font (in this space, the -- em-square is 1 unit by 1 unit) to user space. Normally, a simple scale is -- used (see 'setFontSize'), but a more complex font matrix can be used to shear -- the font or stretch it unequally along the two axes. -- setFontMatrix :: Matrix -- ^ @matrix@ - a 'Matrix' describing a transform to be applied to -- the current font. -> Render () setFontMatrix = liftRender1 Internal.setFontMatrix -- | Gets the current font matrix, as set by 'setFontMatrix' -- getFontMatrix :: Render Matrix getFontMatrix = liftRender0 Internal.getFontMatrix -- | Sets a set of custom font rendering options. Rendering options are -- derived by merging these options with the options derived from underlying -- surface; if the value in @options@ has a default value (like -- 'AntialiasDefault'), then the value from the surface is used. -- setFontOptions :: FontOptions -> Render () setFontOptions = liftRender1 Internal.setFontOptions -- | A drawing operator that generates the shape from a string of Unicode -- characters, rendered according to the current font face, font size (font -- matrix), and font options. -- -- This function first computes a set of glyphs for the string of text. The -- first glyph is placed so that its origin is at the current point. The origin -- of each subsequent glyph is offset from that of the previous glyph by the -- advance values of the previous glyph. -- -- After this call the current point is moved to the origin of where the next -- glyph would be placed in this same progression. That is, the current point -- will be at the origin of the final glyph offset by its advance values. This -- allows for easy display of a single logical string with multiple calls to -- 'showText'. -- -- NOTE: The 'showText' function call is part of what the cairo designers call -- the \"toy\" text API. It is convenient for short demos and simple programs, -- but it is not expected to be adequate for the most serious of text-using -- applications. -- showText :: CairoString string => string -- ^ a string of text -> Render () showText = liftRender1 Internal.showText -- | Gets the font extents for the currently selected font. -- fontExtents :: Render FontExtents fontExtents = liftRender0 Internal.fontExtents -- | Gets the extents for a string of text. The extents describe a user-space -- rectangle that encloses the \"inked\" portion of the text, (as it would be -- drawn by 'showText'). Additionally, the 'textExtentsXadvance' and -- 'textExtentsYadvance' values indicate the amount by which the current point -- would be advanced by 'showText'. -- -- Note that whitespace characters do not directly contribute to the size of -- the rectangle ('textExtentsWidth' and 'textExtentsHeight'). They do contribute -- indirectly by changing the position of non-whitespace characters. -- In particular, trailing whitespace characters are likely to not affect the -- size of the rectangle, though they will affect the 'textExtentsXadvance' and -- 'textExtentsYadvance' values. -- textExtents :: CairoString string => string -- ^ a string of text -> Render TextExtents textExtents = liftRender1 Internal.textExtents -- | Allocates a new font options object with all options initialized to default -- values. -- fontOptionsCreate :: MonadIO m => m FontOptions fontOptionsCreate = liftIO $ Internal.fontOptionsCreate -- | Allocates a new font options object copying the option values from @original@. -- fontOptionsCopy :: MonadIO m => FontOptions -- ^ @original@ -> m FontOptions fontOptionsCopy a = liftIO $ Internal.fontOptionsCopy a -- | Merges non-default options from @other@ into @options@, replacing existing -- values. This operation can be thought of as somewhat similar to compositing -- @other@ onto @options@ with the operation of 'OperationOver'. -- fontOptionsMerge :: MonadIO m => FontOptions -- ^ @options@ -> FontOptions -- ^ @other@ -> m () fontOptionsMerge a b = liftIO $ Internal.fontOptionsMerge a b -- | Compute a hash for the font options object; this value will be useful when -- storing an object containing a 'FontOptions' in a hash table. -- fontOptionsHash :: MonadIO m => FontOptions -> m Int fontOptionsHash a = liftIO $ Internal.fontOptionsHash a -- | Compares two font options objects for equality. -- fontOptionsEqual :: MonadIO m => FontOptions -> FontOptions -> m Bool fontOptionsEqual a b = liftIO $ Internal.fontOptionsEqual a b -- | Sets the antiliasing mode for the font options object. This specifies the -- type of antialiasing to do when rendering text. -- fontOptionsSetAntialias :: MonadIO m => FontOptions -> Antialias -> m () fontOptionsSetAntialias a b = liftIO $ Internal.fontOptionsSetAntialias a b -- | Gets the antialising mode for the font options object. -- fontOptionsGetAntialias :: MonadIO m => FontOptions -> m Antialias fontOptionsGetAntialias a = liftIO $ Internal.fontOptionsGetAntialias a -- | Sets the subpixel order for the font options object. The subpixel order -- specifies the order of color elements within each pixel on the display device -- when rendering with an antialiasing mode of 'AntialiasSubpixel'. -- See the documentation for 'SubpixelOrder' for full details. -- fontOptionsSetSubpixelOrder :: MonadIO m => FontOptions -> SubpixelOrder-> m () fontOptionsSetSubpixelOrder a b = liftIO $ Internal.fontOptionsSetSubpixelOrder a b -- | Gets the subpixel order for the font options object. -- See the documentation for 'SubpixelOrder' for full details. -- fontOptionsGetSubpixelOrder :: MonadIO m => FontOptions -> m SubpixelOrder fontOptionsGetSubpixelOrder a = liftIO $ Internal.fontOptionsGetSubpixelOrder a -- | Sets the hint style for font outlines for the font options object. -- This controls whether to fit font outlines to the pixel grid, and if so, -- whether to optimize for fidelity or contrast. See the documentation for -- 'HintStyle' for full details. -- fontOptionsSetHintStyle :: MonadIO m => FontOptions -> HintStyle -> m () fontOptionsSetHintStyle a b = liftIO $ Internal.fontOptionsSetHintStyle a b -- | Gets the hint style for font outlines for the font options object. -- See the documentation for 'HintStyle' for full details. -- fontOptionsGetHintStyle :: MonadIO m => FontOptions -> m HintStyle fontOptionsGetHintStyle a = liftIO $ Internal.fontOptionsGetHintStyle a -- | Sets the metrics hinting mode for the font options object. This controls -- whether metrics are quantized to integer values in device units. See the -- documentation for 'HintMetrics' for full details. -- fontOptionsSetHintMetrics :: MonadIO m => FontOptions -> HintMetrics -> m () fontOptionsSetHintMetrics a b = liftIO $ Internal.fontOptionsSetHintMetrics a b -- | Gets the metrics hinting mode for the font options object. See the -- documentation for 'HintMetrics' for full details. -- fontOptionsGetHintMetrics :: MonadIO m => FontOptions -> m HintMetrics fontOptionsGetHintMetrics a = liftIO $ Internal.fontOptionsGetHintMetrics a -- | Create a temporary surface that is as compatible as possible with an -- existing surface. The new surface will use the same backend as other unless -- that is not possible for some reason. -- withSimilarSurface :: Surface -- ^ an existing surface used to select the backend of the new surface -> Content -- ^ the content type for the new surface (color, color+alpha or alpha only) -> Int -- ^ width of the new surface, (in device-space units) -> Int -- ^ height of the new surface (in device-space units) -> (Surface -> IO a) -> IO a withSimilarSurface surface contentType width height f = bracket (Internal.surfaceCreateSimilar surface contentType width height) (\surface' -> do status <- Internal.surfaceStatus surface' Internal.surfaceDestroy surface' unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface' -> f surface') -- | Like 'withSimilarSurface' but creates a Surface that is managed by the -- Haskell memory manager rather than only being temporaily allocated. This -- is more flexible and allows you to create surfaces that persist, which -- can be very useful, for example to cache static elements in an animation. -- -- However you should be careful because surfaces can be expensive resources -- and the Haskell memory manager cannot guarantee when it will release them. -- You can manually release the resources used by a surface with -- 'surfaceFinish'. -- createSimilarSurface :: Surface -- ^ an existing surface used to select the backend of the new surface -> Content -- ^ the content type for the new surface (color, color+alpha or alpha only) -> Int -- ^ width of the surface, in pixels -> Int -- ^ height of the surface, in pixels -> IO Surface createSimilarSurface surface contentType width height = do surface <- Internal.surfaceCreateSimilar surface contentType width height Internal.manageSurface surface return surface -- | Create a temporary surface that is compatible with the current target -- surface (like a combination of 'withTargetSurface' and 'withSimilarSurface'). -- -- This is useful for drawing to a temporary surface and then compositing it -- into the main suface. For example, the following code draws to a temporary -- surface and then uses that as a mask: -- -- > renderWithSimilarSurface ContentAlpha 200 200 $ \tmpSurface -> do -- > renderWith tmpSurface $ do -- > ... -- draw onto the temporary surface -- > -- > -- use the temporary surface as a mask, filling it with the -- > -- current source which in this example is transparent red. -- > setSourceRGBA 1 0 0 0.5 -- > setOperator Operator{something} -- think of something clever to do -- > maskSurface tmpSurface 0 0) -- renderWithSimilarSurface :: Content -- ^ the content type for the new surface -- (color, colour+alpha or alpha only) -> Int -- ^ width of the new surface, (in device-space units) -> Int -- ^ height of the new surface, (in device-space units) -> (Surface -> Render a) -- ^ this action draws on the main surface, -- possibly making use of the temporary surface -- (which gets destroyed afterwards). -> Render a renderWithSimilarSurface contentType width height render = withTargetSurface $ \surface -> bracketR (Internal.surfaceCreateSimilar surface contentType width height) (\surface' -> do status <- Internal.surfaceStatus surface' Internal.surfaceDestroy surface' unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface' -> render surface') -- | This function finishes the surface and drops all references to external -- resources. For example, for the Xlib backend it means that cairo will no -- longer access the drawable, which can be freed. After calling 'surfaceFinish' -- the only valid operations on a surface are getting and setting user data and -- referencing and destroying it. Further drawing to the surface will not affect -- the surface but will instead trigger a 'StatusSurfaceFinished' error. -- -- When the last call to 'surfaceDestroy' decreases the reference count to zero, -- cairo will call 'surfaceFinish' if it hasn't been called already, before -- freeing the resources associated with the surface. -- surfaceFinish :: MonadIO m => Surface -> m () surfaceFinish surface = liftIO $ do status <- Internal.surfaceStatus surface Internal.surfaceFinish surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Do any pending drawing for the surface and also restore any temporary -- modification's cairo has made to the surface's state. This function must be -- called before switching from drawing on the surface with cairo to drawing on -- it directly with native APIs. If the surface doesn't support direct access, -- then this function does nothing. -- surfaceFlush :: MonadIO m => Surface -> m () surfaceFlush a = liftIO $ Internal.surfaceFlush a -- | Retrieves the default font rendering options for the surface. This allows -- display surfaces to report the correct subpixel order for rendering on them, -- print surfaces to disable hinting of metrics and so forth. The result can -- then be used with 'scaledFontCreate'. -- surfaceGetFontOptions :: Surface -> Render FontOptions surfaceGetFontOptions surface = do fontOptions <- fontOptionsCreate liftIO $ Internal.surfaceGetFontOptions surface fontOptions return fontOptions -- | Tells cairo that drawing has been done to surface using means other than -- cairo, and that cairo should reread any cached areas. Note that you must call -- 'surfaceFlush' before doing such drawing. -- surfaceMarkDirty :: MonadIO m => Surface -> m () surfaceMarkDirty a = liftIO $ Internal.surfaceMarkDirty a -- | Like 'surfaceMarkDirty', but drawing has been done only to the specified -- rectangle, so that cairo can retain cached contents for other parts of the -- surface. -- surfaceMarkDirtyRectangle :: MonadIO m => Surface -- ^ a 'Surface' -> Int -- ^ X coordinate of dirty rectangle -> Int -- ^ Y coordinate of dirty rectangle -> Int -- ^ width of dirty rectangle -> Int -- ^ height of dirty rectangle -> m () surfaceMarkDirtyRectangle a b c d e = liftIO $ Internal.surfaceMarkDirtyRectangle a b c d e -- | Sets an offset that is added to the device coordinates determined by the -- CTM when drawing to surface. One use case for this function is when we want -- to create a 'Surface' that redirects drawing for a portion of an -- onscreen surface to an offscreen surface in a way that is completely -- invisible to the user of the cairo API. Setting a transformation via -- 'translate' isn't sufficient to do this, since functions like 'deviceToUser' -- will expose the hidden offset. -- -- Note that the offset only affects drawing to the surface, not using the -- surface in a surface pattern. -- surfaceSetDeviceOffset :: MonadIO m => Surface -- ^ a 'Surface' -> Double -- ^ the offset in the X direction, in device units -> Double -- ^ the offset in the Y direction, in device units -> m () surfaceSetDeviceOffset a b c = liftIO $ Internal.surfaceSetDeviceOffset a b c #if CAIRO_CHECK_VERSION(1,6,0) -- | This function provides a stride value that will respect all alignment -- requirements of the accelerated image-rendering code within cairo. -- formatStrideForWidth :: Format -- ^ format of pixels in the surface to create -> Int -- ^ width of the surface, in pixels -> Int -- ^ the stride (number of bytes necessary to store one line) -- or @-1@ if the format is invalid or the width is too large formatStrideForWidth = Internal.formatStrideForWidth #endif -- | Creates an image surface of the specified format and dimensions. -- The initial contents of the surface is undefined; you must explicitely -- clear the buffer, using, for example, 'rectangle' and 'fill' if you want it -- cleared. -- withImageSurface :: Format -- ^ format of pixels in the surface to create -> Int -- ^ width of the surface, in pixels -> Int -- ^ height of the surface, in pixels -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is -- only valid within in this action. -> IO a withImageSurface format width height f = bracket (Internal.imageSurfaceCreate format width height) (\surface -> do status <- Internal.surfaceStatus surface Internal.surfaceDestroy surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface -> f surface) -- | Like 'withImageSurface' but creates a Surface that is managed by the -- Haskell memory manager rather than only being temporaily allocated. This -- is more flexible and allows you to create surfaces that persist, which -- can be very useful, for example to cache static elements in an animation. -- -- However you should be careful because surfaces can be expensive resources -- and the Haskell memory manager cannot guarantee when it will release them. -- You can manually release the resources used by a surface with -- 'surfaceFinish'. -- createImageSurface :: Format -- ^ format of pixels in the surface to create -> Int -- ^ width of the surface, in pixels -> Int -- ^ height of the surface, in pixels -> IO Surface createImageSurface format width height = do surface <- Internal.imageSurfaceCreate format width height Internal.manageSurface surface return surface -- | Like 'withImageSurface' but creating a surface to target external -- data pointed to by 'PixelData'. -- withImageSurfaceForData :: PixelData -- ^ pointer to pixel data -> Format -- ^ format of pixels in the surface to create -> Int -- ^ width of the surface, in pixels -> Int -- ^ height of the surface, in pixels -> Int -- ^ size of stride between rows in the surface to create -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is -- only valid within this action -> IO a withImageSurfaceForData pixels format width height stride f = bracket (Internal.imageSurfaceCreateForData pixels format width height stride) (\surface -> do status <- Internal.surfaceStatus surface Internal.surfaceDestroy surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface -> f surface) -- | Like 'createImageSurface' but creating a surface to target external -- data pointed to by 'PixelData'. -- createImageSurfaceForData :: PixelData -- ^ pointer to pixel data -> Format -- ^ format of pixels in the surface to create -> Int -- ^ width of the surface, in pixels -> Int -- ^ height of the surface, in pixels -> Int -- ^ size of stride between rows in the surface to create -> IO Surface createImageSurfaceForData pixels format width height stride = do surface <- Internal.imageSurfaceCreateForData pixels format width height stride Internal.manageSurface surface return surface -- | Get the width of the image surface in pixels. -- imageSurfaceGetWidth :: MonadIO m => Surface -> m Int imageSurfaceGetWidth a = liftIO $ Internal.imageSurfaceGetWidth a -- | Get the height of the image surface in pixels. -- imageSurfaceGetHeight :: MonadIO m => Surface -> m Int imageSurfaceGetHeight a = liftIO $ Internal.imageSurfaceGetHeight a #if CAIRO_CHECK_VERSION(1,2,0) -- | Get the number of bytes from the start of one row to the start of the -- next. If the image data contains no padding, then this is equal to -- the pixel depth * the width. imageSurfaceGetStride :: MonadIO m => Surface -> m Int imageSurfaceGetStride = liftIO . Internal.imageSurfaceGetStride -- | Get the format of the surface. -- imageSurfaceGetFormat :: MonadIO m => Surface -> m Format imageSurfaceGetFormat a = liftIO $ Internal.imageSurfaceGetFormat a #if __GLASGOW_HASKELL__ >= 606 -- | Return a ByteString of the image data for a surface. In order to remain -- safe the returned ByteString is a copy of the data. This is a little -- slower than returning a pointer into the image surface object itself, but -- much safer imageSurfaceGetData :: Surface -> IO BS.ByteString imageSurfaceGetData a = do height <- Internal.imageSurfaceGetHeight a stride <- Internal.imageSurfaceGetStride a ptr <- Internal.imageSurfaceGetData a #if __GLASGOW_HASKELL__ < 608 BS.copyCStringLen (castPtr ptr, height * stride) #else BS.packCStringLen (castPtr ptr, height * stride) #endif #endif -- | Retrieve the internal array of raw image data. -- -- * Image data in an image surface is stored in memory in uncompressed, -- packed format. Rows in the image are stored top to bottom, and in each -- row pixels are stored from left to right. There may be padding at the end -- of a row. The value returned by 'imageSurfaceGetStride' indicates the -- number of bytes between rows. -- -- * The returned array is a flat representation of a three dimensional array: -- x-coordiante, y-coordinate and several channels for each color. The -- format depends on the 'Format' of the surface: -- -- 'FormatARGB32': each pixel is 32 bits with alpha in the upper 8 bits, -- followed by 8 bits for red, green and blue. Pre-multiplied alpha is used. -- (That is, 50% transparent red is 0x80800000, not 0x80ff0000.) -- -- 'FormatRGB24': each pixel is 32 bits with the upper 8 bits being unused, -- followed by 8 bits for red, green and blue. -- -- 'FormatA8': each pixel is 8 bits holding an alpha value -- -- 'FormatA1': each pixel is one bit where pixels are packed into 32 bit -- quantities. The ordering depends on the endianes of the platform. On a -- big-endian machine, the first pixel is in the uppermost bit, on a -- little-endian machine the first pixel is in the least-significant bit. -- -- * To read or write a specific pixel (and assuming 'FormatARGB32' or -- 'FormatRGB24'), use the formula: @p = y * (rowstride `div` 4) + x@ for the -- pixel and force the array to have 32-bit words or integers. -- -- * Calling this function without explicitly giving it a type will often lead -- to a compiler error since the type parameter @e@ is underspecified. If -- this happens the function can be explicitly typed: -- @surData <- (imageSurfaceGetPixels pb :: IO (SurfaceData Int Word32))@ -- -- * If modifying an image through Haskell\'s array interface is not fast -- enough, it is possible to use 'unsafeRead' and 'unsafeWrite' which have -- the same type signatures as 'readArray' and 'writeArray'. Note that these -- are internal functions that might change with GHC. -- -- * After each write access to the array, you need to inform Cairo -- about the area that has changed using 'surfaceMarkDirty'. -- -- * The function will return an error if the surface is not an image -- surface or if 'surfaceFinish' has been called on the surface. -- imageSurfaceGetPixels :: Storable e => Surface -> IO (SurfaceData Int e) imageSurfaceGetPixels pb = do pixPtr <- Internal.imageSurfaceGetData pb when (pixPtr==nullPtr) $ do fail "imageSurfaceGetPixels: image surface not available" h <- imageSurfaceGetHeight pb r <- imageSurfaceGetStride pb return (mkSurfaceData pb (castPtr pixPtr) (h*r)) -- | An array that stores the raw pixel data of an image 'Surface'. -- data SurfaceData i e = SurfaceData !Surface {-# UNPACK #-} !(Ptr e) !(i,i) {-# UNPACK #-} !Int mkSurfaceData :: Storable e => Surface -> Ptr e -> Int -> SurfaceData Int e mkSurfaceData pb (ptr :: Ptr e) size = SurfaceData pb ptr (0, count-1) count where count = fromIntegral (size `div` sizeOf (undefined :: e)) #if __GLASGOW_HASKELL__ < 605 instance HasBounds SurfaceData where bounds (SurfaceData pb ptr bd cnt) = bd #endif -- | 'SurfaceData' is a mutable array. instance Storable e => MArray SurfaceData e IO where newArray (l,u) e = error "Graphics.Rendering.Cairo.newArray: not implemented" newArray_ (l,u) = error "Graphics.Rendering.Cairo.newArray_: not implemented" {-# INLINE unsafeRead #-} unsafeRead (SurfaceData (Surface pb) pixPtr _ _) idx = do e <- peekElemOff pixPtr idx touchForeignPtr pb return e {-# INLINE unsafeWrite #-} unsafeWrite (SurfaceData (Surface pb) pixPtr _ _) idx elem = do pokeElemOff pixPtr idx elem touchForeignPtr pb #if __GLASGOW_HASKELL__ >= 605 {-# INLINE getBounds #-} getBounds (SurfaceData _ _ bd _) = return bd #endif #if __GLASGOW_HASKELL__ >= 608 {-# INLINE getNumElements #-} getNumElements (SurfaceData _ _ _ count) = return count #endif #endif #ifdef CAIRO_HAS_PDF_SURFACE -- | Creates a PostScript surface of the specified size in points to -- be written to @filename@. -- -- Note that the size of individual pages of the PostScript output can -- vary. See 'psSurfaceSetSize'. -- withPDFSurface :: FilePath -- ^ @filename@ - a filename for the PS output (must be writable) -> Double -- ^ width of the surface, in points (1 point == 1\/72.0 inch) -> Double -- ^ height of the surface, in points (1 point == 1\/72.0 inch) -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is -- only valid within in this action. -> IO a withPDFSurface filename width height f = do surface <- Internal.pdfSurfaceCreate filename width height ret <- f surface Internal.surfaceDestroy surface return ret #if CAIRO_CHECK_VERSION(1,2,0) -- | Changes the size of a PDF surface for the current (and -- subsequent) pages. -- -- This function should only be called before any drawing operations -- have been performed on the current page. The simplest way to do -- this is to call this function immediately after creating the -- surface or immediately after completing a page with either -- 'showPage' or 'copyPage'. -- pdfSurfaceSetSize :: MonadIO m => Surface -> Double -> Double -> m () pdfSurfaceSetSize s x y = liftIO $ Internal.pdfSurfaceSetSize s x y #endif #endif #ifdef CAIRO_HAS_PNG_FUNCTIONS -- | Creates a new image surface and initializes the contents to the given PNG -- file. -- withImageSurfaceFromPNG :: FilePath -> (Surface -> IO a) -> IO a withImageSurfaceFromPNG filename f = bracket (Internal.imageSurfaceCreateFromPNG filename) (\surface -> do status <- Internal.surfaceStatus surface Internal.surfaceDestroy surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface -> f surface) -- | Writes the contents of surface to a new file @filename@ as a PNG image. -- surfaceWriteToPNG :: Surface -- ^ a 'Surface' -> FilePath -- ^ @filename@ - the name of a file to write to -> IO () surfaceWriteToPNG surface filename = do status <- Internal.surfaceWriteToPNG surface filename unless (status == StatusSuccess) $ fail =<< Internal.statusToString status return () #endif #ifdef CAIRO_HAS_PS_SURFACE -- | Creates a PostScript surface of the specified size in points to -- be written to @filename@. -- -- Note that the size of individual pages of the PostScript output can -- vary. See 'psSurfaceSetSize'. -- withPSSurface :: FilePath -- ^ @filename@ - a filename for the PS output (must be writable) -> Double -- ^ width of the surface, in points (1 point == 1\/72.0 inch) -> Double -- ^ height of the surface, in points (1 point == 1\/72.0 inch) -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is -- only valid within in this action. -> IO a withPSSurface filename width height f = bracket (Internal.psSurfaceCreate filename width height) (\surface -> do status <- Internal.surfaceStatus surface Internal.surfaceDestroy surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface -> f surface) #if CAIRO_CHECK_VERSION(1,2,0) -- | Changes the size of a PostScript surface for the current (and -- subsequent) pages. -- -- This function should only be called before any drawing operations -- have been performed on the current page. The simplest way to do -- this is to call this function immediately after creating the -- surface or immediately after completing a page with either -- 'showPage' or 'copyPage'. -- psSurfaceSetSize :: MonadIO m => Surface -> Double -> Double -> m () psSurfaceSetSize s x y = liftIO $ Internal.psSurfaceSetSize s x y #endif #endif #ifdef CAIRO_HAS_SVG_SURFACE -- | Creates a SVG surface of the specified size in points -- be written to @filename@. -- withSVGSurface :: FilePath -- ^ @filename@ - a filename for the SVG output (must be writable) -> Double -- ^ width of the surface, in points (1 point == 1\/72.0 inch) -> Double -- ^ height of the surface, in points (1 point == 1\/72.0 inch) -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is -- only valid within in this action. -> IO a withSVGSurface filename width height f = bracket (Internal.svgSurfaceCreate filename width height) (\surface -> do status <- Internal.surfaceStatus surface Internal.surfaceDestroy surface unless (status == StatusSuccess) $ Internal.statusToString status >>= fail) (\surface -> f surface) #endif #if CAIRO_CHECK_VERSION(1,10,0) -- | Allocates a new empty region object. -- regionCreate :: MonadIO m => m Region regionCreate = liftIO $ Internal.regionCreate -- | Allocates a new region object containing @rectangle@. -- regionCreateRectangle :: MonadIO m => RectangleInt -- ^ @rectangle@ -> m Region regionCreateRectangle a = liftIO $ Internal.regionCreateRectangle a -- | Allocates a new region object containing the union of all given @rects@. -- regionCreateRectangles :: MonadIO m => [RectangleInt] -- ^ @rects@ -> m Region regionCreateRectangles a = liftIO $ Internal.regionCreateRectangles a -- | Allocates a new region object copying the area from @original@. -- regionCopy :: MonadIO m => Region -- ^ @original@ -> m Region regionCopy a = liftIO $ Internal.regionCopy a -- | Gets the bounding rectangle of @region@ as a RectanglInt. -- regionGetExtents :: MonadIO m => Region -- ^ @region@ -> m RectangleInt regionGetExtents a = liftIO $ Internal.regionGetExtents a -- | Returns the number of rectangles contained in @region@. -- regionNumRectangles :: MonadIO m => Region -- ^ @region@ -> m Int regionNumRectangles a = liftIO $ Internal.regionNumRectangles a -- | Gets the @nth@ rectangle from the @region@. -- regionGetRectangle :: MonadIO m => Region -- ^ @region@ -> Int -- ^ @nth@ -> m RectangleInt regionGetRectangle a n = liftIO $ Internal.regionGetRectangle a n -- | Checks whether @region@ is empty. -- regionIsEmpty :: MonadIO m => Region -- ^ @region@ -> m Bool regionIsEmpty a = liftIO $ Internal.regionIsEmpty a -- | Checks whether (@x@, @y@) is contained in @region@. -- regionContainsPoint :: MonadIO m => Region -- ^ @region@ -> Int -- ^ @x@ -> Int -- ^ @y@ -> m Bool regionContainsPoint a x y = liftIO $ Internal.regionContainsPoint a x y -- | Checks whether @rectangle@ is inside, outside or partially contained in @region@. -- regionContainsRectangle :: MonadIO m => Region -- ^ @region@ -> RectangleInt -- ^ @rectangle@ -> m RegionOverlap regionContainsRectangle a rect = liftIO $ Internal.regionContainsRectangle a rect -- | Compares whether @region_a@ is equivalent to @region_b@. -- regionEqual :: MonadIO m => Region -- ^ @region_a@ -> Region -- ^ @region_b@ -> m Bool regionEqual a b = liftIO $ Internal.regionEqual a b -- | Translates @region@ by (@dx@, @dy@). -- regionTranslate :: MonadIO m => Region -- ^ @region@ -> Int -- ^ @dx@ -> Int -- ^ @dy@ -> m () regionTranslate a dx dy = liftIO $ Internal.regionTranslate a dx dy -- | Computes the intersection of @dst@ with @other@ and places the result in @dst@. -- regionIntersect :: MonadIO m => Region -- ^ @dst@ -> Region -- ^ @other@ -> m () regionIntersect a b = liftIO $ do status <- Internal.regionIntersect a b unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Computes the intersection of @dst@ with @rectangle@ and places the result in @dst@. -- regionIntersectRectangle :: MonadIO m => Region -- ^ @dst@ -> RectangleInt -- ^ @rectangle@ -> m () regionIntersectRectangle a rect = liftIO $ do status <- Internal.regionIntersectRectangle a rect unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Subtracts @other@ from @dst@ and places the result in @dst@. -- regionSubtract :: MonadIO m => Region -- ^ @dst@ -> Region -- ^ @other@ -> m () regionSubtract a b = liftIO $ do status <- Internal.regionSubtract a b unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Subtracts @rectangle@ from @dst@ and places the result in @dst@. -- regionSubtractRectangle :: MonadIO m => Region -- ^ @dst@ -> RectangleInt -- ^ @rectangle@ -> m () regionSubtractRectangle a rect = liftIO $ do status <- Internal.regionSubtractRectangle a rect unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Computes the union of @dst@ with @other@ and places the result in @dst@. -- regionUnion :: MonadIO m => Region -- ^ @dst@ -> Region -- ^ @other@ -> m () regionUnion a b = liftIO $ do status <- Internal.regionUnion a b unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Computes the union of @dst@ with @rectangle@ and places the result in @dst@. -- regionUnionRectangle :: MonadIO m => Region -- ^ @dst@ -> RectangleInt -- ^ @rectangle@ -> m () regionUnionRectangle a rect = liftIO $ do status <- Internal.regionUnionRectangle a rect unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Computes the exclusive difference of @dst@ with @other@ and places the result in @dst@. -- That is, @dst@ will be set to contain all areas that are either in @dst@ or in @other@, but not in both. -- regionXor :: MonadIO m => Region -- ^ @dst@ -> Region -- ^ @other@ -> m () regionXor a b = liftIO $ do status <- Internal.regionXor a b unless (status == StatusSuccess) $ Internal.statusToString status >>= fail -- | Computes the exclusive difference of @dst@ with @rectangle@ and places the result in @dst@. -- That is, @dst@ will be set to contain all areas that are either in @dst@ or in @rectangle@, but not in both -- regionXorRectangle :: MonadIO m => Region -- ^ @dst@ -> RectangleInt -- ^ @rectangle@ -> m () regionXorRectangle a rect = liftIO $ do status <- Internal.regionXorRectangle a rect unless (status == StatusSuccess) $ Internal.statusToString status >>= fail #endif -- | Returns the version of the cairo library encoded in a single integer. -- version :: Int version = Internal.version -- | Returns the version of the cairo library as a human-readable string of the -- form \"X.Y.Z\". -- versionString :: String versionString = Internal.versionString cairo-0.13.1.0/Graphics/Rendering/Cairo/0000755000000000000000000000000012474505512015734 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal.hs0000644000000000000000000000552112474505512020047 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Direct bindings to the cairo library. ----------------------------------------------------------------------------- -- #hide -- module Graphics.Rendering.Cairo.Internal ( Render(..), bracketR , module Graphics.Rendering.Cairo.Types , module Graphics.Rendering.Cairo.Internal.Drawing.Cairo , module Graphics.Rendering.Cairo.Internal.Drawing.Paths , module Graphics.Rendering.Cairo.Internal.Drawing.Patterns , module Graphics.Rendering.Cairo.Internal.Drawing.Text , module Graphics.Rendering.Cairo.Internal.Drawing.Transformations , module Graphics.Rendering.Cairo.Internal.Fonts.FontOptions , module Graphics.Rendering.Cairo.Internal.Surfaces.Image , module Graphics.Rendering.Cairo.Internal.Surfaces.PDF , module Graphics.Rendering.Cairo.Internal.Surfaces.PNG , module Graphics.Rendering.Cairo.Internal.Surfaces.PS , module Graphics.Rendering.Cairo.Internal.Surfaces.SVG , module Graphics.Rendering.Cairo.Internal.Surfaces.Surface , module Graphics.Rendering.Cairo.Internal.Region , module Graphics.Rendering.Cairo.Internal.Utilities ) where import Graphics.Rendering.Cairo.Types import Graphics.Rendering.Cairo.Internal.Drawing.Cairo import Graphics.Rendering.Cairo.Internal.Drawing.Paths import Graphics.Rendering.Cairo.Internal.Drawing.Patterns import Graphics.Rendering.Cairo.Internal.Drawing.Text import Graphics.Rendering.Cairo.Internal.Drawing.Transformations import Graphics.Rendering.Cairo.Internal.Fonts.FontOptions import Graphics.Rendering.Cairo.Internal.Surfaces.Image import Graphics.Rendering.Cairo.Internal.Surfaces.PDF import Graphics.Rendering.Cairo.Internal.Surfaces.PNG import Graphics.Rendering.Cairo.Internal.Surfaces.PS import Graphics.Rendering.Cairo.Internal.Surfaces.SVG import Graphics.Rendering.Cairo.Internal.Surfaces.Surface import Graphics.Rendering.Cairo.Internal.Region import Graphics.Rendering.Cairo.Internal.Utilities import Control.Monad.Reader import Control.Applicative import Control.Exception (bracket) -- | The Render monad. All drawing operations take place in a Render context. -- You can obtain a Render context for a 'Surface' using 'renderWith'. -- newtype Render m = Render { runRender :: ReaderT Cairo IO m } deriving (Functor, Applicative, Monad, MonadIO, MonadReader Cairo) {-# INLINE bracketR #-} bracketR :: IO a -> (a -> IO b) -> (a -> Render c) -> Render c bracketR begin end action = Render $ ReaderT $ \r -> bracket begin end (\s -> runReaderT (runRender $ action s) r) cairo-0.13.1.0/Graphics/Rendering/Cairo/Matrix.chs0000644000000000000000000001025212474505512017677 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Matrix -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Matrix math ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Matrix ( Matrix(Matrix) , MatrixPtr , identity , translate , scale , rotate , transformDistance , transformPoint , scalarMultiply , adjoint , invert ) where import Foreign hiding (rotate) import Foreign.C -- | Representation of a 2-D affine transformation. -- -- The Matrix type represents a 2x2 transformation matrix along with a -- translation vector. @Matrix a1 a2 b1 b2 c1 c2@ describes the -- transformation of a point with coordinates x,y that is defined by -- -- > / x' \ = / a1 b1 \ / x \ + / c1 \ -- > \ y' / \ a2 b2 / \ y / \ c2 / -- -- or -- -- > x' = a1 * x + b1 * y + c1 -- > y' = a2 * x + b2 * y + c2 data Matrix = Matrix { xx :: !Double, yx :: !Double, xy :: !Double, yy :: !Double, x0 :: !Double, y0 :: !Double } deriving (Show, Eq) {#pointer *cairo_matrix_t as MatrixPtr -> Matrix#} instance Storable Matrix where sizeOf _ = {#sizeof cairo_matrix_t#} alignment _ = alignment (undefined :: CDouble) peek p = do xx <- {#get cairo_matrix_t->xx#} p yx <- {#get cairo_matrix_t->yx#} p xy <- {#get cairo_matrix_t->xy#} p yy <- {#get cairo_matrix_t->yy#} p x0 <- {#get cairo_matrix_t->x0#} p y0 <- {#get cairo_matrix_t->y0#} p return $ Matrix (realToFrac xx) (realToFrac yx) (realToFrac xy) (realToFrac yy) (realToFrac x0) (realToFrac y0) poke p (Matrix xx yx xy yy x0 y0) = do {#set cairo_matrix_t->xx#} p (realToFrac xx) {#set cairo_matrix_t->yx#} p (realToFrac yx) {#set cairo_matrix_t->xy#} p (realToFrac xy) {#set cairo_matrix_t->yy#} p (realToFrac yy) {#set cairo_matrix_t->x0#} p (realToFrac x0) {#set cairo_matrix_t->y0#} p (realToFrac y0) return () instance Num Matrix where (*) (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') = Matrix (xx * xx' + yx * xy') (xx * yx' + yx * yy') (xy * xx' + yy * xy') (xy * yx' + yy * yy') (x0 * xx' + y0 * xy' + x0') (x0 * yx' + y0 * yy' + y0') (+) = pointwise2 (+) (-) = pointwise2 (-) negate = pointwise negate abs = pointwise abs signum = pointwise signum -- this definition of fromInteger means that 2*m = scale 2 m -- and it means 1 = identity fromInteger n = Matrix (fromInteger n) 0 0 (fromInteger n) 0 0 {-# INLINE pointwise #-} pointwise f (Matrix xx yx xy yy x0 y0) = Matrix (f xx) (f yx) (f xy) (f yy) (f x0) (f y0) {-# INLINE pointwise2 #-} pointwise2 f (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') = Matrix (f xx xx') (f yx yx') (f xy xy') (f yy yy') (f x0 x0') (f y0 y0') identity :: Matrix identity = Matrix 1 0 0 1 0 0 translate :: Double -> Double -> Matrix -> Matrix translate tx ty m = m * (Matrix 1 0 0 1 tx ty) scale :: Double -> Double -> Matrix -> Matrix scale sx sy m = m * (Matrix sx 0 0 sy 0 0) rotate :: Double -> Matrix -> Matrix rotate r m = m * (Matrix c s (-s) c 0 0) where s = sin r c = cos r transformDistance :: Matrix -> (Double,Double) -> (Double,Double) transformDistance (Matrix xx yx xy yy _ _) (dx,dy) = newX `seq` newY `seq` (newX,newY) where newX = xx * dx + xy * dy newY = yx * dx + yy * dy transformPoint :: Matrix -> (Double,Double) -> (Double,Double) transformPoint (Matrix xx yx xy yy x0 y0) (dx,dy) = newX `seq` newY `seq` (newX,newY) where newX = xx * dx + xy * dy + x0 newY = yx * dx + yy * dy + y0 scalarMultiply :: Double -> Matrix -> Matrix scalarMultiply scalar = pointwise (*scalar) adjoint :: Matrix -> Matrix adjoint (Matrix a b c d tx ty) = Matrix d (-b) (-c) a (c*ty - d*tx) (b*tx - a*ty) invert :: Matrix -> Matrix invert m@(Matrix xx yx xy yy _ _) = scalarMultiply (recip det) $ adjoint m where det = xx*yy - yx*xy cairo-0.13.1.0/Graphics/Rendering/Cairo/Types.chs0000644000000000000000000003570112474505512017545 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Types -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Haskell bindings to the cairo types. ----------------------------------------------------------------------------- -- #hide module Graphics.Rendering.Cairo.Types ( PixelData , Matrix(Matrix), MatrixPtr , Cairo(Cairo), unCairo , Surface(Surface), withSurface, mkSurface, manageSurface , Pattern(Pattern), unPattern , Status(..) , Operator(..) , Antialias(..) , FillRule(..) , LineCap(..) , LineJoin(..) , ScaledFont(..), unScaledFont , FontFace(..), unFontFace , Glyph, unGlyph , TextExtentsPtr , TextExtents(..) , FontExtentsPtr , FontExtents(..) , FontSlant(..) , FontWeight(..) , SubpixelOrder(..) , HintStyle(..) , HintMetrics(..) , FontOptions(..), withFontOptions, mkFontOptions , Path(..), unPath #if CAIRO_CHECK_VERSION(1,10,0) , RectangleInt(..) , RegionOverlap(..) , Region(..), withRegion, mkRegion #endif , Content(..) , Format(..) , Extend(..) , Filter(..) , cIntConv , cFloatConv , cFromBool , cToBool , cToEnum , cFromEnum , peekFloatConv , withFloatConv ) where {#import Graphics.Rendering.Cairo.Matrix#} import Foreign hiding (rotate) import Foreign.C import Control.Monad (liftM) {#context lib="cairo" prefix="cairo"#} type PixelData = Ptr CUChar -- not visible {#pointer *cairo_t as Cairo newtype#} unCairo (Cairo x) = x -- | The medium to draw on. {#pointer *surface_t as Surface foreign newtype#} withSurface (Surface x) = withForeignPtr x mkSurface :: Ptr Surface -> IO Surface mkSurface surfacePtr = do surfaceForeignPtr <- newForeignPtr_ surfacePtr return (Surface surfaceForeignPtr) manageSurface :: Surface -> IO () manageSurface (Surface surfaceForeignPtr) = do addForeignPtrFinalizer surfaceDestroy surfaceForeignPtr foreign import ccall unsafe "&cairo_surface_destroy" surfaceDestroy :: FinalizerPtr Surface -- | Patterns can be simple solid colors, various kinds of gradients or -- bitmaps. The current pattern for a 'Render' context is used by the 'stroke', -- 'fill' and paint operations. These operations composite the current pattern -- with the target surface using the currently selected 'Operator'. -- {#pointer *pattern_t as Pattern newtype#} unPattern (Pattern x) = x -- | Cairo status. -- -- * 'Status' is used to indicate errors that can occur when using -- Cairo. In some cases it is returned directly by functions. When using -- 'Graphics.Rendering.Cairo.Render', the last error, if any, is stored -- in the monad and can be retrieved with 'Graphics.Rendering.Cairo.status'. -- {#enum status_t as Status {underscoreToCase} deriving(Eq,Show)#} -- | Composition operator for all drawing operations. -- {#enum operator_t as Operator {underscoreToCase} deriving(Eq,Show)#} -- | Specifies the type of antialiasing to do when rendering text or shapes -- -- ['AntialiasDefault'] Use the default antialiasing for the subsystem -- and target device. -- -- ['AntialiasNone'] Use a bilevel alpha mask. -- -- ['AntialiasGray'] Perform single-color antialiasing (using shades of -- gray for black text on a white background, for example). -- -- ['AntialiasSubpixel'] Perform antialiasing by taking advantage of -- the order of subpixel elements on devices such as LCD panels. -- {#enum antialias_t as Antialias {underscoreToCase} deriving(Eq,Show)#} -- | Specify how paths are filled. -- -- * For both fill rules, whether or not a point is included in the fill is -- determined by taking a ray from that point to infinity and looking at -- intersections with the path. The ray can be in any direction, as long -- as it doesn't pass through the end point of a segment or have a tricky -- intersection such as intersecting tangent to the path. (Note that -- filling is not actually implemented in this way. This is just a -- description of the rule that is applied.) -- -- ['FillRuleWinding'] If the path crosses the ray from left-to-right, -- counts +1. If the path crosses the ray from right to left, counts -1. -- (Left and right are determined from the perspective of looking along -- the ray from the starting point.) If the total count is non-zero, the -- point will be filled. -- -- ['FillRuleEvenOdd'] Counts the total number of intersections, -- without regard to the orientation of the contour. If the total number -- of intersections is odd, the point will be filled. -- {#enum fill_rule_t as FillRule {underscoreToCase} deriving(Eq,Show)#} -- | Specify line endings. -- -- ['LineCapButt'] Start(stop) the line exactly at the start(end) point. -- -- ['LineCapRound'] Use a round ending, the center of the circle is the -- end point. -- -- ['LineCapSquare'] Use squared ending, the center of the square is the -- end point -- {#enum line_cap_t as LineCap {underscoreToCase} deriving(Eq,Show)#} -- | Specify how lines join. -- {#enum line_join_t as LineJoin {underscoreToCase} deriving(Eq,Show)#} {#pointer *scaled_font_t as ScaledFont newtype#} unScaledFont (ScaledFont x) = x {#pointer *font_face_t as FontFace newtype#} unFontFace (FontFace x) = x {#pointer *glyph_t as Glyph newtype#} unGlyph (Glyph x) = x {#pointer *text_extents_t as TextExtentsPtr -> TextExtents#} -- | Specify the extents of a text. data TextExtents = TextExtents { textExtentsXbearing :: Double , textExtentsYbearing :: Double , textExtentsWidth :: Double , textExtentsHeight :: Double , textExtentsXadvance :: Double , textExtentsYadvance :: Double } instance Storable TextExtents where sizeOf _ = {#sizeof text_extents_t#} alignment _ = alignment (undefined :: CDouble) peek p = do x_bearing <- {#get text_extents_t->x_bearing#} p y_bearing <- {#get text_extents_t->y_bearing#} p width <- {#get text_extents_t->width#} p height <- {#get text_extents_t->height#} p x_advance <- {#get text_extents_t->x_advance#} p y_advance <- {#get text_extents_t->y_advance#} p return $ TextExtents (cFloatConv x_bearing) (cFloatConv y_bearing) (cFloatConv width) (cFloatConv height) (cFloatConv x_advance) (cFloatConv y_advance) poke p (TextExtents x_bearing y_bearing width height x_advance y_advance) = do {#set text_extents_t->x_bearing#} p (cFloatConv x_bearing) {#set text_extents_t->y_bearing#} p (cFloatConv y_bearing) {#set text_extents_t->width#} p (cFloatConv width) {#set text_extents_t->height#} p (cFloatConv height) {#set text_extents_t->x_advance#} p (cFloatConv x_advance) {#set text_extents_t->y_advance#} p (cFloatConv y_advance) return () {#pointer *font_extents_t as FontExtentsPtr -> FontExtents#} -- | Result of querying the font extents. data FontExtents = FontExtents { fontExtentsAscent :: Double , fontExtentsDescent :: Double , fontExtentsHeight :: Double , fontExtentsMaxXadvance :: Double , fontExtentsMaxYadvance :: Double } instance Storable FontExtents where sizeOf _ = {#sizeof font_extents_t#} alignment _ = alignment (undefined :: CDouble) peek p = do ascent <- {#get font_extents_t->ascent#} p descent <- {#get font_extents_t->descent#} p height <- {#get font_extents_t->height#} p max_x_advance <- {#get font_extents_t->max_x_advance#} p max_y_advance <- {#get font_extents_t->max_y_advance#} p return $ FontExtents (cFloatConv ascent) (cFloatConv descent) (cFloatConv height) (cFloatConv max_x_advance) (cFloatConv max_y_advance) poke p (FontExtents ascent descent height max_x_advance max_y_advance) = do {#set font_extents_t->ascent#} p (cFloatConv ascent) {#set font_extents_t->descent#} p (cFloatConv descent) {#set font_extents_t->height#} p (cFloatConv height) {#set font_extents_t->max_x_advance#} p (cFloatConv max_x_advance) {#set font_extents_t->max_y_advance#} p (cFloatConv max_y_advance) return () -- | Specify font slant. {#enum font_slant_t as FontSlant {underscoreToCase} deriving(Eq,Show)#} -- | Specify font weight. {#enum font_weight_t as FontWeight {underscoreToCase} deriving(Eq,Show)#} -- | The subpixel order specifies the order of color elements within each pixel -- on the display device when rendering with an antialiasing mode of -- 'AntialiasSubpixel'. -- -- ['SubpixelOrderDefault'] Use the default subpixel order for for the -- target device -- -- ['SubpixelOrderRgb'] Subpixel elements are arranged horizontally -- with red at the left -- -- ['SubpixelOrderBgr'] Subpixel elements are arranged horizontally -- with blue at the left -- -- ['SubpixelOrderVrgb'] Subpixel elements are arranged vertically -- with red at the top -- -- ['SubpixelOrderVbgr'] Subpixel elements are arranged vertically -- with blue at the top -- {#enum subpixel_order_t as SubpixelOrder {underscoreToCase} deriving(Eq,Show)#} -- | Specifies the type of hinting to do on font outlines. -- -- Hinting is the process of fitting outlines to the pixel grid in order to -- improve the appearance of the result. Since hinting outlines involves -- distorting them, it also reduces the faithfulness to the original outline -- shapes. Not all of the outline hinting styles are supported by all font -- backends. -- -- ['HintStyleDefault'] Use the default hint style for for font backend and -- target device -- -- ['HintStyleNone'] Do not hint outlines -- -- ['HintStyleSlight'] Hint outlines slightly to improve contrast while -- retaining good fidelity to the original shapes. -- -- ['HintStyleMedium'] Hint outlines with medium strength giving a compromise -- between fidelity to the original shapes and contrast -- -- ['HintStyleFull'] Hint outlines to maximize contrast -- {#enum hint_style_t as HintStyle {underscoreToCase}#} -- | Specifies whether to hint font metrics. -- -- Hinting font metrics means quantizing them so that they are integer values -- in device space. Doing this improves the consistency of letter and line -- spacing, however it also means that text will be laid out differently at -- different zoom factors. -- -- ['HintMetricsDefault'] Hint metrics in the default manner for the font -- backend and target device -- -- ['HintMetricsOff'] Do not hint font metrics -- -- ['HintMetricsOn'] Hint font metrics -- -- {#enum hint_metrics_t as HintMetrics {underscoreToCase} deriving(Eq,Show)#} -- | Specifies how to render text. {#pointer *font_options_t as FontOptions foreign newtype#} withFontOptions (FontOptions fptr) = withForeignPtr fptr mkFontOptions :: Ptr FontOptions -> IO FontOptions mkFontOptions fontOptionsPtr = do fontOptionsForeignPtr <- newForeignPtr fontOptionsDestroy fontOptionsPtr return (FontOptions fontOptionsForeignPtr) foreign import ccall unsafe "&cairo_font_options_destroy" fontOptionsDestroy :: FinalizerPtr FontOptions -- XXX: pathToList :: Path -> [PathData] -- -- http://cairographics.org/manual/bindings-path.html -- -- {#enum path_data_type_t as PathDataType {underscoreToCase}#} -- -- type Point = (Double, Double) -- data PathData = PathMoveTo Point -- | PathLineTo Point -- | PathCurveTo Point Point Point -- | PathClose -- | A Cairo path. -- -- * A path is a sequence of drawing operations that are accumulated until -- 'Graphics.Rendering.Cairo.stroke' is called. Using a path is particularly -- useful when drawing lines with special join styles and -- 'Graphics.Rendering.Cairo.closePath'. -- {#pointer *path_t as Path newtype#} unPath (Path x) = x #if CAIRO_CHECK_VERSION(1,10,0) {#pointer *rectangle_int_t as RectangleIntPtr -> RectangleInt#} -- | A data structure for holding a rectangle with integer coordinates. data RectangleInt = RectangleInt { x :: Int , y :: Int , width :: Int , height :: Int } instance Storable RectangleInt where sizeOf _ = {#sizeof rectangle_int_t#} alignment _ = alignment (undefined :: CInt) peek p = do x <- {#get rectangle_int_t->x#} p y <- {#get rectangle_int_t->y#} p width <- {#get rectangle_int_t->width#} p height <- {#get rectangle_int_t->height#} p return $ RectangleInt (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height) poke p (RectangleInt {..}) = do {#set rectangle_int_t->x#} p (fromIntegral x) {#set rectangle_int_t->y#} p (fromIntegral y) {#set rectangle_int_t->width#} p (fromIntegral width) {#set rectangle_int_t->height#} p (fromIntegral height) return () -- | Used as the return value for regionContainsRectangle. {#enum cairo_region_overlap_t as RegionOverlap {underscoreToCase} deriving(Eq,Show)#} -- | A Cairo region. Represents a set of integer-aligned rectangles. -- -- It allows set-theoretical operations like regionUnion and regionIntersect to be performed on them. {#pointer *region_t as Region foreign newtype#} withRegion (Region fptr) = withForeignPtr fptr mkRegion :: Ptr Region -> IO Region mkRegion regionPtr = do regionForeignPtr <- newForeignPtr regionDestroy regionPtr return (Region regionForeignPtr) foreign import ccall unsafe "&cairo_region_destroy" regionDestroy :: FinalizerPtr Region #endif {#enum content_t as Content {underscoreToCase} deriving(Eq,Show)#} data Format = FormatARGB32 | FormatRGB24 | FormatA8 | FormatA1 deriving (Enum,Show,Eq) -- | FIXME: We should find out about this. {#enum extend_t as Extend {underscoreToCase} deriving(Eq,Show)#} -- | Specify how filtering is done. {#enum filter_t as Filter {underscoreToCase} deriving(Eq,Show)#} -- Marshalling functions {-# INLINE cIntConv #-} cIntConv :: (Integral a, Integral b) => a -> b cIntConv = fromIntegral {-# INLINE cFloatConv #-} cFloatConv :: (RealFloat a, RealFloat b) => a -> b cFloatConv = realToFrac {-# INLINE cFromBool #-} cFromBool :: Num a => Bool -> a cFromBool = fromBool {-# INLINE cToBool #-} cToBool :: (Eq a, Num a) => a -> Bool cToBool = toBool {-# INLINE cToEnum #-} cToEnum :: (Integral i, Enum e) => i -> e cToEnum = toEnum . cIntConv {-# INLINE cFromEnum #-} cFromEnum :: (Enum e, Integral i) => e -> i cFromEnum = cIntConv . fromEnum {-# INLINE peekFloatConv #-} peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b peekFloatConv = liftM cFloatConv . peek {-# INLINE withFloatConv #-} withFloatConv :: (Storable b, RealFloat a, RealFloat b) => a -> (Ptr b -> IO c) -> IO c withFloatConv = with . cFloatConv {-# INLINE withArrayFloatConv #-} withArrayFloatConv :: (Storable b, RealFloat a, RealFloat b) => [a] -> (Ptr b -> IO b1) -> IO b1 withArrayFloatConv = withArray . map (cFloatConv) cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/0000755000000000000000000000000012474505512017510 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Region.chs0000644000000000000000000000663412474505512021443 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Region -- Copyright : (c) Hamish Mackenzie 2013 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : -- Stability : experimental -- Portability : portable -- -- Region functions. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Region where #if CAIRO_CHECK_VERSION(1,10,0) {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} regionCreateRectangles rects = withArrayLen rects $ \ n ptr -> {#call region_create_rectangles#} ptr (fromIntegral n) >>= mkRegion {#fun region_create as regionCreate {} -> `Region' mkRegion*#} {#fun region_create_rectangle as regionCreateRectangle { `RectangleInt' } -> `Region' mkRegion*#} {#fun region_copy as regionCopy { withRegion* `Region' } -> `Region' mkRegion*#} {#fun region_destroy as regionDestroy { withRegion* `Region' } -> `()'#} {#fun region_reference as regionReference { withRegion* `Region' } -> `()'#} {#fun region_status as regionStatus { withRegion* `Region' } -> `Status' cToEnum#} {#fun region_get_extents as regionGetExtents { withRegion* `Region', alloca- `RectangleInt' peek* } -> `()'#} {#fun region_num_rectangles as regionNumRectangles { withRegion* `Region' } -> `Int' fromIntegral#} {#fun region_get_rectangle as regionGetRectangle { withRegion* `Region', fromIntegral `Int', alloca- `RectangleInt' peek* } -> `()'#} {#fun region_is_empty as regionIsEmpty { withRegion* `Region' } -> `Bool' cToBool#} {#fun region_contains_point as regionContainsPoint { withRegion* `Region', fromIntegral `Int', fromIntegral `Int' } -> `Bool' cToBool#} {#fun region_contains_rectangle as regionContainsRectangle { withRegion* `Region', `RectangleInt' } -> `RegionOverlap' cToEnum#} {#fun region_equal as regionEqual { withRegion* `Region', withRegion* `Region' } -> `Bool' cToBool#} {#fun region_translate as regionTranslate { withRegion* `Region', fromIntegral `Int', fromIntegral `Int' } -> `()'#} {#fun region_intersect as regionIntersect { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#} {#fun region_intersect_rectangle as regionIntersectRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#} {#fun region_subtract as regionSubtract { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#} {#fun region_subtract_rectangle as regionSubtractRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#} {#fun region_union as regionUnion { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#} {#fun region_union_rectangle as regionUnionRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#} {#fun region_xor as regionXor { withRegion* `Region', withRegion* `Region' } -> `Status' cToEnum#} {#fun region_xor_rectangle as regionXorRectangle { withRegion* `Region', `RectangleInt' } -> `Status' cToEnum#} #endif cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Utilities.chs0000644000000000000000000000255012474505512022164 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Utilities -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- http://cairographics.org/manual/Support.html ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Utilities where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C #if __GLASGOW_HASKELL__ >= 707 import System.IO.Unsafe (unsafePerformIO) #endif import Codec.Binary.UTF8.String import Data.Char (ord, chr) import Data.Text (Text) import Data.ByteString (useAsCString) import qualified Data.Text.Encoding as T (encodeUtf8) {#context lib="cairo" prefix="cairo"#} {#fun status_to_string as statusToString { cFromEnum `Status' } -> `String'#} {#fun pure version as version {} -> `Int'#} {#fun pure version_string as versionString {} -> `String'#} class CairoString s where withUTFString :: s -> (CString -> IO a) -> IO a instance CairoString [Char] where withUTFString = withCAString . encodeString instance CairoString Text where withUTFString s = useAsCString (T.encodeUtf8 s) cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/0000755000000000000000000000000012474505512021103 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/Cairo.chs0000644000000000000000000001262712474505512022647 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Drawing.Cairo -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- The cairo drawing context functions. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Drawing.Cairo where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun create { withSurface* `Surface' } -> `Cairo' Cairo #} {#fun reference { unCairo `Cairo' } -> `()' #} {#fun destroy { unCairo `Cairo' } -> `()' #} {#fun save { unCairo `Cairo' } -> `()' #} {#fun restore { unCairo `Cairo' } -> `()' #} {#fun status as status { unCairo `Cairo' } -> `Status' cToEnum#} {#fun get_target as getTarget { unCairo `Cairo' } -> `Surface' mkSurface*#} {#fun push_group as ^ { unCairo `Cairo' } -> `()' #} {#fun push_group_with_content as ^ { unCairo `Cairo', cFromEnum `Content' } -> `()' #} {#fun pop_group as ^ { unCairo `Cairo' } -> `Pattern' Pattern #} {#fun pop_group_to_source as ^ { unCairo `Cairo' } -> `()' #} {#fun set_source_rgb as setSourceRGB { unCairo `Cairo', `Double', `Double', `Double' } -> `()'#} {#fun set_source_rgba as setSourceRGBA { unCairo `Cairo', `Double', `Double', `Double', `Double' } -> `()'#} {#fun set_source as setSource { unCairo `Cairo', unPattern `Pattern' } -> `()'#} {#fun set_source_surface as setSourceSurface { unCairo `Cairo', withSurface* `Surface', `Double', `Double' } -> `()'#} {#fun get_source as getSource { unCairo `Cairo' } -> `Pattern' Pattern#} {#fun set_antialias as setAntialias { unCairo `Cairo', cFromEnum `Antialias' } -> `()'#} {#fun get_antialias as getAntialias { unCairo `Cairo' } -> `Antialias' cToEnum#} setDash context xs offset = withArrayLen (map (cFloatConv) xs) $ \len ptr -> {#call set_dash#} context ptr (cIntConv len) (cFloatConv offset) {#fun set_fill_rule as setFillRule { unCairo `Cairo', cFromEnum `FillRule' } -> `()'#} {#fun get_fill_rule as getFillRule { unCairo `Cairo' } -> `FillRule' cToEnum#} {#fun set_line_cap as setLineCap { unCairo `Cairo', cFromEnum `LineCap' } -> `()'#} {#fun get_line_cap as getLineCap { unCairo `Cairo' } -> `LineCap' cToEnum#} {#fun set_line_join as setLineJoin { unCairo `Cairo', cFromEnum `LineJoin' } -> `()'#} {#fun get_line_join as getLineJoin { unCairo `Cairo' } -> `LineJoin' cToEnum#} {#fun set_line_width as setLineWidth { unCairo `Cairo', `Double' } -> `()'#} {#fun get_line_width as getLineWidth { unCairo `Cairo' } -> `Double'#} {#fun set_miter_limit as setMiterLimit { unCairo `Cairo', `Double' } -> `()'#} {#fun get_miter_limit as getMiterLimit { unCairo `Cairo' } -> `Double'#} {#fun set_operator as setOperator { unCairo `Cairo', cFromEnum `Operator' } -> `()'#} {#fun get_operator as getOperator { unCairo `Cairo' } -> `Operator' cToEnum#} {#fun set_tolerance as setTolerance { unCairo `Cairo', `Double' } -> `()'#} {#fun get_tolerance as getTolerance { unCairo `Cairo' } -> `Double'#} {#fun clip as clip { unCairo `Cairo' } -> `()'#} {#fun clip_preserve as clipPreserve { unCairo `Cairo' } -> `()'#} {#fun reset_clip as resetClip { unCairo `Cairo' } -> `()'#} {#fun clip_extents as clipExtents { unCairo `Cairo', alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv* } -> `()'#} {#fun fill as fill { unCairo `Cairo' } -> `()'#} {#fun fill_preserve as fillPreserve { unCairo `Cairo' } -> `()'#} {#fun fill_extents as fillExtents { unCairo `Cairo', alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv* } -> `()'#} {#fun in_fill as inFill { unCairo `Cairo', `Double', `Double' } -> `Bool' cToBool#} {#fun mask as mask { unCairo `Cairo', unPattern `Pattern' } -> `()'#} {#fun mask_surface as maskSurface { unCairo `Cairo', withSurface* `Surface', `Double', `Double' } -> `()'#} {#fun paint as paint { unCairo `Cairo' } -> `()'#} {#fun paint_with_alpha as paintWithAlpha { unCairo `Cairo', `Double' } -> `()'#} {#fun stroke as stroke { unCairo `Cairo' } -> `()'#} {#fun stroke_preserve as strokePreserve { unCairo `Cairo' } -> `()'#} {#fun stroke_extents as strokeExtents { unCairo `Cairo', alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv* } -> `()'#} {#fun in_stroke as inStroke { unCairo `Cairo', `Double', `Double' } -> `Bool' cToBool#} {#fun copy_page as copyPage { unCairo `Cairo' } -> `()'#} {#fun show_page as showPage { unCairo `Cairo' } -> `()'#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs0000644000000000000000000000420512474505512022662 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Drawing.Paths -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Creating paths and manipulating path data. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Drawing.Paths where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C import Data.Text import Graphics.Rendering.Cairo.Internal.Utilities (CairoString(..)) {#context lib="cairo" prefix="cairo"#} {#fun get_current_point as getCurrentPoint { unCairo `Cairo', alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv* } -> `()'#} {#fun new_path as newPath { unCairo `Cairo' } -> `()'#} {#fun close_path as closePath { unCairo `Cairo' } -> `()'#} {#fun arc as arc { unCairo `Cairo', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun arc_negative as arcNegative { unCairo `Cairo', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun curve_to as curveTo { unCairo `Cairo', `Double', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun line_to as lineTo { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun move_to as moveTo { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun rectangle as rectangle { unCairo `Cairo', `Double', `Double', `Double', `Double' } -> `()'#} textPath :: CairoString string => Cairo -> string -> IO () textPath c string = withUTFString string $ \string' -> {# call text_path #} c string' {#fun rel_curve_to as relCurveTo { unCairo `Cairo', `Double', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun rel_line_to as relLineTo { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun rel_move_to as relMoveTo { unCairo `Cairo', `Double', `Double' } -> `()'#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/Patterns.chs0000644000000000000000000000452412474505512023407 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Drawing.Patterns -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Gradients and filtered sources. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Drawing.Patterns where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun pattern_add_color_stop_rgb as patternAddColorStopRGB { unPattern `Pattern', `Double', `Double', `Double', `Double' } -> `()'#} {#fun pattern_add_color_stop_rgba as patternAddColorStopRGBA { unPattern `Pattern', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun pattern_create_rgb as patternCreateRGB { `Double', `Double', `Double' } -> `Pattern' Pattern#} {#fun pattern_create_rgba as patternCreateRGBA { `Double', `Double', `Double', `Double' } -> `Pattern' Pattern#} {#fun pattern_create_for_surface as patternCreateForSurface { withSurface* `Surface' } -> `Pattern' Pattern#} {#fun pattern_create_linear as patternCreateLinear { `Double', `Double', `Double', `Double' } -> `Pattern' Pattern#} {#fun pattern_create_radial as patternCreateRadial { `Double', `Double', `Double', `Double', `Double', `Double' } -> `Pattern' Pattern#} {#fun pattern_destroy as patternDestroy { unPattern `Pattern' } -> `()'#} {#fun pattern_reference as patternReference { unPattern `Pattern' } -> `Pattern' Pattern#} {#fun pattern_status as patternStatus { unPattern `Pattern' } -> `Status' cToEnum#} {#fun pattern_set_extend as patternSetExtend { unPattern `Pattern', cFromEnum `Extend' } -> `()'#} {#fun pattern_get_extend as patternGetExtend { unPattern `Pattern' } -> `Extend' cToEnum#} {#fun pattern_set_filter as patternSetFilter { unPattern `Pattern', cFromEnum `Filter' } -> `()'#} {#fun pattern_get_filter as patternGetFilter { unPattern `Pattern' } -> `Filter' cToEnum#} {#fun pattern_set_matrix as patternSetMatrix { unPattern `Pattern', `Matrix' } -> `()'#} {#fun pattern_get_matrix as patternGetMatrix { unPattern `Pattern', alloca- `Matrix' peek*} -> `()'#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/Text.chs0000644000000000000000000000343012474505512022526 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Drawing.Text -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Rendering text. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Drawing.Text where {#import Graphics.Rendering.Cairo.Types#} import Graphics.Rendering.Cairo.Internal.Utilities (CairoString(..)) import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} selectFontFace :: CairoString string => Cairo -> string -> FontSlant -> FontWeight -> IO () selectFontFace c string slant weight = withUTFString string $ \string' -> {# call select_font_face #} c string' (cFromEnum slant) (cFromEnum weight) {#fun set_font_size as setFontSize { unCairo `Cairo', `Double' } -> `()'#} {#fun set_font_matrix as setFontMatrix { unCairo `Cairo', `Matrix' } -> `()'#} {#fun get_font_matrix as getFontMatrix { unCairo `Cairo', alloca- `Matrix' peek*} -> `()'#} {#fun set_font_options as setFontOptions { unCairo `Cairo', withFontOptions* `FontOptions' } -> `()'#} showText :: CairoString string => Cairo -> string -> IO () showText c string = withUTFString string $ \string' -> {# call show_text #} c string' {#fun font_extents as fontExtents { unCairo `Cairo', alloca- `FontExtents' peek* } -> `()'#} textExtents :: CairoString string => Cairo -> string -> IO TextExtents textExtents c string = withUTFString string $ \string' -> alloca $ \result -> do {# call text_extents #} c string' result peek result cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Drawing/Transformations.chs0000644000000000000000000000363312474505512025000 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Drawing.Tranformations -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Manipulating the current transformation matrix. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Drawing.Transformations where {#import Graphics.Rendering.Cairo.Types#} import Foreign hiding (rotate) import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun translate as translate { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun scale as scale { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun rotate as rotate { unCairo `Cairo', `Double' } -> `()'#} {#fun transform as transform { unCairo `Cairo', `Matrix' } -> `()'#} {#fun set_matrix as setMatrix { unCairo `Cairo', `Matrix' } -> `()'#} {#fun get_matrix as getMatrix { unCairo `Cairo', alloca- `Matrix' peek*} -> `()'#} {#fun identity_matrix as identityMatrix { unCairo `Cairo' } -> `()'#} {#fun user_to_device as userToDevice { unCairo `Cairo', withFloatConv* `Double' peekFloatConv*, withFloatConv* `Double' peekFloatConv* } -> `()'#} {#fun user_to_device_distance as userToDeviceDistance { unCairo `Cairo', withFloatConv* `Double' peekFloatConv*, withFloatConv* `Double' peekFloatConv* } -> `()'#} {#fun device_to_user as deviceToUser { unCairo `Cairo', withFloatConv* `Double' peekFloatConv*, withFloatConv* `Double' peekFloatConv* } -> `()'#} {#fun device_to_user_distance as deviceToUserDistance { unCairo `Cairo', withFloatConv* `Double' peekFloatConv*, withFloatConv* `Double' peekFloatConv* } -> `()'#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Fonts/0000755000000000000000000000000012474505512020601 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Fonts/FontOptions.chs0000644000000000000000000000465312474505512023572 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Fonts.FontOptions -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- How a font should be rendered. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Fonts.FontOptions where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun font_options_create as fontOptionsCreate { } -> `FontOptions' mkFontOptions*#} {#fun font_options_copy as fontOptionsCopy { withFontOptions* `FontOptions' } -> `FontOptions' mkFontOptions*#} {#fun font_options_destroy as fontOptionsDestroy { withFontOptions* `FontOptions' } -> `()'#} {#fun font_options_status as fontOptionsStatus { withFontOptions* `FontOptions' } -> `Status' cToEnum#} {#fun font_options_merge as fontOptionsMerge { withFontOptions* `FontOptions', withFontOptions* `FontOptions' } -> `()'#} {#fun font_options_hash as fontOptionsHash { withFontOptions* `FontOptions' } -> `Int'#} {#fun font_options_equal as fontOptionsEqual { withFontOptions* `FontOptions', withFontOptions* `FontOptions' } -> `Bool'#} {#fun font_options_set_antialias as fontOptionsSetAntialias { withFontOptions* `FontOptions', cFromEnum `Antialias' } -> `()'#} {#fun font_options_get_antialias as fontOptionsGetAntialias { withFontOptions* `FontOptions' } -> `Antialias' cToEnum#} {#fun font_options_set_subpixel_order as fontOptionsSetSubpixelOrder { withFontOptions* `FontOptions', cFromEnum `SubpixelOrder' } -> `()'#} {#fun font_options_get_subpixel_order as fontOptionsGetSubpixelOrder { withFontOptions* `FontOptions' } -> `SubpixelOrder' cToEnum#} {#fun font_options_set_hint_style as fontOptionsSetHintStyle { withFontOptions* `FontOptions', cFromEnum `HintStyle' } -> `()'#} {#fun font_options_get_hint_style as fontOptionsGetHintStyle { withFontOptions* `FontOptions' } -> `HintStyle' cToEnum#} {#fun font_options_set_hint_metrics as fontOptionsSetHintMetrics { withFontOptions* `FontOptions', cFromEnum `HintMetrics' } -> `()'#} {#fun font_options_get_hint_metrics as fontOptionsGetHintMetrics { withFontOptions* `FontOptions' } -> `HintMetrics' cToEnum#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/0000755000000000000000000000000012474505512021263 5ustar0000000000000000cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/Image.chs0000644000000000000000000000311712474505512023006 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.Image -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Rendering to memory buffers. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.Image where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun image_surface_create_for_data as imageSurfaceCreateForData { id `Ptr CUChar' , cFromEnum `Format' , `Int' , `Int' , `Int' } -> `Surface' mkSurface*#} {#fun image_surface_create as imageSurfaceCreate { cFromEnum `Format', `Int', `Int' } -> `Surface' mkSurface*#} {#fun image_surface_get_width as imageSurfaceGetWidth { withSurface* `Surface' } -> `Int'#} {#fun image_surface_get_height as imageSurfaceGetHeight { withSurface* `Surface' } -> `Int'#} #if CAIRO_CHECK_VERSION(1,2,0) {#fun image_surface_get_stride as imageSurfaceGetStride { withSurface* `Surface' } -> `Int'#} {#fun image_surface_get_format as imageSurfaceGetFormat { withSurface* `Surface' } -> `Format' cToEnum#} {#fun image_surface_get_data as imageSurfaceGetData { withSurface* `Surface' } -> `(Ptr CUChar)' id#} #if CAIRO_CHECK_VERSION(1,6,0) {#fun pure format_stride_for_width as formatStrideForWidth { cFromEnum `Format', `Int' } -> `Int'#} #endif #endif cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs0000644000000000000000000000167112474505512022400 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.PDF -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Rendering PDF documents. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.PDF where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} #ifdef CAIRO_HAS_PDF_SURFACE {#fun pdf_surface_create as pdfSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#} #if CAIRO_CHECK_VERSION(1,2,0) {#fun pdf_surface_set_size as pdfSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#} #endif #endif cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs0000644000000000000000000000200612474505512022404 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.PNG -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see cairo/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Reading and writing PNG images. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.PNG where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} #ifdef CAIRO_HAS_PNG_FUNCTIONS imageSurfaceCreateFromPNG :: FilePath -> IO Surface imageSurfaceCreateFromPNG filename = withCAString filename $ \filenamePtr -> {#call unsafe image_surface_create_from_png#} filenamePtr >>= mkSurface {#fun surface_write_to_png as surfaceWriteToPNG { withSurface* `Surface', withCAString* `FilePath' } -> `Status' cToEnum#} #endif cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs0000644000000000000000000000166712474505512022316 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.PS -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Rendering PS documents. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.PS where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} #ifdef CAIRO_HAS_PS_SURFACE {#fun ps_surface_create as psSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#} #if CAIRO_CHECK_VERSION(1,2,0) {#fun cairo_ps_surface_set_size as psSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#} #endif #endif cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/Surface.chs0000644000000000000000000000355712474505512023364 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.Surface -- Copyright : (c) Paolo Martini 2005 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Base class for surfaces. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.Surface where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} {#fun surface_create_similar as surfaceCreateSimilar { withSurface* `Surface', cFromEnum `Content', `Int', `Int' } -> `Surface' mkSurface*#} {#fun surface_destroy as surfaceDestroy { withSurface* `Surface' } -> `()'#} {#fun surface_finish as surfaceFinish { withSurface* `Surface' } -> `()'#} {#fun surface_flush as surfaceFlush { withSurface* `Surface' } -> `()'#} {#fun surface_get_font_options as surfaceGetFontOptions { withSurface* `Surface', withFontOptions* `FontOptions'} -> `()'#} {#fun surface_get_content as surfaceGetContent { withSurface* `Surface' } -> `Content' cToEnum#} {#fun surface_mark_dirty as surfaceMarkDirty { withSurface* `Surface' } -> `()'#} {#fun surface_mark_dirty_rectangle as surfaceMarkDirtyRectangle { withSurface* `Surface', `Int', `Int', `Int', `Int' } -> `()'#} {#fun surface_reference as surfaceReference { withSurface* `Surface' } -> `()'#} {#fun surface_set_device_offset as surfaceSetDeviceOffset { withSurface* `Surface', `Double', `Double' } -> `()'#} {#fun surface_status as surfaceStatus { withSurface* `Surface' } -> `Status' cToEnum#} cairo-0.13.1.0/Graphics/Rendering/Cairo/Internal/Surfaces/SVG.chs0000644000000000000000000000144612474505512022426 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Cairo.Internal.Surfaces.SVG -- Copyright : (c) Duncan Coutts 2007 -- License : BSD-style (see doc/COPYRIGHT) -- -- Maintainer : p.martini@neuralnoise.com -- Stability : experimental -- Portability : portable -- -- Rendering SVG images. ----------------------------------------------------------------------------- module Graphics.Rendering.Cairo.Internal.Surfaces.SVG where {#import Graphics.Rendering.Cairo.Types#} import Foreign import Foreign.C {#context lib="cairo" prefix="cairo"#} #ifdef CAIRO_HAS_SVG_SURFACE {#fun svg_surface_create as svgSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#} #endif