packages feed

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 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#}