cairo-core (empty) → 1.16.3
raw patch · 24 files changed
+2271/−0 lines, 24 filesdep +basedep +monad-extrasdep +transformersbuild-type:Customsetup-changed
Dependencies added: base, monad-extras, transformers
Files
- Changelog +69/−0
- LICENSE +30/−0
- README.md +21/−0
- Setup.hs +507/−0
- cairo-core.cabal +62/−0
- include/cairo-core.h +4/−0
- src/Graphics/Cairo/Drawing/Cairo.chs +151/−0
- src/Graphics/Cairo/Drawing/Paths.chs +65/−0
- src/Graphics/Cairo/Drawing/Patterns.chs +110/−0
- src/Graphics/Cairo/Drawing/Region.chs +64/−0
- src/Graphics/Cairo/Drawing/TagsLinks.chs +18/−0
- src/Graphics/Cairo/Drawing/Text.chs +89/−0
- src/Graphics/Cairo/Drawing/Transformations.chs +38/−0
- src/Graphics/Cairo/Fonts/FontFace.chs +29/−0
- src/Graphics/Cairo/Fonts/FontOptions.chs +51/−0
- src/Graphics/Cairo/Fonts/ScaledFont.chs +100/−0
- src/Graphics/Cairo/HasStatus.hs +11/−0
- src/Graphics/Cairo/Render.hs +36/−0
- src/Graphics/Cairo/Surfaces/Device.chs +56/−0
- src/Graphics/Cairo/Surfaces/Surface.chs +103/−0
- src/Graphics/Cairo/Types.chs +535/−0
- src/Graphics/Cairo/Utilities/ErrorHandling.chs +22/−0
- src/Graphics/Cairo/Utilities/Matrix.hs +78/−0
- src/Graphics/Cairo/Utilities/VersionInformation.chs +22/−0
+ Changelog view
@@ -0,0 +1,69 @@+commit db325b51d98a127e48b6323df4e91b9f34e4e0d0+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Sat Feb 2 14:59:48 2019 +0800++ Refine hackage information.++commit a10112f890a39805f5f49bfa6d479694e8f642bc+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Sat Feb 2 14:55:17 2019 +0800++ Pretty Document+ + DONE: Document formating. Current document just removes all formation,+ which looks ugly.++commit 570c98b464dcb0b2a9a20607a7e6fa592fcd2fb6+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Sun Jan 27 17:41:27 2019 +0800++ Document generation, from URLs pointing to Cairo website.+ + Even this is just a binding library. Proper docuemnt saves end user from+ opening another website and checking for naming and parameters+ difference.+ + TODO: Document formating. Current document just removes all formation,+ which looks ugly.++commit d670308e221f532735c76c6e482d6729f1ce7af2+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Fri Jan 18 23:47:54 2019 +0800++ Fix Render generation logic. Now this package is rebuildable and works+ with haddock.+ + Building system skips source files that are not changed after last+ building. Thus those files won't be scanned by `genRender`. Therefore+ target Render.hs did not contain methods from those since it was always+ from Render.hs in source.+ + Now target Render.hs is checked first to see if this is just updating+ some Decls, or generating new from source.++commit 897c705222ce09217b44627c53697633ea52c0d1+Author: 王世达 <1886157+Magicloud@users.noreply.github.com>+Date: Wed Jan 16 00:01:31 2019 +0800++ Update README.md++commit f1a9a8b8ff817e6c01c14cf3b7907ea80a08c7dd+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Tue Jan 15 22:59:14 2019 +0800++ Update readme. Add `MonadIO Render` and `with`.+ + `IO` action in `Render` cannot be done without `MonadIO Render`.+ + `with` is `use` in `Render`.++commit 3d24f3557b94774b3016ea7c2520d8621c02b96d+Author: Magicloud <1886157+Magicloud@users.noreply.github.com>+Date: Wed Jan 9 15:39:07 2019 +0800++ Cairo Haskell binding. Non-optional part.+ + Cairo binding available with GHC 8.6. Trying to make this memory safe+ and typed.+ + Haddock does not work yet.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Magicloud (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Magicloud nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,21 @@+# Cairo Haskell binding - Core++This is a library for Haskell to use Cairo function straightforwardly. This package only contains non-optional functions (which is not controlled by building flags). Optional functions like surface supporting and font supporting are in "cairo-opts".++The source is inspired by [garetxe](https://github.com/garetxe) and [cohomology](https://github.com/cohomology).++## Memory safe++All the pointers should be reference/destroy -ed as manual required, if possible. Hopefully I did not miss any part or misunderstand the document.++## Type++When making the library, I tried to use more meaningful type name. So one looking at the type signature would know what to do.++## Render++A sugar monad wrapping all functions use `Context` as first parameter, like cairo from gtk2hs does.++## Status check++Checking the status of most Cairo objects is necessary, after creation, or a sequence of actions on it. A sugar method `with` is given for `Render`. And a method `use` is given for regular IO monad.
+ Setup.hs view
@@ -0,0 +1,507 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Exception+import qualified Data.ByteString.Lazy as LBS+import Data.Char+import Data.List+import Data.Maybe+import Data.Tree.NTree.TypeDefs+import Distribution.Simple hiding ( Module(..) )+import Distribution.Simple.PreProcess+import Distribution.Types.BuildInfo+import qualified Language.Haskell.Extension as C+import Language.Haskell.Exts.Comments+import qualified Language.Haskell.Exts.Extension as H+import Language.Haskell.Exts.Parser+import Language.Haskell.Exts.Pretty+import Language.Haskell.Exts.SrcLoc+import Language.Haskell.Exts.Syntax hiding (XTag, XAttr)+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import System.Directory+import System.FilePath+import Text.XML.HXT.DOM.ShowXml+import Text.XML.HXT.DOM.TypeDefs+import Text.XML.HXT.Parser.HtmlParsec+import Text.XML.HXT.XPath++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { hookedPreProcessors = [ ("chs", \bi lbi clbi ->+ PreProcessor False $ \(iD, iF) (oD, oF) verbosity -> do+ catch (do+ (runPreProcessor $ ppC2hs bi lbi clbi) (iD, iF) (oD, oF) verbosity+ rmLINE (oD </> oF)+ bindingDoc (oD </> oF)+ c2hsWrapper bi (oD </> oF)) (\(e :: SomeException) -> do+ print e+ copyFile (oD </> oF) "/tmp/fuck"+ removeFile (oD </> oF))+ render bi oD (oD </> oF))+ , ("hs", \bi _ _ ->+ PreProcessor False $ \(iD, iF) (oD, oF) _ -> do+ copyFile (iD </> iF) (oD </> oF)+ bindingDoc (oD </> oF)+ render bi oD (oD </> oF))]}++rmLINE :: FilePath -> IO ()+rmLINE fp = do+ readFile fp >>=+ writeFile (fp ++ ".fuck") . unlines . filter (\line -> not $ "{-# LINE " `isPrefixOf` line && "\" #-}" `isSuffixOf` line) . lines+ renameFile (fp ++ ".fuck") fp++bindingDoc :: FilePath -> IO ()+bindingDoc fp = readFile fp >>=+ mapM (\line' -> if "-- λ http" `isPrefixOf` line'+ then do+ doc <- mkDoc $ drop 5 line'+ return $ "{- |" ++ doc ++ "-}"+ else case seqPos "λ http" line' of+ Nothing -> return line'+ Just i -> (++) (take i line') <$> mkDoc (drop (i + 2) line')) . lines >>=+ writeFile fp . unlines++seqPos :: Eq a => [a] -> [a] -> Maybe Int+seqPos x xs =+ let xs' = filter (isPrefixOf x) $ tails xs+ in if not $ null xs'+ then Just $ length xs - length (head xs')+ else Nothing++mkDoc :: String -> IO String+mkDoc line = map (\case+ '\160' -> ' '+ x -> x) <$> case '#' `elemIndex` line of+ Just i -> do+ let url = take i line+ archor = drop (i + 1) line+ defShow . head . getXPath ("//a[@name='" ++ archor ++ "']/..") <$> cache url+ Nothing -> case ' ' `elemIndex` line of+ Just i -> do+ let url = take i line+ xpath = drop (i + 1) line+ xshow . getXPath xpath <$> cache url+ Nothing -> error line++strip :: String -> String+strip qeds+ | head qeds == '"'+ , last qeds == '"'+ = tail $ init qeds+ | otherwise = qeds++haddockEscape :: String -> String+haddockEscape = concatMap (\c ->+ if c `elem` "/"+ then ['\\', c]+ else [c])++defShow :: NTree XNode -> String+defShow (NTree (XTag div' _) contents)+ | div' == mkName "div"+ = intercalate "\n" $ map defShow contents+defShow (NTree (XTag p' [NTree (XAttr class') [NTree (XText "since") []]]) [NTree (XText since) []])+ | p' == mkName "p"+ , class' == mkName "class"+ , "Since: " `isPrefixOf` since+ = "@since " ++ drop 7 since+ | otherwise = show since+defShow (NTree (XTag h' []) inners)+ | h' `elem` map (mkName . (:) 'h' . show) [1 .. 9 :: Int]+ = replicate (read $ drop 1 $ strip $ show h') '=' ++ " " ++ concatMap defShow inners+defShow (NTree (XTag p' attrs) inners)+ | p' == mkName "p"+ = let attr = filter (attrMatch "class") attrs+ NTree _ [NTree (XText class') _] = head attr+ in if not (null attr) && class' == "title"+ then concatMap defShow inners -- this case is useless?+ else concatMap defShow inners+defShow (NTree (XText t) inners) = if t == "\n"+ then concatMap defShow inners+ else t ++ concatMap defShow inners+defShow (NTree (XTag a' [NTree (XAttr name') _]) [])+ | a' == mkName "a"+ , name' == mkName "name"+ = "" -- Ignore HTML anchor.+defShow (NTree (XTag pre' _) code)+ | pre' == mkName "pre"+ = intercalate "\n" ["@", concatMap defShow code, "@"]+defShow t@(NTree (XTag table' _) _)+ | table' == mkName "table"+ , not $ null $ getXPath "/table[@class='informaltable' and colgroup/col/@class='struct_members_name' and colgroup/col/@class='struct_members_description' and colgroup/col/@class='struct_members_annotations']" t+ = intercalate "\n" $ map (\tr ->+ let name = concatMap defShow $ getXPath "/tr/td[@class='struct_member_name']/child::node()" tr+ desc = concatMap defShow $ getXPath "/tr/td[@class='struct_member_description']/child::node()" tr+ anno = concatMap defShow $ getXPath "/tr/td[@class='struct_member_annotations']/child::node()" tr+ in "[" ++ name ++ "]: " ++ desc ++ "\n\n " ++ anno) $ getXPath "/table/tbody/tr" t+defShow t@(NTree (XTag table' _) _)+ | table' == mkName "table"+ , not $ null $ getXPath "/table[@class='informaltable' and colgroup/col/@class='enum_members_name' and colgroup/col/@class='enum_members_description' and colgroup/col/@class='enum_members_annotations']" t+ = intercalate "\n" $ map (\tr ->+ let name = concatMap defShow $ getXPath "/tr/td[@class='enum_member_name']/child::node()" tr+ desc = concatMap defShow $ getXPath "/tr/td[@class='enum_member_description']/child::node()" tr+ anno = concatMap defShow $ getXPath "/tr/td[@class='enum_member_annotations']/child::node()" tr+ in "[" ++ name ++ "]: " ++ desc ++ "\n\n " ++ anno) $ getXPath "/table/tbody/tr" t+defShow t@(NTree (XTag table' _) _)+ | table' == mkName "table"+ , not $ null $ getXPath "/table[@class='informaltable' and colgroup/col/@class='parameters_name' and colgroup/col/@class='parameters_description' and colgroup/col/@class='parameters_annotations']" t+ = intercalate "\n" $ map (\tr ->+ let name = concatMap defShow $ getXPath "/tr/td[@class='parameter_name']/child::node()" tr+ desc = concatMap defShow $ getXPath "/tr/td[@class='parameter_description']/child::node()" tr+ anno = concatMap defShow $ getXPath "/tr/td[@class='parameter_annotations']/child::node()" tr+ in "[" ++ name ++ "]: " ++ desc ++ "\n\n " ++ anno) $ getXPath "/table/tbody/tr" t+defShow t@(NTree (XTag table' _) _)+ | table' == mkName "table"+ , not $ null $ getXPath "/table[@class='listing_frame']/tbody/tr/td[@class='listing_code']/pre[@class='programlisting']" t+ = let code = xshow $ getXPath "string(/table[@class='listing_frame']/tbody/tr/td[@class='listing_code']/pre[@class='programlisting'])" t+ in "@\n" ++ code ++ "\n@"+defShow (NTree (XTag a' attrs) inners)+ | a' == mkName "a"+ = let [NTree _ [NTree (XText url') _]] = filter (attrMatch "href") attrs+ url = haddockEscape $ if "http" `isPrefixOf` url'+ then url'+ else "https://www.cairographics.org/manual/" ++ url'+ in "[" ++ concatMap defShow inners ++ "](" ++ url ++ ")"+defShow (NTree (XTag hr' _) _)+ | hr' == mkName "hr"+ = "\n"+defShow (NTree (XTag br' _) _)+ | br' == mkName "br"+ = "\n"+defShow (NTree (XTag ul' _) lis)+ | ul' == mkName "ul"+ = intercalate "\n" $ map ulShow lis+defShow (NTree (XTag ol' _) lis)+ | ol' == mkName "ol"+ = intercalate "\n" $ map olShow $ zip lis [1..]+defShow (NTree (XTag code' _) inners)+ | code' == mkName "code"+ = concatMap defShow inners+defShow (NTree (XTag em' _) inners)+ | em' == mkName "em"+ = "/" ++ concatMap defShow inners ++ "/"+defShow (NTree (XTag span' _) inners)+ | span' == mkName "span"+ = concatMap defShow inners+defShow (NTree (XTag b' _) inners)+ | b' == mkName "b"+ = concatMap defShow inners+defShow x = error $ show x++ulShow :: NTree XNode -> String+ulShow (NTree (XTag li' _) xs)+ | li' == mkName "li"+ = "- " ++ concatMap defShow xs+ulShow x = defShow x++olShow :: (NTree XNode, Int) -> String+olShow (NTree (XTag li' _) xs, i)+ | li' == mkName "li"+ = show i ++ ". " ++ concatMap defShow xs+olShow (x, _) = defShow x++attrMatch :: String -> NTree XNode -> Bool+attrMatch attrName (NTree (XAttr attr') _)+ | attr' == mkName attrName+ = True+attrMatch _ _ = False++cache :: String -> IO (NTree XNode)+cache url = do+ tmpD <- getTemporaryDirectory+ let pageName = tmpD </> map (\x -> if isAlphaNum x+ then x+ else '_') url+ doesFileExist pageName >>= \case+ True -> return ()+ False -> do+ req <- parseRequest url+ newTlsManager >>= httpLbs req >>= LBS.writeFile pageName . responseBody+ last . parseHtmlContent <$>+ readFile pageName++render :: BuildInfo -> FilePath -> FilePath -> IO ()+render bi dir inFile = do+ doesE <- doesFileExist (dir </> "Graphics/Cairo/Render.hs")+ let renderFile = if doesE+ then dir </> "Graphics/Cairo/Render.hs"+ else "src/Graphics/Cairo/Render.hs"+ (modRender, _) <- parseModuleFile renderFile (defaultExtensions bi)+ r <- genRender modRender <$> parseModuleFile inFile (defaultExtensions bi)+ writeFile (dir </> "Graphics/Cairo/Render.hs") $ prettyPrint r++c2hsWrapper :: BuildInfo -> FilePath -> IO ()+c2hsWrapper bi fp = do+ (m, c) <- parseModuleFile fp (defaultExtensions bi)+ let mc = associateHaddock (m, c)+ if not $ skipModule c+ then writeFile fp $ interleavePrint $ refineExports $ liftIO mc c+ else return ()++interleavePrint :: Module (SrcSpanInfo, [Comment]) -> String+interleavePrint (Module _ b c d e) = intercalate "\n"+ [ intercalate "\n" $ map prettyPrint c+ , case b of+ Nothing -> ""+ Just mh@(ModuleHead _ (ModuleName (_, mc) _) _ _) ->+ intercalate "\n"+ [ commentsPrint mc+ , prettyPrint mh ]+ , intercalate "\n" $ map prettyPrint d+ , intercalate "\n" $ map (\decl -> intercalate "\n"+ [ commentsPrint $ declComments decl+ , prettyPrint decl ]) e ]+interleavePrint x = error $ show x++commentsPrint :: [Comment] -> String+commentsPrint [] = ""+commentsPrint cs = "{-" ++ intercalate "\n" (map (\ (Comment _ _ s) -> s) cs) ++ "-}"++getLanguagePragmas :: String -> [H.Extension]+getLanguagePragmas content = case getTopPragmas content of+ ParseFailed _ _ -> []+ ParseOk pragmas -> concatMap (\case+ LanguagePragma _ lps -> map (\(Ident _ n) -> H.EnableExtension $ read n) lps+ _ -> []) pragmas++refineExports :: Module (SrcSpanInfo, [Comment]) -> Module (SrcSpanInfo, [Comment])+refineExports (Module a (Just (ModuleHead b f g Nothing)) c d e) = refineExports' a b c d e f g noL+refineExports (Module a (Just (ModuleHead b f g (Just (ExportSpecList h [])))) c d e) = refineExports' a b c d e f g h+refineExports x = x++refineExports' :: (SrcSpanInfo, [Comment])+ -> (SrcSpanInfo, [Comment])+ -> [ModulePragma (SrcSpanInfo, [Comment])]+ -> [ImportDecl (SrcSpanInfo, [Comment])]+ -> [Decl (SrcSpanInfo, [Comment])]+ -> ModuleName (SrcSpanInfo, [Comment])+ -> Maybe (WarningText (SrcSpanInfo, [Comment]))+ -> (SrcSpanInfo, [Comment])+ -> Module (SrcSpanInfo, [Comment])+refineExports' a b c d e f@(ModuleName _ mn) g h = Module a (Just $ ModuleHead b f g $ Just $ ExportSpecList h exports) c d e+ where+ exports = catMaybes $ concatMap (\case+ FunBind _ matches -> map (\(Match _ (Ident _ n) _ _ _) -> if notExport n+ then Nothing+ else Just $ exportFunction mn n) matches+ TypeDecl _ dh _ -> [Just $ exportType mn $ nameOfDeclHead dh]+ DataDecl _ _ _ dh _ _ -> [Just $ exportData mn $ nameOfDeclHead dh]+ PatBind _ (PVar _ (Ident _ n)) _ _ -> [Just $ exportPattern mn n]+ _ -> [Nothing]) e++exportType :: String -> String -> ExportSpec (SrcSpanInfo, [Comment])+exportType mn n = EAbs noL (NoNamespace noL) $ Qual noL (ModuleName noL mn) $ Ident noL n+exportData :: String -> String -> ExportSpec (SrcSpanInfo, [Comment])+exportData mn n = EThingWith noL (EWildcard noL 0) (Qual noL (ModuleName noL mn) $ Ident noL n) []+exportPattern :: String -> String -> ExportSpec (SrcSpanInfo, [Comment])+exportPattern mn n = EAbs noL (NoNamespace noL) $ Qual noL (ModuleName noL mn) $ Ident noL n+exportFunction :: String -> String -> ExportSpec (SrcSpanInfo, [Comment])+exportFunction mn n = EVar noL $ Qual noL (ModuleName noL mn) $ Ident noL n++notExport :: String -> Bool+notExport n = last n `elem` ['\'', '_']++nameOfDeclHead :: Show l => DeclHead l -> String+nameOfDeclHead (DHead _ (Ident _ n)) = n+nameOfDeclHead (DHApp _ x _) = nameOfDeclHead x+nameOfDeclHead x = error $ show x++genRender :: Module SrcSpanInfo+ -> (Module SrcSpanInfo, [Comment]) -> Module SrcSpanInfo+genRender modRender (Module _ (Just (ModuleHead _ (ModuleName _ mn) _ _)) _ _ e, _)+ | mn `elem` ["Graphics.Cairo.Render", "Graphics.Cairo.Types"] = modRender+ | otherwise =+ let renders = concatMap (\case+ TypeSig _ a t@(TyFun _ (TyCon _ (UnQual _ (Ident _ "Context"))) b) ->+ TypeSig noSrcSpan a (liftOut b) : map (funBind (count t) mn) a+ TypeSig _ a t@(TyFun _ (TyParen _ (TyCon _ (UnQual _ (Ident _ "Context")))) b) ->+ TypeSig noSrcSpan a (liftOut b) : map (funBind (count t) mn) a+ TypeSig _ a (TyForall _ b c t@(TyFun _ (TyCon _ (UnQual _ (Ident _ "Context"))) d)) ->+ TypeSig noSrcSpan a (TyForall noSrcSpan b c $ liftOut d) : map (funBind (count t) mn) a+ TypeSig _ a (TyForall _ b c t@(TyFun _ (TyParen _ (TyCon _ (UnQual _ (Ident _ "Context")))) d)) ->+ TypeSig noSrcSpan a (TyForall noSrcSpan b c $ liftOut d) : map (funBind (count t) mn) a+ _ -> []) e+ in if null renders+ then modRender+ else updateImport mn $ mergeDecl modRender renders+genRender _ x = error $ show x++mergeDecl :: Show l => Module l -> [Decl l] -> Module l+mergeDecl (Module a b c d e) decls = Module a b c d (deleteFirstsBy sameName e decls ++ decls)+mergeDecl x _ = error $ show x++sameName :: Decl l -> Decl l -> Bool+sameName (TypeSig _ [Ident _ n1] _) (TypeSig _ [Ident _ n2] _) = n1 == n2+sameName (FunBind _ [Match _ (Ident _ n1) _ _ _]) (FunBind _ [Match _ (Ident _ n2) _ _ _]) = n1 == n2+sameName _ _ = False++count :: Type l -> Integer+count = sum . unfoldr (\case+ TyFun _ _ n -> Just (1, n)+ _ -> Nothing)++liftOut :: Type SrcSpanInfo -> Type SrcSpanInfo+liftOut (TyFun _ a t) = TyFun noSrcSpan a $ liftOut t+liftOut (TyApp _ (TyVar _ (Ident _ "m")) a) =+ TyApp noSrcSpan (TyApp noSrcSpan (TyCon noSrcSpan $ UnQual noSrcSpan $ Ident noSrcSpan "Render")+ (TyCon noSrcSpan (UnQual noSrcSpan (Ident noSrcSpan "m")))) a+liftOut x = error $ show x++updateImport :: String -> Module SrcSpanInfo -> Module SrcSpanInfo+updateImport mn m@(Module a b c d e) =+ let newImport = ImportDecl noSrcSpan (ModuleName noSrcSpan mn) True False False Nothing Nothing Nothing+ in case any (newImport ==) d of+ True -> m+ False -> Module a b c (newImport : d) e+updateImport _ x = error $ show x++funBind :: Integer -> String -> Name SrcSpanInfo -> Decl SrcSpanInfo+funBind paramNum modName funName = FunBind noSrcSpan+ [Match noSrcSpan funName+ (map (\i -> PVar noSrcSpan (Ident noSrcSpan ("v" ++ show i))) [2..paramNum])+ (UnGuardedRhs noSrcSpan $ fromParseResult $ parseExp $ intercalate "\n"+ [ "Render $ do"+ , " context <- ask"+ , concat [" ", modName, ".", prettyPrint funName, " context ", intercalate " " $ map ((++) "v" . show) [2..paramNum]]])+ Nothing]++liftIO :: Module (SrcSpanInfo, [Comment]) -> [Comment] -> Module (SrcSpanInfo, [Comment])+liftIO (Module a' b' c' d' e') comments =+ let name2LiftIO = detectFunctions2LiftIO e' comments+ in if null name2LiftIO+ then Module a' b' c' d' e'+ else Module a' b' c' (importMonadIO : d') $ concatMap (\case+ TypeSig a ns b -> map (\n -> if n `isIn` name2LiftIO+ then liftIOTypeSig $ TypeSig a [n] b+ else TypeSig a [n] b) ns+ g@(PatBind a f@(PVar _ b) (UnGuardedRhs c d) e) -> [if b `isIn` name2LiftIO+ then PatBind a f (UnGuardedRhs c $ InfixApp noL+ (Var noL (UnQual noL (Ident noL "liftIO")))+ (QVarOp noL (UnQual noL (Symbol noL ".")))+ d) e+ else g]+ FunBind a bs -> map (\b@(Match c d e (UnGuardedRhs f g) h) -> if d `isIn` name2LiftIO+ then FunBind a [Match c d e (UnGuardedRhs f $ InfixApp noL+ (Var noL (UnQual noL (Ident noL "liftIO")))+ (QVarOp noL (UnQual noL (Symbol noL "$")))+ g) h]+ else FunBind a [b]) bs+ x -> [x]) e'+liftIO x _ = error $ show x++noL :: (SrcSpanInfo, [Comment])+noL = (noSrcSpan, [])++isIn :: Name l -> [Name l] -> Bool+isIn (Ident _ x) xs = case find (\case+ Ident _ n -> n == x+ Symbol _ n -> n == x) xs of+ Nothing -> False+ _ -> True+isIn (Symbol _ x) xs = case find (\case+ Ident _ n -> n == x+ Symbol _ n -> n == x) xs of+ Nothing -> False+ _ -> True++parseModuleFile :: String+ -> [Extension] -> IO (Module SrcSpanInfo, [Comment])+parseModuleFile fp exts = do+ c <- readFile fp+ case parseModuleWithComments (defaultParseMode+ { parseFilename = fp+ , extensions = getLanguagePragmas c ++ map why exts }) c of+ ParseFailed l s -> fail (s ++ ": " ++ fp ++ "\n" ++ show l)+ ParseOk r -> return r++why :: C.Extension -> H.Extension+why = read . show++skipModule :: [Comment] -> Bool+skipModule = any (\(Comment ml _ comment) ->+ not ml && comment == " λ SKIP MODULE")++detectFunctions2LiftIO :: [Decl l] -> [Comment] -> [Name l]+detectFunctions2LiftIO decls comments =+ concatMap (\(TypeSig _ ns _) -> ns) $ filter (\case+ TypeSig _ ns (TyForall _ _ _ t) -> checkType t && all (\(Ident _ n) -> not $ checkAnn n comments) ns+ TypeSig _ ns (TyFun _ _ t) -> checkType t && all (\(Ident _ n) -> not $ checkAnn n comments) ns+ _ -> False) decls++checkType :: Type l -> Bool+checkType (TyFun _ _ t) = checkType t+checkType (TyApp _ (TyCon _ (UnQual _ (Ident _ "IO"))) _) = True+checkType _ = False++checkAnn :: String -> [Comment] -> Bool+checkAnn n = any (\(Comment ml _ comment) ->+ not ml && comment == (" λ SKIP " ++ n))++liftIOTypeSig :: Decl (SrcSpanInfo, [Comment]) -> Decl (SrcSpanInfo, [Comment])+liftIOTypeSig (TypeSig a b z@TyFun{}) = TypeSig a b+ (TyForall noL Nothing+ (Just $ CxTuple noL+ [ ClassA noL+ (UnQual noL (Ident noL "MonadIO"))+ [TyVar noL (Ident noL "m")] ])+ (replaceIO z))+liftIOTypeSig (TypeSig a b (TyForall c d (Just (CxSingle e f)) z)) =+ TypeSig a b (TyForall c d+ (Just $ CxTuple e [f, contextMonadIO]) (replaceIO z))+liftIOTypeSig (TypeSig a b (TyForall c d (Just (CxTuple e f)) z)) =+ TypeSig a b+ (TyForall c d (Just $ CxTuple e $ contextMonadIO : f) (replaceIO z))+liftIOTypeSig x = error $ show x++replaceIO :: Show l => Type l -> Type l+replaceIO (TyFun a b c) = TyFun a b $ replaceIO c+replaceIO (TyApp a (TyCon b (UnQual c (Ident d "IO"))) e) =+ TyApp a (TyCon b (UnQual c (Ident d "m"))) e+replaceIO x = error $ show x++importMonadIO :: ImportDecl (SrcSpanInfo, [Comment])+importMonadIO = ImportDecl noL+ (ModuleName noL "Control.Monad.IO.Class")+ False False False Nothing Nothing Nothing++contextMonadIO :: Asst (SrcSpanInfo, [Comment])+contextMonadIO = ClassA noL+ (UnQual noL (Ident noL "MonadIO"))+ [TyVar noL (Ident noL "m")]++declComments :: Decl (a, p) -> p+declComments (TypeDecl (_, c) _ _) = c+declComments (TypeFamDecl (_, c) _ _ _) = c+declComments (ClosedTypeFamDecl (_, c) _ _ _ _) = c+declComments (DataDecl (_, c) _ _ _ _ _) = c+declComments (GDataDecl (_, c) _ _ _ _ _ _) = c+declComments (DataFamDecl (_, c) _ _ _) = c+declComments (TypeInsDecl (_, c) _ _) = c+declComments (DataInsDecl (_, c) _ _ _ _) = c+declComments (GDataInsDecl (_, c) _ _ _ _ _) = c+declComments (ClassDecl (_, c) _ _ _ _) = c+declComments (InstDecl (_, c) _ _ _) = c+declComments (DerivDecl (_, c) _ _ _) = c+declComments (InfixDecl (_, c) _ _ _) = c+declComments (DefaultDecl (_, c) _) = c+declComments (SpliceDecl (_, c) _) = c+declComments (TypeSig (_, c) _ _) = c+declComments (PatSynSig (_, c) _ _ _ _ _) = c+declComments (FunBind (_, c) _) = c+declComments (PatBind (_, c) _ _ _) = c+declComments (PatSyn (_, c) _ _ _) = c+declComments (ForImp (_, c) _ _ _ _ _) = c+declComments (ForExp (_, c) _ _ _ _) = c+declComments (RulePragmaDecl (_, c) _) = c+declComments (DeprPragmaDecl (_, c) _) = c+declComments (WarnPragmaDecl (_, c) _) = c+declComments (InlineSig (_, c) _ _ _) = c+declComments (InlineConlikeSig (_, c) _ _) = c+declComments (SpecSig (_, c) _ _ _) = c+declComments (SpecInlineSig (_, c) _ _ _ _) = c+declComments (InstSig (_, c) _) = c+declComments (AnnPragma (_, c) _) = c+declComments (MinimalPragma (_, c) _) = c+declComments (RoleAnnotDecl (_, c) _ _) = c+declComments (CompletePragma (_, c) _ _) = c
+ cairo-core.cabal view
@@ -0,0 +1,62 @@+name: cairo-core+version: 1.16.3+synopsis: Cairo Haskell binding (core functions)+description: Cairo Haskell binding (core functions). Please checkout cairo-opts for other functions.+homepage: https://github.com/magicloud/cairo-core#readme+license: BSD3+license-file: LICENSE+author: Magicloud+maintainer: magiclouds@gmail.com+copyright: None+category: Graphics+build-type: Custom+extra-source-files: README.md, Changelog+cabal-version: 2.0++custom-setup+ setup-depends:+ base >= 4.7 && < 5,+ Cabal,+ filepath,+ haskell-src-exts < 1.21,+ directory,+ http-client,+ http-client-tls,+ hxt,+ hxt-xpath,+ bytestring++library+ hs-source-dirs: src+ exposed-modules: Graphics.Cairo.Types+ Graphics.Cairo.HasStatus+ Graphics.Cairo.Utilities.Matrix+ Graphics.Cairo.Utilities.ErrorHandling+ Graphics.Cairo.Utilities.VersionInformation+ Graphics.Cairo.Surfaces.Surface+ Graphics.Cairo.Surfaces.Device+ Graphics.Cairo.Fonts.FontFace+ Graphics.Cairo.Fonts.FontOptions+ Graphics.Cairo.Fonts.ScaledFont+ Graphics.Cairo.Drawing.TagsLinks+ Graphics.Cairo.Drawing.Text+ Graphics.Cairo.Drawing.Transformations+ Graphics.Cairo.Drawing.Region+ Graphics.Cairo.Drawing.Patterns+ Graphics.Cairo.Drawing.Paths+ Graphics.Cairo.Drawing.Cairo+ Graphics.Cairo.Render+ build-depends: base >= 4.7 && < 5+ , monad-extras+ , transformers+ default-language: Haskell2010+ c-sources: include/cairo-core.h+ include-dirs: include+ pkgconfig-depends: cairo+ build-tools: c2hs+ default-extensions: LambdaCase+ ghc-options: -Wall -fno-warn-orphans++source-repository head+ type: git+ location: https://github.com/magicloud/cairo-core
+ include/cairo-core.h view
@@ -0,0 +1,4 @@+#include<cairo.h>++#define CAIRO_CHECK_VERSION(major, minor, micro) \+ (CAIRO_VERSION >= CAIRO_VERSION_ENCODE(major, minor, micro))
+ src/Graphics/Cairo/Drawing/Cairo.chs view
@@ -0,0 +1,151 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-cairo-t.description+-}+module Graphics.Cairo.Drawing.Cairo where++{#import Graphics.Cairo.Types#}+import Foreign.C.Types+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import Graphics.Cairo.HasStatus++{#context lib="cairo" prefix="cairo"#}++instance HasStatus Context where+ status = Graphics.Cairo.Drawing.Cairo.status++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-create+{#fun create as ^ { `Surface' } -> `Context' outContext*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-target+{#fun get_target as ^ { `Context' } -> `Surface' outSurfaceRef*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-source+{#fun get_source as ^ { `Context' } -> `Pattern' outPatternRef*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-status+{#fun status as ^ { `Context' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-save+{#fun save as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-restore+{#fun restore as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-source-rgb+{#fun set_source_rgb as ^ { `Context', CDouble `Red', CDouble `Green', CDouble `Blue' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-source-rgba+{#fun set_source_rgba as ^ { `Context', CDouble `Red', CDouble `Green', CDouble `Blue', CDouble `Alpha' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-source+{#fun set_source as ^ { `Context', `Pattern' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-source-surface+{#fun set_source_surface as ^ { `Context', `Surface', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-antialias+{#fun set_antialias as ^ { `Context', `Antialias' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-antialias+{#fun get_antialias as ^ { `Context' } -> `Antialias'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-fill-rule+{#fun set_fill_rule as ^ { `Context', `FillRule' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-fill-rule+{#fun get_fill_rule as ^ { `Context' } -> `FillRule'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-line-cap+{#fun set_line_cap as ^ { `Context', `LineCap' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-line-cap+{#fun get_line_cap as ^ { `Context' } -> `LineCap'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-line-join+{#fun set_line_join as ^ { `Context', `LineJoin' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-line-join+{#fun get_line_join as ^ { `Context' } -> `LineJoin'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-line-width+{#fun set_line_width as ^ { `Context', `Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-line-width+{#fun get_line_width as ^ { `Context' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-miter-limit+{#fun set_miter_limit as ^ { `Context', `Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-miter-limit+{#fun get_miter_limit as ^ { `Context' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-operator+{#fun set_operator as ^ { `Context', `Operator' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-operator+{#fun get_operator as ^ { `Context' } -> `Operator'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-tolerance+{#fun set_tolerance as ^ { `Context', `Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-tolerance+{#fun get_tolerance as ^ { `Context' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-clip+{#fun clip as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-clip-preserve+{#fun clip_preserve as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-reset-clip+{#fun reset_clip as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-fill+{#fun fill as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-fill-preserve+{#fun fill_preserve as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-fill-extents+{#fun fill_extents as ^ { `Context', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-in-fill+{#fun in_fill as ^ { `Context', CDouble `X', CDouble `Y' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-mask+{#fun mask as ^ { `Context', `Pattern' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-mask-surface+{#fun mask_surface as ^ { `Context', `Surface', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-paint+{#fun paint as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-paint-with-alpha+{#fun paint_with_alpha as ^ { `Context', CDouble `Alpha' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-stroke+{#fun stroke as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-stroke-preserve+{#fun stroke_preserve as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-stroke-extents+{#fun stroke_extents as ^ { `Context', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-in-stroke+{#fun in_stroke as ^ { `Context', CDouble `X', CDouble `Y' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-copy-page+{#fun copy_page as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-show-page+{#fun show_page as ^ { `Context' } -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-push-group+{#fun push_group as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-push-group-with-content+{#fun push_group_with_content as ^ { `Context', `Content' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-pop-group+{#fun pop_group as ^ { `Context' } -> `Pattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-pop-group-to-source+{#fun pop_group_to_source as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-group-target+{#fun get_group_target as ^ { `Context' } -> `Surface' outSurfaceRef*#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-set-dash+setDash :: Context -> [Double] -> Offset -> IO ()+setDash context dashes offset =+ withArrayLen (map (CDouble) dashes) $ \len ptr -> setDash' context ptr len offset+ where {#fun set_dash as setDash' { `Context', id `Ptr CDouble', `Int', CDouble `Offset' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-dash+getDash :: Context -> IO ([Double], Offset)+getDash context = do+ len <- getDashCount context+ allocaArray len $ \ptr -> do+ offset <- getDash' context ptr+ dashes <- (map (\(CDouble x) -> x)) <$> peekArray len ptr+ return (dashes, offset)+ where {#fun get_dash as getDash' { `Context', id `Ptr CDouble', alloca- `Offset' peekDouble* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-dash-count+{#fun get_dash_count as ^ { `Context' } -> `Int'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-clip-extents+{#fun clip_extents as ^ { `Context', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-copy-clip-rectangle-list+{#fun copy_clip_rectangle_list as ^ { `Context' } -> `RectangleList Double' peek*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-get-reference-count+{#fun get_reference_count as ^ { `Context' } -> `Int'#}+#endif -- CAIRO_CHECK_VERSION(1,4,0)++#if CAIRO_CHECK_VERSION(1,10,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-in-clip+{#fun in_clip as ^ { `Context', CDouble `X', CDouble `Y' } -> `Bool'#}+#endif -- CAIRO_CHECK_VERSION(1,10,0)
+ src/Graphics/Cairo/Drawing/Paths.chs view
@@ -0,0 +1,65 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Paths.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-Paths.description+-}+module Graphics.Cairo.Drawing.Paths where++{#import Graphics.Cairo.Types#}+import Foreign.C.Types+import Foreign.Marshal+import Foreign.Storable++{#context lib="cairo" prefix="cairo"#}++-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-copy-path+{#fun copy_path as ^ { `Context' } -> `Path' peek*#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-copy-path-flat+{#fun copy_path_flat as ^ { `Context' } -> `Path' peek*#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-append-path+{#fun append_path as ^ { `Context', with* `Path' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-get-current-point+{#fun get_current_point as ^ { `Context', alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-new-path+{#fun new_path as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-close-path+{#fun close_path as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-arc+{#fun arc as ^ { `Context', CDouble `X', CDouble `Y', CDouble `Radius', CDouble `Angle', CDouble `Angle' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-arc-negative+{#fun arc_negative as ^ { `Context', CDouble `X', CDouble `Y', CDouble `Radius', CDouble `Angle', CDouble `Angle' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-curve-to+{#fun curve_to as ^ { `Context', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-line-to+{#fun line_to as ^ { `Context', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-move-to+{#fun move_to as ^ { `Context', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-rectangle+{#fun rectangle as ^ { `Context', CDouble `X', CDouble `Y', CDouble `Width', CDouble `Height' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-text-path+{#fun text_path as ^ { `Context', withUTF8String* `String' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-rel-curve-to+{#fun rel_curve_to as ^ { `Context', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-rel-line-to+{#fun rel_line_to as ^ { `Context', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-rel-move-to+{#fun rel_move_to as ^ { `Context', CDouble `X', CDouble `Y' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-glyph-path+glyphPath :: Context -> [Glyph] -> IO ()+glyphPath context glyphs =+ withArrayLen glyphs $ \len ptr -> glyphPath' context ptr len+ where {#fun glyph_path as glyphPath' { `Context', `GlyphPtr', `Int' } -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-new-sub-path+{#fun new_sub_path as ^ { `Context' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,6,0)+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-has-current-point+{#fun has_current_point as ^ { `Context' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-path-extents+{#fun path_extents as ^ { `Context', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,6,0)
+ src/Graphics/Cairo/Drawing/Patterns.chs view
@@ -0,0 +1,110 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-cairo-pattern-t.description+-}+module Graphics.Cairo.Drawing.Patterns where++{#import Graphics.Cairo.Types#}+import Control.Exception+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Storable+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++instance HasStatus Pattern where+ status = patternStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-add-color-stop-rgb+{#fun pattern_add_color_stop_rgb as ^ { withPattern* `GradientPattern', CDouble `Offset', CDouble `Red', CDouble `Green', CDouble `Blue' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-add-color-stop-rgba+{#fun pattern_add_color_stop_rgba as ^ { withPattern* `GradientPattern', CDouble `Offset', CDouble `Red', CDouble `Green', CDouble `Blue', CDouble `Alpha' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-rgb+{#fun pattern_create_rgb as ^ { CDouble `Red', CDouble `Green', CDouble `Blue' } -> `SolidPattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-rgba+{#fun pattern_create_rgba as ^ { CDouble `Red', CDouble `Green', CDouble `Blue', CDouble `Alpha' } -> `SolidPattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-for-surface+{#fun pattern_create_for_surface as ^ { `Surface' } -> `SurfacePattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-linear+{#fun pattern_create_linear as ^ { CDouble `X', CDouble `Y', CDouble `X', CDouble `Y' } -> `LinearGradientPattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-radial+{#fun pattern_create_radial as ^ { CDouble `X', CDouble `Y', CDouble `Radius', CDouble `X', CDouble `Y', CDouble `Radius' } -> `RadialGradientPattern' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-status+{#fun pattern_status as ^ { `Pattern' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-set-extend+{#fun pattern_set_extend as ^ { withPattern* `SurfacePattern', `Extend' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-extend+{#fun pattern_get_extend as ^ { withPattern* `SurfacePattern' } -> `Extend'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-set-filter+{#fun pattern_set_filter as ^ { withPattern* `SurfacePattern', `Filter' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-filter+{#fun pattern_get_filter as ^ { withPattern* `SurfacePattern' } -> `Filter'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-set-matrix+{#fun pattern_set_matrix as ^ { `Pattern', with* `Matrix Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-matrix+{#fun pattern_get_matrix as ^ { `Pattern', alloca- `Matrix Double' peek*} -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-type+{#fun pattern_get_type as ^ { `Pattern' } -> `PatternType'#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-color-stop-count+{#fun pattern_get_color_stop_count as ^ { withPattern* `GradientPattern', alloca- `Int' peekInt* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-color-stop-rgba+{#fun pattern_get_color_stop_rgba as ^ { withPattern* `GradientPattern', fromIntegral `Index', alloca- `Double' peekDouble*, alloca- `Red' peekDouble*, alloca- `Green' peekDouble*, alloca- `Blue' peekDouble*, alloca- `Alpha' peekDouble* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-rgba+{#fun pattern_get_rgba as ^ { withPattern* `SolidPattern', alloca- `Red' peekDouble*, alloca- `Green' peekDouble*, alloca- `Blue' peekDouble*, alloca- `Alpha' peekDouble* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-surface+{#fun pattern_get_surface as ^ { withPattern* `SurfacePattern', alloca- `Surface' outSurfacePtrRef* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-linear-points+{#fun pattern_get_linear_points as ^ { withPattern* `LinearGradientPattern', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-radial-circles+{#fun pattern_get_radial_circles as ^ { withPattern* `RadialGradientPattern', alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `Radius' peekDouble*, alloca- `X' peekDouble*, alloca- `Y' peekDouble*, alloca- `Radius' peekDouble* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-get-reference-count+{#fun pattern_get_reference_count as ^ { `Pattern' } -> `Int'#}+#endif -- CAIRO_CHECK_VERSION(1,4,0)++#if CAIRO_CHECK_VERSION(1,12,0)+{- |+λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-begin-patch+λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-end-patch+-}+meshPatternPatch :: Mesh -> (Mesh -> IO c) -> IO c+meshPatternPatch mesh f =+ bracket (meshPatternBeginPatch mesh) (const $ do+ meshPatternEndPatch mesh+ patternStatus mesh >>= failStatus) (const $ f mesh)+ where+ {#fun mesh_pattern_begin_patch as ^ { withPattern* `Mesh' } -> `()'#}+ {#fun mesh_pattern_end_patch as ^ { withPattern* `Mesh' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-create-mesh+{#fun pattern_create_mesh as ^ {} -> `Mesh' outPattern*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-move-to+{#fun mesh_pattern_move_to as ^ { withPattern* `Mesh', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-line-to+{#fun mesh_pattern_line_to as ^ { withPattern* `Mesh', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-curve-to+{#fun mesh_pattern_curve_to as ^ { withPattern* `Mesh', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-set-control-point+{#fun mesh_pattern_set_control_point as ^ { withPattern* `Mesh', cFromEnum `MeshPointNum', CDouble `X', CDouble `Y' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-set-corner-color-rgb+{#fun mesh_pattern_set_corner_color_rgb as ^ { withPattern* `Mesh', cFromEnum `MeshCornerNum', CDouble `Red', CDouble `Green', CDouble `Blue' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-set-corner-color-rgba+{#fun mesh_pattern_set_corner_color_rgba as ^ { withPattern* `Mesh', cFromEnum `MeshCornerNum', CDouble `Red', CDouble `Green', CDouble `Blue', CDouble `Alpha' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-get-patch-count+{#fun mesh_pattern_get_patch_count as ^ { withPattern* `Mesh', alloca- `Int' peekInt*} -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-get-path+{#fun mesh_pattern_get_path as ^ { withPattern* `Mesh', `Int' } -> `Path' peek*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-get-control-point+{#fun mesh_pattern_get_control_point as ^ { withPattern* `Mesh', `Int', cFromEnum `MeshPointNum', alloca- `X' peekDouble*, alloca- `Y' peekDouble* } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-mesh-pattern-get-corner-color-rgba+{#fun mesh_pattern_get_corner_color_rgba as ^ { withPattern* `Mesh', `Int', cFromEnum `MeshCornerNum', alloca- `Red' peekDouble*, alloca- `Green' peekDouble*, alloca- `Blue' peekDouble*, alloca- `Alpha' peekDouble* } -> `()' failStatusRaw*#}+#endif -- CAIRO_CHECK_VERSION(1,12,0)
+ src/Graphics/Cairo/Drawing/Region.chs view
@@ -0,0 +1,64 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Regions.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-Regions.description+-}+module Graphics.Cairo.Drawing.Region where++{#import Graphics.Cairo.Types#}+import Foreign.Marshal+import qualified Foreign.Ptr as C2HSImp+import Foreign.Storable+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++#if CAIRO_CHECK_VERSION(1,10,0)+instance HasStatus Region where+ status = regionStatus++-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-create+{#fun region_create as ^ {} -> `Region' outRegion*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-create-rectangle+{#fun region_create_rectangle as ^ { with* `Rectangle Int' } -> `Region' outRegion*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-create-rectangles+{#fun region_create_rectangles as ^ {`RectangleIntPtr', `Int' } -> `Region' outRegion*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-copy+{#fun region_copy as ^ { `Region' } -> `Region' outRegion*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-status+{#fun region_status as ^ { `Region' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-get-extents+{#fun region_get_extents as ^ { `Region', alloca- `Rectangle Int' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-num-rectangles+{#fun region_num_rectangles as ^ { `Region' } -> `Int'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-get-rectangle+{#fun region_get_rectangle as ^ { `Region', fromIntegral `Index', alloca- `Rectangle Int' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-is-empty+{#fun region_is_empty as ^ { `Region' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-contains-point+{#fun region_contains_point as ^ { `Region', fromIntegral `XInt', fromIntegral `YInt' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-contains-rectangle+{#fun region_contains_rectangle as ^ { `Region', with* `Rectangle Int' } -> `RegionOverlap'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-equal+{#fun region_equal as ^ { `Region', `Region' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-translate+{#fun region_translate as ^ { `Region', fromIntegral `XInt', fromIntegral `YInt' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-intersect+{#fun region_intersect as ^ { `Region', `Region' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-intersect-rectangle+{#fun region_intersect_rectangle as ^ { `Region', with* `Rectangle Int' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-subtract+{#fun region_subtract as ^ { `Region', `Region' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-subtract-rectangle+{#fun region_subtract_rectangle as ^ { `Region', with* `Rectangle Int' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-union+{#fun region_union as ^ { `Region', `Region' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-union-rectangle+{#fun region_union_rectangle as ^ { `Region', with* `Rectangle Int' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-xor+{#fun region_xor as ^ { `Region', `Region' } -> `()' failStatusRaw*#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-xor-rectangle+{#fun region_xor_rectangle as ^ { `Region', with* `Rectangle Int' } -> `()' failStatusRaw*#}+#endif -- CAIRO_CHECK_VERSION(1,10,0)
+ src/Graphics/Cairo/Drawing/TagsLinks.chs view
@@ -0,0 +1,18 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Tags-and-Links.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Tags-and-Links.html#cairo-Tags-and-Links.description+-}+module Graphics.Cairo.Drawing.TagsLinks where++{#import Graphics.Cairo.Types#}++{#context lib="cairo" prefix="cairo"#}++#if CAIRO_CHECK_VERSION(1,16,0)+-- λ https://www.cairographics.org/manual/cairo-Tags-and-Links.html#cairo-tag-begin+{#fun tag_begin as ^ { `Context', `String', `String' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Tags-and-Links.html#cairo-tag-end+{#fun tag_end as ^ { `Context', `String' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,16,0)
+ src/Graphics/Cairo/Drawing/Text.chs view
@@ -0,0 +1,89 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-text.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-text.html#cairo-text.description+-}+module Graphics.Cairo.Drawing.Text where++{#import Graphics.Cairo.Types#}+import Foreign+import Graphics.Cairo.Fonts.FontOptions+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-select-font-face+{#fun select_font_face as ^ { `Context', withUTF8String* `String', `FontSlant', `FontWeight' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-set-font-size+{#fun set_font_size as ^ { `Context', `Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-set-font-matrix+{#fun set_font_matrix as ^ { `Context', with* `Matrix Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-get-font-matrix+{#fun get_font_matrix as ^ { `Context', alloca- `Matrix Double' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-set-font-options+{#fun set_font_options as ^ { `Context', `FontOptions' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-set-font-face+{#fun set_font_face as ^ { `Context', `FontFace' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-get-font-face+{#fun get_font_face as ^ { `Context' } -> `FontFace' outFontFaceRef*#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-show-text+{#fun show_text as ^ { `Context', withUTF8String* `String' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-font-extents+{#fun font_extents as ^ { `Context', alloca- `FontExtents' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-text-extents+{#fun text_extents as ^ { `Context', withUTF8String* `String', alloca- `TextExtents' peek* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-get-font-options+getFontOptions :: Context -> IO FontOptions+getFontOptions c = do+ fo <- (fontOptionsCreate >>= getFontOptions' c)+ fontOptionsStatus fo >>= failStatus+ return fo+ where {#fun get_font_options as getFontOptions' { `Context', `FontOptions' outFontOptions* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-glyph-extents+glyphExtents :: Context -> [Glyph] -> IO TextExtents+glyphExtents context glyphs =+ withArrayLen glyphs $ \len ptr -> glyphExtents' context ptr len+ where {#fun glyph_extents as glyphExtents' { `Context', `GlyphPtr', `Int', alloca- `TextExtents' peek* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-show-glyphs+showGlyphs :: Context -> [Glyph] -> IO ()+showGlyphs context glyphs =+ withArrayLen glyphs $ \len glyphPtr -> showGlyphs' context glyphPtr len+ where {#fun show_glyphs as showGlyphs' { `Context', `GlyphPtr', `Int' } -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-set-scaled-font+{#fun set_scaled_font as ^ { `Context', `ScaledFont' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-get-scaled-font+{#fun get_scaled_font as ^ { `Context' } -> `ScaledFont' outScaledFontRef*#}+#endif -- CAIRO_CHECK_VERSION(1,4,0)++#if CAIRO_CHECK_VERSION(1,8,0)+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-show-text-glyphs+showTextGlyphs :: Context+ -> String -> [Glyph] -> [TextCluster] -> TextClusterFlags -> IO ()+showTextGlyphs context utf8 glyphs textClusters textClusterFlags =+ withArrayLen glyphs $ \glyphLen glyphPtr ->+ withArrayLen textClusters $ \tcLen tcPtr ->+ showTextGlyphs' context utf8 (-1) glyphPtr glyphLen tcPtr tcLen textClusterFlags+ where {#fun show_text_glyphs as showTextGlyphs' { `Context', withUTF8String* `String', `Int', `GlyphPtr', `Int', `TextClusterPtr', `Int', `TextClusterFlags' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-text-cluster-free+{#fun text_cluster_free as ^ { `TextClusterPtr' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-glyph-free+{#fun glyph_free as ^ { `GlyphPtr' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-toy-font-face-create+{#fun toy_font_face_create as ^ { withUTF8String* `String', `FontSlant', `FontWeight' } -> `FontFace'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-toy-font-face-get-family+{#fun toy_font_face_get_family as ^ { `FontFace' } -> `String'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-toy-font-face-get-slant+{#fun toy_font_face_get_slant as ^ { `FontFace' } -> `FontSlant'#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-toy-font-face-get-weight+{#fun toy_font_face_get_weight as ^ { `FontFace' } -> `FontWeight'#}+#endif -- CAIRO_CHECK_VERSION(1,8,0)
+ src/Graphics/Cairo/Drawing/Transformations.chs view
@@ -0,0 +1,38 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Transformations.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-Transformations.functions_details+-}+module Graphics.Cairo.Drawing.Transformations where++{#import Graphics.Cairo.Types#}+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Storable++{#context lib="cairo" prefix="cairo"#}++-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-translate+{#fun translate as ^ { `Context', CDouble `X0', CDouble `Y0' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-scale+{#fun scale as ^ { `Context', CDouble `XX', CDouble `YY' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-rotate+{#fun rotate as ^ { `Context', CDouble `Radius' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-transform+{#fun transform as ^ { `Context', with* `Matrix Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-set-matrix+{#fun set_matrix as ^ { `Context', with* `Matrix Double' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-get-matrix+{#fun get_matrix as ^ { `Context', alloca- `Matrix Double' peek*} -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-identity-matrix+{#fun identity_matrix as ^ { `Context' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-user-to-device+{#fun user_to_device as ^ { `Context', withDouble* `X' peekDouble*, withDouble* `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-user-to-device-distance+{#fun user_to_device_distance as ^ { `Context', withDouble* `X' peekDouble*, withDouble* `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-device-to-user+{#fun device_to_user as ^ { `Context', withDouble* `X' peekDouble*, withDouble* `Y' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-Transformations.html#cairo-device-to-user-distance+{#fun device_to_user_distance as ^ { `Context', withDouble* `X' peekDouble*, withDouble* `Y' peekDouble* } -> `()'#}
+ src/Graphics/Cairo/Fonts/FontFace.chs view
@@ -0,0 +1,29 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-cairo-font-face-t.description+-}+module Graphics.Cairo.Fonts.FontFace where++{#import Graphics.Cairo.Types#}+import qualified Foreign.Ptr as C2HSImp+import Graphics.Cairo.HasStatus++{#context lib="cairo" prefix="cairo"#}++instance HasStatus FontFace where+ status = fontFaceStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-font-face-status+{#fun font_face_status as ^ { `FontFace' } -> `Status'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-font-face-get-type+{#fun font_face_get_type as ^ { `FontFace' } -> `FontType'#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-font-face-get-reference-count+{#fun font_face_get_reference_count as ^ { `FontFace' } -> `Int'#}+#endif -- CAIRO_CHECK_VERSION(1,4,0)
+ src/Graphics/Cairo/Fonts/FontOptions.chs view
@@ -0,0 +1,51 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-cairo-font-options-t.description+-}+module Graphics.Cairo.Fonts.FontOptions where++{#import Graphics.Cairo.Types#}+import Graphics.Cairo.HasStatus++{#context lib="cairo" prefix="cairo"#}++instance HasStatus FontOptions where+ status = fontOptionsStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-create+{#fun font_options_create as ^ {} -> `FontOptions'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-copy+{#fun font_options_copy as ^ { `FontOptions' } -> `FontOptions'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-status+{#fun font_options_status as ^ { `FontOptions' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-merge+{#fun font_options_merge as ^ { `FontOptions', `FontOptions' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-hash+{#fun font_options_hash as ^ { `FontOptions' } -> `Int'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-equal+{#fun font_options_equal as ^ { `FontOptions', `FontOptions' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-set-antialias+{#fun font_options_set_antialias as ^ { `FontOptions', `Antialias' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-get-antialias+{#fun font_options_get_antialias as ^ { `FontOptions' } -> `Antialias'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-set-subpixel-order+{#fun font_options_set_subpixel_order as ^ { `FontOptions', `SubpixelOrder' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-get-subpixel-order+{#fun font_options_get_subpixel_order as ^ { `FontOptions' } -> `SubpixelOrder'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-set-hint-style+{#fun font_options_set_hint_style as ^ { `FontOptions', `HintStyle' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-get-hint-style+{#fun font_options_get_hint_style as ^ { `FontOptions' } -> `HintStyle'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-set-hint-metrics+{#fun font_options_set_hint_metrics as ^ { `FontOptions', `HintMetrics' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-get-hint-metrics+{#fun font_options_get_hint_metrics as ^ { `FontOptions' } -> `HintMetrics'#}++#if CAIRO_CHECK_VERSION(1,16,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-get-variations+{#fun font_options_get_variations as ^ { `FontOptions' } -> `String'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-set-variations+{#fun font_options_set_variations as ^ { `FontOptions', `String' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,16,0)
+ src/Graphics/Cairo/Fonts/ScaledFont.chs view
@@ -0,0 +1,100 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-cairo-scaled-font-t.description+-}+module Graphics.Cairo.Fonts.ScaledFont where++{#import Graphics.Cairo.Types#}+import Control.Exception+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Cairo.Drawing.Text+import Graphics.Cairo.Fonts.FontFace+import Graphics.Cairo.Fonts.FontOptions+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++instance HasStatus ScaledFont where+ status = scaledFontStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-glyph-extents+scaledFontGlyphExtents :: ScaledFont -> [Glyph] -> IO TextExtents+scaledFontGlyphExtents scaledFont glyphs =+ withArrayLen glyphs $ \len glyphPtr -> scaledFontGlyphExtents' scaledFont glyphPtr len+ where {#fun scaled_font_glyph_extents as scaledFontGlyphExtents' { `ScaledFont', `GlyphPtr', `Int', alloca- `TextExtents' peek* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-create+{#fun scaled_font_create as ^ { `FontFace', with* `Matrix Double', with* `Matrix Double', `FontOptions' } -> `ScaledFont' outScaledFont*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-status+{#fun scaled_font_status as ^ { `ScaledFont' } -> `Status' #}+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-extents+{#fun scaled_font_extents as ^ { `ScaledFont', alloca- `FontExtents' peek* } -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-font-face+scaledFontGetFontFace :: ScaledFont -> IO FontFace+scaledFontGetFontFace sf = do+ ff <- scaledFontGetFontFace' sf+ fontFaceStatus ff >>= failStatus+ return ff+ where {#fun scaled_font_get_font_face as scaledFontGetFontFace' { `ScaledFont' } -> `FontFace' outFontFaceRef*#}++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-font-options+scaledFontGetFontOptions :: ScaledFont -> IO FontOptions+scaledFontGetFontOptions sf = do+ fo <- (fontOptionsCreate >>= scaledFontGetFontOptions' sf)+ fontOptionsStatus fo >>= failStatus+ return fo+ where {#fun scaled_font_get_font_options as scaledFontGetFontOptions' { `ScaledFont', `FontOptions' outFontOptions* } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-text-extents+{#fun scaled_font_text_extents as ^ { `ScaledFont', withUTF8String* `String', alloca- `TextExtents' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-font-matrix+{#fun scaled_font_get_font_matrix as ^ { `ScaledFont', alloca- `Matrix Double' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-ctm+{#fun scaled_font_get_ctm as ^ { `ScaledFont', alloca- `Matrix Double' peek* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-type+{#fun scaled_font_get_type as ^ { `ScaledFont' } -> `FontType'#}+#endif++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-reference-count+{#fun scaled_font_get_reference_count as ^ { `ScaledFont' } -> `Int'#}+#endif++#if CAIRO_CHECK_VERSION(1,8,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-text-to-glyphs+scaledFontTextToGlyphs :: ScaledFont+ -> X+ -> Y+ -> String+ -> IO ([Glyph], [TextCluster], TextClusterFlags)+scaledFontTextToGlyphs scaledFont x y utf8 =+ with nullPtr $ \gPtrPtr ->+ with nullPtr $ \tcPtrPtr ->+ bracket (do+ (s, numG, numTC, tcf) <- scaledFontTextToGlyphs' scaledFont x y utf8 (-1) gPtrPtr tcPtrPtr+ gPtr <- peek gPtrPtr+ tcPtr <- peek tcPtrPtr+ return (s, numG, numTC, tcf, gPtr, tcPtr))+ (\(s, _, _, _, gPtr, tcPtr) -> do+ glyphFree gPtr+ textClusterFree tcPtr+ failStatus s) (\(_, numG, numTC, tcf, gPtr, tcPtr) -> do+ glyphs <- peekArray numG gPtr+ tcs <- peekArray numTC tcPtr+ return (glyphs, tcs, tcf))+ where+ {#fun scaled_font_text_to_glyphs as scaledFontTextToGlyphs' { `ScaledFont', CDouble `X', CDouble `Y', withUTF8String* `String', `Int', id `Ptr GlyphPtr', alloca- `Int' peekInt*, id `Ptr TextClusterPtr', alloca- `Int' peekInt*, alloca- `TextClusterFlags' peekEnum* } -> `Status'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-get-scale-matrix+{#fun scaled_font_get_scale_matrix as ^ { `ScaledFont', alloca- `Matrix Double' peek* } -> `()'#}+#endif
+ src/Graphics/Cairo/HasStatus.hs view
@@ -0,0 +1,11 @@+module Graphics.Cairo.HasStatus where++import Control.Exception+import Control.Monad+import Graphics.Cairo.Types+import Graphics.Cairo.Utilities.ErrorHandling++class HasStatus a where+ status :: a -> IO Status+ use :: a -> (a -> IO b) -> IO b+ use a = bracket (return a) (failStatus <=< status)
+ src/Graphics/Cairo/Render.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE GADTs #-}+module Graphics.Cairo.Render where++import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Types++data Render m a where+ Render :: MonadIO m => ReaderT Context m a -> Render m a++instance (MonadIO m) => Functor (Render m) where+ fmap f (Render render) = Render $ fmap f render++instance (MonadIO m) => Applicative (Render m) where+ pure = Render . pure+ (<*>) (Render f) (Render a) = Render $ f <*> a++instance (MonadIO m) => Monad (Render m) where+ (>>=) (Render x) f = Render $ ReaderT $ \ r -> do+ a <- runReaderT x r+ let Render b' = f a+ runReaderT b' r++instance (MonadIO m) => MonadIO (Render m) where+ liftIO ioa = Render $ liftIO ioa++runRender :: (MonadIO m) => Context -> Render m a -> m a+runRender context (Render render) = runReaderT render context++with :: (MonadIO m, HasStatus t) =>+ t -> (t -> Render IO a) -> Render m a+with sth f = Render $ ReaderT $ \r -> liftIO $+ use sth (\s ->+ let (Render x) = f s+ in runReaderT x r)
+ src/Graphics/Cairo/Surfaces/Device.chs view
@@ -0,0 +1,56 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-device-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-cairo-device-t.description+-}+module Graphics.Cairo.Surfaces.Device where++{#import Graphics.Cairo.Types#}+import Control.Exception+import Control.Monad+import qualified Foreign.Ptr as C2HSImp+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++#if CAIRO_CHECK_VERSION(1,10,0)+instance HasStatus Device where+ status = deviceStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-status+{#fun device_status as ^ { `Device' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-finish+{#fun device_finish as ^ { `Device' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-flush+{#fun device_flush as ^ { `Device' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-get-type+{#fun device_get_type as ^ { `Device' } -> `DeviceType'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-get-reference-count+{#fun device_get_reference_count as ^ { `Device' } -> `Int'#}++{-|+λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-acquire+λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-release+-}+acquireDevice :: Device -> (Device -> IO c) -> IO c+acquireDevice d f =+ bracket (deviceAcquire d) (const (deviceRelease d) <=< failStatus) (const $ f d)+ where+ {#fun device_acquire as ^ { `Device' } -> `Status'#}+ {#fun device_release as ^ { `Device' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-elapsed+{#fun device_observer_elapsed as ^ { `Device' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-fill-elapsed+{#fun device_observer_fill_elapsed as ^ { `Device' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-glyphs-elapsed+{#fun device_observer_glyphs_elapsed as ^ { `Device' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-mask-elapsed+{#fun device_observer_mask_elapsed as ^ { `Device' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-paint-elapsed+{#fun device_observer_paint_elapsed as ^ { `Device' } -> `Double'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-observer-stroke-elapsed+{#fun device_observer_stroke_elapsed as ^ { `Device' } -> `Double'#}+#endif -- CAIRO_CHECK_VERSION(1,10,0)
+ src/Graphics/Cairo/Surfaces/Surface.chs view
@@ -0,0 +1,103 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-cairo-surface-t.description+-}+module Graphics.Cairo.Surfaces.Surface where++{#import Graphics.Cairo.Types#}+import Control.Exception+import Foreign.C.Types+import Foreign.Marshal.Alloc+import Graphics.Cairo.HasStatus+import Graphics.Cairo.Utilities.ErrorHandling++{#context lib="cairo" prefix="cairo"#}++instance HasStatus Surface where+ status = surfaceStatus++-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-create-similar+{#fun surface_create_similar as ^ { `Surface', `Content', fromIntegral `WidthInt', fromIntegral `HeightInt' } -> `Surface' outSurface*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-status+{#fun surface_status as ^ { `Surface' } -> `Status'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-finish+{#fun surface_finish as ^ { `Surface' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-flush+{#fun surface_flush as ^ { `Surface' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-font-options+{#fun surface_get_font_options as ^ { `Surface', `FontOptions'} -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-mark-dirty+{#fun surface_mark_dirty as ^ { `Surface' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-mark-dirty-rectangle+{#fun surface_mark_dirty_rectangle as ^ { `Surface', fromIntegral `XInt', fromIntegral `YInt', fromIntegral `WidthInt', fromIntegral `HeightInt' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-set-device-offset+{#fun surface_set_device_offset as ^ { `Surface', CDouble `XOffset', CDouble `YOffset' } -> `()'#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-content+{#fun surface_get_content as ^ { `Surface' } -> `Content'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-device-offset+{#fun surface_get_device_offset as ^ { `Surface', alloca- `XOffset' peekDouble*, alloca- `YOffset' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-set-fallback-resolution+{#fun surface_set_fallback_resolution as ^ { `Surface', CDouble `XResolution', CDouble `YResolution' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-type+{#fun surface_get_type as ^ { `Surface' } -> `SurfaceType'#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-reference-count+{#fun surface_get_reference_count as ^ { `Surface' } -> `Int'#}+#endif -- CAIRO_CHECK_VERSION(1,4,0)++#if CAIRO_CHECK_VERSION(1,6,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-copy-page+{#fun surface_copy_page as ^ { `Surface' } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-show-page+{#fun surface_show_page as ^ { `Surface' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,6,0)++#if CAIRO_CHECK_VERSION(1,8,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-has-show-text-glyphs+{#fun surface_has_show_text_glyphs as ^ { `Surface' } -> `Bool'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-fallback-resolution+{#fun surface_get_fallback_resolution as ^ { `Surface', alloca- `XResolution' peekDouble*, alloca- `YResolution' peekDouble* } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,8,0)++#if CAIRO_CHECK_VERSION(1,10,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-create-for-rectangle+{#fun surface_create_for_rectangle as ^ { `Surface', CDouble `X', CDouble `Y', CDouble `Width', CDouble `Height'} -> `Surface' outSurface*#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-device+{#fun surface_get_device as ^ { `Surface' } -> `Maybe Device' outMaybeDevice*#}+#endif -- CAIRO_CHECK_VERSION(1,10,0)++#if CAIRO_CHECK_VERSION(1,12,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-create-similar-image+{#fun surface_create_similar_image as ^ { `Surface', `Format', fromIntegral `WidthInt', fromIntegral `HeightInt' } -> `Surface' outSurface*#}++{-|+λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-map-to-image+λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-unmap-image+-}+useSurfaceMapImage :: Surface+ -> Maybe (Rectangle Int) -> (Surface -> IO c) -> IO c+useSurfaceMapImage s mr f =+ bracket (surfaceMapToImage s mr) (\ns -> do+ st <- surfaceStatus ns+ surfaceUnmapImage s ns+ failStatus st) f+ where+ {#fun surface_map_to_image as ^ { `Surface', withMaybe* `Maybe (Rectangle Int)' } -> `Surface' outSurface*#}+ {#fun surface_unmap_image as ^ { `Surface', `Surface' } -> `()'#}++-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-supports-mime-type+{#fun surface_supports_mime_type as ^ { `Surface', `String' } -> `Bool'#}+#endif -- CAIRO_CHECK_VERSION(1,12,0)++#if CAIRO_CHECK_VERSION(1,14,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-get-device-scale+{#fun surface_get_device_scale as ^ { `Surface', alloca- `XScale' peekDouble*, alloca- `YScale' peekDouble* } -> `()'#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-set-device-scale+{#fun surface_set_device_scale as ^ { `Surface', CDouble `XScale', CDouble `YScale' } -> `()'#}+#endif -- CAIRO_CHECK_VERSION(1,14,0)
+ src/Graphics/Cairo/Types.chs view
@@ -0,0 +1,535 @@+-- λ SKIP MODULE+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+#include "cairo-core.h"++module Graphics.Cairo.Types where++import Control.Monad+import Control.Monad.Extra+import Data.Foldable+import Data.Maybe+import Foreign+import Foreign.C+import qualified GHC.Foreign as GF (withCString)+import qualified GHC.IO.Encoding as GF (utf8)++{#context lib="cairo" prefix="cairo"#}++type Index = Int+type WidthInt = Int+type HeightInt = Int+type XInt = Int+type YInt = Int+type X = Double+type Y = Double+type Width = Double+type Height = Double+type Radius = Double+type Offset = Double+type XOffset = Double+type YOffset = Double+type XResolution = Double+type YResolution = Double+type XScale = Double+type YScale = Double+type Red = Double+type Green = Double+type Blue = Double+type Alpha = Double+type Angle = Double+type XX = Double+type YY = Double+type XY = Double+type YX = Double+type X0 = Double+type Y0 = Double+data Rectangle a = Rectangle { rectX :: a, rectY :: a+ , rectWidth :: a+ , rectHeight :: a }+ deriving (Show, Eq)+data Circle a = Circle { circleCenter :: Point a+ , circleRadius :: a }+ deriving (Show, Eq)+data Point a = Point { pointX :: a+ , pointY :: a }+ deriving (Show, Eq)+data Color a = ColorRGB { colorRed :: a+ , colorGreen :: a+ , colorBlue :: a }+ | ColorRGBA { colorARed :: a+ , colorAGreen :: a+ , colorABlue :: a+ , colorAlpha :: a }+ deriving (Show, Eq)+data Matrix a = Matrix { matrixXX :: a, matrixYX :: a+ , matrixXY :: a, matrixYY :: a+ , matrixX0 :: a, matrixY0 :: a }+ deriving (Show, Eq)+data Version = Version { verMajor :: Int+ , verMinor :: Int+ , verMicro :: Int }+ deriving (Eq)+instance Ord Version where+ compare (Version a1 a2 a3) (Version b1 b2 b3) =+ case compare a1 b1 of+ GT -> GT+ LT -> LT+ EQ -> case compare a2 b2 of+ GT -> GT+ LT -> LT+ EQ -> compare a3 b3++type SolidPattern = Pattern+type SurfacePattern = Pattern+type GradientPattern = Pattern+type LinearGradientPattern = GradientPattern+type RadialGradientPattern = GradientPattern+type Mesh = Pattern++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-t+{#pointer *t as Context foreign finalizer destroy newtype#}+outContext :: Ptr Context -> IO Context+outContext = fmap Context . newForeignPtr cairo_destroy++-- λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-font-face-t+{#pointer *font_face_t as FontFace foreign finalizer font_face_destroy newtype#}+outFontFace :: Ptr FontFace -> IO FontFace+outFontFace = fmap FontFace . newForeignPtr cairo_font_face_destroy+outFontFaceRef :: Ptr FontFace -> IO FontFace+outFontFaceRef = fmap FontFace . (newForeignPtr cairo_font_face_destroy <=< fontFaceReference)++-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-font-options-t+{#pointer *font_options_t as FontOptions foreign finalizer font_options_destroy newtype#}+outFontOptions :: Ptr FontOptions -> IO FontOptions+outFontOptions = fmap FontOptions . newForeignPtr cairo_font_options_destroy++-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-t+{#pointer *pattern_t as Pattern foreign finalizer pattern_destroy newtype#}+outPattern :: Ptr Pattern -> IO Pattern+outPattern = fmap Pattern . newForeignPtr cairo_pattern_destroy+outPatternRef :: Ptr Pattern -> IO Pattern+outPatternRef = fmap Pattern . (newForeignPtr cairo_pattern_destroy <=< patternReference)++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-scaled-font-t+{#pointer *scaled_font_t as ScaledFont foreign finalizer scaled_font_destroy newtype#}+outScaledFont :: Ptr ScaledFont -> IO ScaledFont+outScaledFont = fmap ScaledFont . newForeignPtr cairo_scaled_font_destroy+outScaledFontRef :: Ptr ScaledFont -> IO ScaledFont+outScaledFontRef = fmap ScaledFont . (newForeignPtr cairo_scaled_font_destroy <=< scaledFontReference)++-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-t+{#pointer *surface_t as Surface foreign finalizer surface_destroy newtype#}+outSurface :: Ptr Surface -> IO Surface+outSurface = fmap Surface . newForeignPtr cairo_surface_destroy+outSurfaceRef :: Ptr Surface -> IO Surface+outSurfaceRef = fmap Surface . (newForeignPtr cairo_surface_destroy <=< surfaceReference)+outSurfacePtrRef :: Ptr (Ptr Surface) -> IO Surface+outSurfacePtrRef pp = peek pp >>= outSurfaceRef++type UnionNum = Int+sizeOfDouble :: Int+sizeOfDouble = 8+sizeOfUnion :: Int+sizeOfUnion = 2 * sizeOfDouble+pathDataSizes :: [(PathDataType, (UnionNum, Int))]+pathDataSizes = [ (PathMoveTo, (2, 2 * sizeOfUnion))+ , (PathLineTo, (2, 2 * sizeOfUnion))+ , (PathCurveTo, (4, 4 * sizeOfUnion))+ , (PathClosePath, (1, sizeOfUnion)) ]+us :: PathDataType -> UnionNum+us t = fst $ fromJust $ lookup t pathDataSizes+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-path-data-t+{#pointer *path_data_t as PathDataPtr -> PathData#}+data PathData = PDMoveTo (Point Double)+ | PDLineTo (Point Double)+ | PDCurveTo (Point Double, Point Double, Point Double)+ | PDClosePath+instance Storable PathData where+ sizeOf PDClosePath = snd $ fromJust $ lookup PathClosePath pathDataSizes+ sizeOf (PDCurveTo _) = snd $ fromJust $ lookup PathCurveTo pathDataSizes+ sizeOf _ = snd $ fromJust $ lookup PathMoveTo pathDataSizes+ alignment _ = sizeOfUnion+ peek p = do+ pdType <- (toEnum . fromIntegral) <$> {#get path_data_t->header.type#} p+ let p' = plusPtr p sizeOfUnion+ case pdType of+ PathMoveTo -> do+ CDouble x <- {#get path_data_t->point.x#} p'+ CDouble y <- {#get path_data_t->point.y#} p'+ return $ PDMoveTo $ Point x y+ PathLineTo -> do+ CDouble x <- {#get path_data_t->point.x#} p'+ CDouble y <- {#get path_data_t->point.y#} p'+ return $ PDLineTo $ Point x y+ PathCurveTo -> do+ CDouble x0 <- {#get path_data_t->point.x#} p'+ CDouble y0 <- {#get path_data_t->point.y#} p'+ let p'' = plusPtr p' sizeOfUnion+ CDouble x1 <- {#get path_data_t->point.x#} p''+ CDouble y1 <- {#get path_data_t->point.y#} p''+ let p''' = plusPtr p'' sizeOfUnion+ CDouble x2 <- {#get path_data_t->point.x#} p'''+ CDouble y2 <- {#get path_data_t->point.y#} p'''+ return $ PDCurveTo (Point x0 y0, Point x1 y1, Point x2 y2)+ PathClosePath -> return PDClosePath+ poke p (PDMoveTo (Point x y)) = do+ {#set path_data_t->header.type#} p $ fromIntegral $ fromEnum PathMoveTo+ {#set path_data_t->header.length#} p $ fromIntegral $ us PathMoveTo+ let p' = plusPtr p sizeOfUnion+ {#set path_data_t->point.x#} p' $ CDouble x+ {#set path_data_t->point.y#} p' $ CDouble y+ poke p (PDLineTo (Point x y)) = do+ {#set path_data_t->header.type#} p $ fromIntegral $ fromEnum PathLineTo+ {#set path_data_t->header.length#} p $ fromIntegral $ us PathLineTo+ let p' = plusPtr p sizeOfUnion+ {#set path_data_t->point.x#} p' $ CDouble x+ {#set path_data_t->point.y#} p' $ CDouble y+ poke p (PDCurveTo (Point x0 y0, Point x1 y1, Point x2 y2)) = do+ {#set path_data_t->header.type#} p $ fromIntegral $ fromEnum PathCurveTo+ {#set path_data_t->header.length#} p $ fromIntegral $ us PathCurveTo+ let p' = plusPtr p sizeOfUnion+ {#set path_data_t->point.x#} p' $ CDouble x0+ {#set path_data_t->point.y#} p' $ CDouble y0+ let p'' = plusPtr p' sizeOfUnion+ {#set path_data_t->point.x#} p'' $ CDouble x1+ {#set path_data_t->point.y#} p'' $ CDouble y1+ let p''' = plusPtr p'' sizeOfUnion+ {#set path_data_t->point.x#} p''' $ CDouble x2+ {#set path_data_t->point.y#} p''' $ CDouble y2+ poke p PDClosePath = do+ {#set path_data_t->header.type#} p $ fromIntegral $ fromEnum PathClosePath+ {#set path_data_t->header.length#} p $ fromIntegral $ us PathClosePath++-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-path-t+{#pointer *path_t as PathPtr -> Path#}+data Path = Path { pathStatus :: Status+ , pathData :: [PathData] }+instance Storable Path where+ sizeOf _ = {#sizeof path_t#}+ alignment _ = {#alignof path_t#}+ peek p = do+ s <- (toEnum . fromIntegral) <$> {#get path_t->status#} p+ p' <- {#get path_t->data#} p+ c <- fromIntegral <$> {#get path_t->num_data#} p+ (Path s) <$> unfoldM (\(pdPtr, cnt) -> do+ if (cnt >= c)+ then return Nothing+ else do+ pd <- peek pdPtr+ case pd of+ PDMoveTo _ -> return $ Just (pd, (plusPtr pdPtr $ sizeOf pd, cnt + (us PathMoveTo)))+ PDLineTo _ -> return $ Just (pd, (plusPtr pdPtr $ sizeOf pd, cnt + (us PathLineTo)))+ PDCurveTo _ -> return $ Just (pd, (plusPtr pdPtr $ sizeOf pd, cnt + (us PathCurveTo)))+ PDClosePath -> return $ Just (pd, (plusPtr pdPtr $ sizeOf pd, cnt + (us PathClosePath)))) (p', 0)+ poke p (Path s pds)= do+ {#set path_t->status#} p $ fromIntegral $ fromEnum s+ let len = sum $ map sizeOf pds+ pdPtr <- mallocArray len+ _ <- foldlM (\p' pd -> do+ poke p' pd+ return $ plusPtr p' $ sizeOf pd) pdPtr pds+ {#set path_t->data#} p pdPtr+ {#set path_t->num_data#} p $ fromIntegral len++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-font-extents-t+{#pointer *font_extents_t as FontExtentsPtr -> FontExtents#}+data FontExtents = FontExtents { feAscent :: Double+ , feDescent :: Double+ , feHeight :: Height+ , feMaxXadvance :: Double+ , feMaxYadvance :: Double }+instance Storable FontExtents where+ sizeOf _ = {#sizeof font_extents_t#}+ alignment _ = {#alignof font_extents_t#}+ peek p = do+ CDouble ascent <- {#get font_extents_t->ascent#} p+ CDouble descent <- {#get font_extents_t->descent#} p+ CDouble height <- {#get font_extents_t->height#} p+ CDouble maxXa <- {#get font_extents_t->max_x_advance#} p+ CDouble maxYa <- {#get font_extents_t->max_y_advance#} p+ return $ FontExtents ascent descent height maxXa maxYa+ poke p (FontExtents ascent descent height maxXa maxYa) = do+ {#set font_extents_t->ascent#} p (CDouble ascent)+ {#set font_extents_t->descent#} p (CDouble descent)+ {#set font_extents_t->height#} p (CDouble height)+ {#set font_extents_t->max_x_advance#} p (CDouble maxXa)+ {#set font_extents_t->max_y_advance#} p (CDouble maxYa)++-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-glyph-t+{#pointer *glyph_t as GlyphPtr -> Glyph#}+data Glyph = Glyph { glyphIndex :: Index+ , glyphX :: X+ , glyphY :: Y }+instance Storable Glyph where+ sizeOf _ = {#sizeof glyph_t#}+ alignment _ = {#alignof glyph_t#}+ peek p = do+ i <- {#get glyph_t->index#} p+ CDouble x <- {#get glyph_t->x#} p+ CDouble y <- {#get glyph_t->y#} p+ return $ Glyph (fromIntegral i) x y+ poke p (Glyph i x y) = do+ {#set glyph_t->index#} p (fromIntegral i)+ {#set glyph_t->x#} p (CDouble x)+ {#set glyph_t->y#} p (CDouble y)++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-t+{#pointer *matrix_t as MatrixPtr -> Matrix Double#}+instance Storable (Matrix Double) where+ sizeOf _ = {#sizeof matrix_t#}+ alignment _ = {#alignof matrix_t#}+ peek p = do+ CDouble xx <- {#get matrix_t->xx#} p+ CDouble yx <- {#get matrix_t->yx#} p+ CDouble xy <- {#get matrix_t->xy#} p+ CDouble yy <- {#get matrix_t->yy#} p+ CDouble x0 <- {#get matrix_t->x0#} p+ CDouble y0 <- {#get matrix_t->y0#} p+ return $ Matrix xx yx xy yy x0 y0+ poke p (Matrix xx yx xy yy x0 y0)= do+ {#set matrix_t->xx#} p (CDouble xx)+ {#set matrix_t->yx#} p (CDouble yx)+ {#set matrix_t->xy#} p (CDouble xy)+ {#set matrix_t->yy#} p (CDouble yy)+ {#set matrix_t->x0#} p (CDouble x0)+ {#set matrix_t->y0#} p (CDouble y0)+instance Functor Matrix where+ fmap f (Matrix xx yx xy yy x0 y0) = Matrix (f xx) (f yx) (f xy) (f yy) (f x0) (f y0)+instance Num (Matrix Double) 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')+ (+) (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') =+ Matrix (xx + xx') (yx + yx') (xy + xy') (yy + yy') (x0 + x0') (y0 + y0')+ (-) (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') =+ Matrix (xx - xx') (yx - yx') (xy - xy') (yy - yy') (x0 - x0') (y0 - y0')+ abs = fmap abs+ signum = fmap signum+ fromInteger n = Matrix (fromInteger n) 0 0 (fromInteger n) 0 0++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-rectangle-t+{#pointer *rectangle_t as RectanglePtr -> Rectangle Double#}+instance Storable (Rectangle Double) where+ sizeOf _ = {#sizeof rectangle_t#}+ alignment _ = {#alignof rectangle_t#}+ peek p = do+ CDouble x <- {#get rectangle_t->x#} p+ CDouble y <- {#get rectangle_t->y#} p+ CDouble width <- {#get rectangle_t->width#} p+ CDouble height <- {#get rectangle_t->height#} p+ return $ Rectangle x y width height+ poke p (Rectangle x y w h) = do+ {#set rectangle_t->x#} p (CDouble x)+ {#set rectangle_t->y#} p (CDouble y)+ {#set rectangle_t->width#} p (CDouble w)+ {#set rectangle_t->height#} p (CDouble h)++-- λ https://www.cairographics.org/manual/cairo-cairo-scaled-font-t.html#cairo-text-extents-t+{#pointer *text_extents_t as TextExtentsPtr -> TextExtents#}+data TextExtents = TextExtents { teXbearing :: Double+ , teYbearing :: Double+ , teWidth :: Width+ , teHeight :: Height+ , teXadvance :: Double+ , teYadvance :: Double }+instance Storable TextExtents where+ sizeOf _ = {#sizeof text_extents_t#}+ alignment _ = {#alignof text_extents_t#}+ peek p = do+ CDouble xb <- {#get text_extents_t->x_bearing#} p+ CDouble yb <- {#get text_extents_t->y_bearing#} p+ CDouble w <- {#get text_extents_t->width#} p+ CDouble h <- {#get text_extents_t->height#} p+ CDouble xa <- {#get text_extents_t->x_advance#} p+ CDouble ya <- {#get text_extents_t->y_advance#} p+ return $ TextExtents xb yb w h xa ya+ poke p (TextExtents xb yb w h xa ya) = do+ {#set text_extents_t->x_bearing#} p (CDouble xb)+ {#set text_extents_t->y_bearing#} p (CDouble yb)+ {#set text_extents_t->width#} p (CDouble w)+ {#set text_extents_t->height#} p (CDouble h)+ {#set text_extents_t->x_advance#} p (CDouble xa)+ {#set text_extents_t->y_advance#} p (CDouble ya)++#if CAIRO_CHECK_VERSION(1,4,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-rectangle-list-t+data RectangleList a = RectangleList { rlStatus :: Status+ , rlRectangles :: [Rectangle a] }+ deriving (Show, Eq)+{#pointer *rectangle_list_t as RectangleListPtr -> RectangleList Double#}+instance Storable (RectangleList Double) where+ sizeOf _ = {#sizeof rectangle_list_t#}+ alignment _ = {#alignof rectangle_list_t#}+ peek p = do+ s <- {#get rectangle_list_t->status#} p+ r <- {#get rectangle_list_t->rectangles#} p+ n <- {#get rectangle_list_t->num_rectangles#} p+ peekArray (fromIntegral n) r >>=+ return . RectangleList (toEnum $ fromIntegral s)+ poke p (RectangleList s rs)=+ withArrayLen rs $ \len ptr' -> do+ {#set rectangle_list_t->status#} p (fromIntegral $ fromEnum s)+ {#set rectangle_list_t->rectangles#} p ptr'+ {#set rectangle_list_t->num_rectangles#} p (fromIntegral len)+#endif -- CAIRO_CHECK_VERSION(1,4,0)++#if CAIRO_CHECK_VERSION(1,8,0)+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-text-cluster-t+data TextCluster = TextCluster { textClusterNumBytes :: Int+ , textClusterNumGlyphs :: Int }+ deriving (Show, Eq)+{#pointer *text_cluster_t as TextClusterPtr -> TextCluster#}+instance Storable TextCluster where+ sizeOf _ = {#sizeof text_cluster_t#}+ alignment _ = {#alignof text_cluster_t#}+ peek p = do+ b <- {#get text_cluster_t->num_bytes#} p+ g <- {#get text_cluster_t->num_glyphs#} p+ return $ TextCluster (fromIntegral b) (fromIntegral g)+ poke p (TextCluster b g)= do+ {#set text_cluster_t->num_bytes#} p (fromIntegral b)+ {#set text_cluster_t->num_glyphs#} p (fromIntegral g)+#endif -- CAIRO_CHECK_VERSION(1,8,0)++#if CAIRO_CHECK_VERSION(1,10,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-t+{#pointer *device_t as Device foreign finalizer device_destroy newtype#}+outDevice :: Ptr Device -> IO Device+outDevice = fmap Device . newForeignPtr cairo_device_destroy+outMaybeDevice :: Ptr Device -> IO (Maybe Device)+outMaybeDevice p = if p == nullPtr+ then return Nothing+ else Just <$> outDevice p++-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-t+{#pointer *region_t as Region foreign finalizer region_destroy newtype#}+outRegion :: Ptr Region -> IO Region+outRegion = fmap Region . newForeignPtr cairo_region_destroy++-- λ https://www.cairographics.org/manual/cairo-Types.html#cairo-rectangle-int-t+{#pointer *rectangle_int_t as RectangleIntPtr -> Rectangle Int#}+instance Storable (Rectangle Int) where+ sizeOf _ = {#sizeof rectangle_int_t#}+ alignment _ = {#alignof rectangle_int_t#}+ 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 $ Rectangle (fromIntegral x)+ (fromIntegral y)+ (fromIntegral width)+ (fromIntegral height)+ poke p (Rectangle x y w h) = do+ {#set rectangle_int_t->x#} p (fromIntegral x)+ {#set rectangle_int_t->y#} p (fromIntegral y)+ {#set rectangle_int_t->width#} p (fromIntegral w)+ {#set rectangle_int_t->height#} p (fromIntegral h)+#endif -- CAIRO_CHECK_VERSION(1,10,0)++-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-antialias-t+{#enum antialias_t as Antialias {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-surface-t.html#cairo-content-t+{#enum content_t as Content {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-extend-t+{#enum extend_t as Extend {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-fill-rule-t+{#enum fill_rule_t as FillRule {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-filter-t+{#enum filter_t as Filter {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-font-slant-t+{#enum font_slant_t as FontSlant {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-text.html#cairo-font-weight-t+{#enum font_weight_t as FontWeight {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-Image-Surfaces.html#cairo-format-t+{#enum format_t as Format {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-hint-metrics-t+{#enum hint_metrics_t as HintMetrics {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-hint-style-t+{#enum hint_style_t as HintStyle {underscoreToCase}#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-line-cap-t+{#enum line_cap_t as LineCap {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-line-join-t+{#enum line_join_t as LineJoin {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-t.html#cairo-operator-t+{#enum operator_t as Operator {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-Paths.html#cairo-path-data-type-t+{#enum path_data_type_t as PathDataType {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-font-options-t.html#cairo-subpixel-order-t+{#enum subpixel_order_t as SubpixelOrder {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-Error-handling.html#cairo-status-t+{#enum status_t as Status {underscoreToCase} deriving(Eq, Show)#}++#if CAIRO_CHECK_VERSION(1,2,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-font-face-t.html#cairo-font-type-t+{#enum font_type_t as FontType {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-cairo-pattern-t.html#cairo-pattern-type-t+{#enum pattern_type_t as PatternType {underscoreToCase} deriving(Eq, Show)#}+-- λ https://cairographics.org/manual/cairo-cairo-surface-t.html#cairo-surface-type-t+{#enum surface_type_t as SurfaceType {underscoreToCase} deriving(Eq, Show)#}+#endif -- CAIRO_CHECK_VERSION(1,2,0)++#if CAIRO_CHECK_VERSION(1,8,0)+-- λ https://cairographics.org/manual/cairo-text.html#cairo-text-cluster-flags-t+{#enum text_cluster_flags_t as TextClusterFlags {underscoreToCase} deriving(Eq, Show)#}+#endif -- CAIRO_CHECK_VERSION(1,8,0)++#if CAIRO_CHECK_VERSION(1,10,0)+-- λ https://www.cairographics.org/manual/cairo-cairo-device-t.html#cairo-device-type-t+{#enum device_type_t as DeviceType {underscoreToCase} deriving(Eq, Show)#}+-- λ https://www.cairographics.org/manual/cairo-Regions.html#cairo-region-overlap-t+{#enum region_overlap_t as RegionOverlap {underscoreToCase} deriving(Eq, Show)#}+#endif -- CAIRO_CHECK_VERSION(1,10,0)++#if CAIRO_CHECK_VERSION(1,12,0)+data MeshPointNum = MP0+ | MP1+ | MP2+ | MP3+ deriving (Show, Eq, Enum)+data MeshCornerNum = MC0+ | MC1+ | MC2+ | MC3+ deriving (Show, Eq, Enum)+#endif -- CAIRO_CHECK_VERSION(1,12,0)++-- Marshallers++cFromEnum :: (Enum a, Integral b) => a -> b+cFromEnum = fromIntegral . fromEnum++peekEnum :: (Storable a, Integral a, Enum b) => Ptr a -> IO b+peekEnum = fmap toEnum . peekInt++peekInt :: (Storable a, Integral a) => Ptr a -> IO Int+peekInt = fmap fromIntegral . peek++peekDouble :: Ptr CDouble -> IO Double+peekDouble = fmap (\(CDouble x) -> x) . peek++withDouble :: Double -> (Ptr CDouble -> IO b) -> IO b+withDouble = with . CDouble++withUTF8String :: String -> (CString -> IO a) -> IO a+withUTF8String = GF.withCString GF.utf8++withMaybe :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b+withMaybe m f = case m of+ Nothing -> f nullPtr+ Just p -> with p f++-- Referencer++{#fun reference as ^ { id `Ptr Context' } -> `Ptr Context' return*#}+{#fun pattern_reference as ^ { id `Ptr Pattern' } -> `Ptr Pattern' return*#}+{#fun region_reference as ^ { id `Ptr Region' } -> `Ptr Region' return*#}+{#fun font_face_reference as ^ { id `Ptr FontFace' } -> `Ptr FontFace' return*#}+{#fun scaled_font_reference as ^ { id `Ptr ScaledFont' } -> `Ptr ScaledFont' return*#}+{#fun device_reference as ^ { id `Ptr Device' } -> `Ptr Device' return*#}+{#fun surface_reference as ^ { id `Ptr Surface' } -> `Ptr Surface' return*#}
+ src/Graphics/Cairo/Utilities/ErrorHandling.chs view
@@ -0,0 +1,22 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Error-handling.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Error-handling.html#cairo-Error-handling.description+-}+module Graphics.Cairo.Utilities.ErrorHandling where++{#import Graphics.Cairo.Types#}+import Control.Monad++{#context lib="cairo" prefix="cairo"#}++-- λ https://www.cairographics.org/manual/cairo-Error-handling.html#cairo-status-to-string+{#fun status_to_string as ^ { `Status' } -> `String'#}+-- λ https://www.cairographics.org/manual/cairo-Error-handling.html#cairo-debug-reset-static-data+{#fun debug_reset_static_data as ^ {} -> `()'#}++failStatus :: Status -> IO ()+failStatus s = when (s /= StatusSuccess) $ statusToString s >>= fail+failStatusRaw :: (Integral a) => a -> IO ()+failStatusRaw = failStatus . toEnum . fromIntegral
+ src/Graphics/Cairo/Utilities/Matrix.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleInstances #-}+{-|+Description : λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-cairo-matrix-t.description+-}+module Graphics.Cairo.Utilities.Matrix where++import Graphics.Cairo.Types++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-init+matrixInit :: a -> a -> a -> a -> a -> a -> Matrix a+matrixInit = Matrix++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-init-identity+matrixInitIdentity :: Matrix Double+matrixInitIdentity = Matrix 1 0 0 1 0 0++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-init-translate+matrixInitTranslate :: X0 -> Y0 -> Matrix Double+matrixInitTranslate = Matrix 1 0 0 1++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-init-scale+matrixInitScale :: XX -> YY -> Matrix Double+matrixInitScale sx sy = Matrix sx 0 0 sy 0 0++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-init-rotate+matrixInitRotate :: Radius -> Matrix Double+matrixInitRotate radians = Matrix c s (-s) c 0 0+ where s = sin radians+ c = cos radians++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-translate+matrixTranslate :: X0 -> Y0 -> Matrix Double -> Matrix Double+matrixTranslate tx ty m = m * matrixInitTranslate tx ty++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-scale+matrixScale :: XX -> YY -> Matrix Double -> Matrix Double+matrixScale sx sy m = m * matrixInitScale sx sy++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-rotate+matrixRotate :: Radius -> Matrix Double -> Matrix Double+matrixRotate radians m = m * matrixInitRotate radians++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-invert+matrixInvert :: Matrix Double -> Maybe (Matrix Double)+matrixInvert (Matrix 0 0 0 _ _ _) = Nothing+matrixInvert (Matrix _ 0 0 0 _ _) = Nothing+matrixInvert (Matrix xx 0 0 yy x0 y0) =+ let (xx', x0') = if xx /= 1+ then (recip xx, -x0 * recip xx)+ else (xx, -x0)+ (yy', y0') = if yy /= 1+ then (recip yy, -y0 * recip yy)+ else (yy, -y0)+ in Just $ Matrix xx' 0 0 yy' x0' y0'+matrixInvert matrix+ | determinant matrix == 0 = Nothing+ | otherwise = Just $ scalarMultiply (adjoint matrix) (recip $ determinant matrix)+ where+ determinant (Matrix xx' yx' xy' yy' _ _) = xx' * yy' - yx' * xy'+ adjoint (Matrix xx' yx' xy' yy' x0' y0') = Matrix yy' (-yx') (-xy') xx' (xy' * y0' - yy' * x0') (yx' * x0' - xx' * y0')+ scalarMultiply matrix' scalar = fmap (scalar *) matrix'++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-multiply+matrixMultiply :: Matrix Double -> Matrix Double -> Matrix Double+matrixMultiply = (*)++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-transform-distance+matrixTransformDistance :: Matrix Double -> (X, Y) -> (X, Y)+matrixTransformDistance (Matrix xx yx xy yy _ _) (x, y) =+ (xx * x + xy * y, yx * x + yy * y)++-- λ https://www.cairographics.org/manual/cairo-cairo-matrix-t.html#cairo-matrix-transform-point+matrixTransformPoint :: Matrix Double -> (X, Y) -> (X, Y)+matrixTransformPoint matrix@(Matrix _ _ _ _ x0 y0) pd =+ let (x, y) = matrixTransformDistance matrix pd+ in (x + x0, y + y0)
+ src/Graphics/Cairo/Utilities/VersionInformation.chs view
@@ -0,0 +1,22 @@+#include "cairo-core.h"+{-|+Description : λ https://www.cairographics.org/manual/cairo-Version-Information.html //div[@class="refnamediv"]/table/tr/td/p/text()++λ https://www.cairographics.org/manual/cairo-Version-Information.html#cairo-Version-Information.description+-}+module Graphics.Cairo.Utilities.VersionInformation where++import Graphics.Cairo.Types++{#context lib="cairo" prefix="cairo"#}++-- λ https://www.cairographics.org/manual/cairo-Version-Information.html#cairo-version+{#fun pure version as versionNumber {} -> `Int'#}+-- λ https://www.cairographics.org/manual/cairo-Version-Information.html#cairo-version-string+{#fun pure version_string as ^ {} -> `String'#}++instance Show Version where+ show _ = versionString++version :: Version+version = Version {#const CAIRO_VERSION_MAJOR#} {#const CAIRO_VERSION_MINOR#} {#const CAIRO_VERSION_MICRO#}