simple-pango (empty) → 0.1.0.1
raw patch · 43 files changed
+4461/−0 lines, 43 filesdep +arraydep +basedep +bytestringsetup-changed
Dependencies added: array, base, bytestring, c-enum, c-struct, containers, glib-stopgap, primitive, simple-cairo, simple-pango, template-haskell, text, union-angle, union-color
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- csrc/pango_log_attr.c +20/−0
- include/pango_log_attr.h +23/−0
- simple-pango.cabal +115/−0
- src/Data/Font/VariationAxis.hs +26/−0
- src/Data/Font/VariationAxis/Internal.hs +70/−0
- src/Data/Text/CString.hs +14/−0
- src/Data/Text/Foreign/StringPartial.hs +23/−0
- src/Foreign/C/String/ForeignCStringLen.hs +26/−0
- src/Foreign/C/String/Misc.hs +22/−0
- src/Foreign/C/String/Utf8.hs +25/−0
- src/Foreign/Ptr/Misc.hs +9/−0
- src/Graphics/Pango/Basic/BidirectionalText.hsc +92/−0
- src/Graphics/Pango/Basic/Fonts/PangoFontDescription.hsc +398/−0
- src/Graphics/Pango/Basic/Fonts/PangoFontDescription/Type.hs +74/−0
- src/Graphics/Pango/Basic/Fonts/PangoFontDescription/Variations.hs +67/−0
- src/Graphics/Pango/Basic/GlyphStorage.hsc +36/−0
- src/Graphics/Pango/Basic/GlyphStorage/Internal.hsc +172/−0
- src/Graphics/Pango/Basic/GlyphStorage/PangoMatrix.hs +29/−0
- src/Graphics/Pango/Basic/GlyphStorage/PangoMatrix/Internal.hsc +188/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayout.hs +75/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayout/Internal.hsc +883/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutIter.hs +27/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutIter/Internal.hsc +196/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutLine.hsc +16/−0
- src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutLine/Internal.hsc +117/−0
- src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoLanguage.hs +13/−0
- src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoLanguage/Internal.hsc +103/−0
- src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript.hsc +9/−0
- src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript/Enum.hsc +141/−0
- src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript/Internal.hsc +95/−0
- src/Graphics/Pango/Basic/TextAttributes.hs +59/−0
- src/Graphics/Pango/Basic/TextAttributes/Internal.hsc +650/−0
- src/Graphics/Pango/Basic/VerticalText.hsc +91/−0
- src/Graphics/Pango/LowLevel/Contexts.hs +7/−0
- src/Graphics/Pango/LowLevel/Contexts/Internal.hsc +91/−0
- src/Graphics/Pango/LowLevel/TabStops.hs +21/−0
- src/Graphics/Pango/LowLevel/TabStops/Internal.hsc +241/−0
- src/Graphics/Pango/Rendering/Cairo.hsc +159/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for simple-pango++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Yoshikuni Jujo (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Yoshikuni Jujo nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# simple-pango
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ csrc/pango_log_attr.c view
@@ -0,0 +1,20 @@+#include <pango/pango.h>+#include "pango_log_attr.h"++void+pango_log_attr_to_struct(PangoLogAttr *src, PangoLogAttrStr *dst)+{+ dst->is_line_break = src->is_line_break;+ dst->is_mandatory_break = src->is_mandatory_break;+ dst->is_char_break = src->is_char_break;+ dst->is_white = src->is_white;+ dst->is_cursor_position = src->is_cursor_position;+ dst->is_word_start = src->is_word_start;+ dst->is_word_end = src->is_word_end;+ dst->is_sentence_boundary = src->is_sentence_boundary;+ dst->is_sentence_start = src->is_sentence_end;+ dst->is_sentence_end = src->is_sentence_end;+ dst->backspace_deletes_character = src->backspace_deletes_character;+ dst->is_expandable_space = src->is_expandable_space;+ dst->is_word_boundary = src->is_word_boundary;+}
+ include/pango_log_attr.h view
@@ -0,0 +1,23 @@+#ifndef _PANGO_LOG_ATTR_H+#define _PANGO_LOG_ATTR_H++#include <pango/pango.h>++typedef struct {+ guint is_line_break;+ guint is_mandatory_break;+ guint is_char_break;+ guint is_white;+ guint is_cursor_position;+ guint is_word_start;+ guint is_word_end;+ guint is_sentence_boundary;+ guint is_sentence_start;+ guint is_sentence_end;+ guint backspace_deletes_character;+ guint is_expandable_space;+ guint is_word_boundary;+ } PangoLogAttrStr;++#endif+
+ simple-pango.cabal view
@@ -0,0 +1,115 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name: simple-pango+version: 0.1.0.1+synopsis: Binding to Pango library+description: Please see the README on GitHub at <https://github.com/githubuser/simple-pango#readme>+category: Graphics+homepage: https://github.com/githubuser/simple-pango#readme+bug-reports: https://github.com/githubuser/simple-pango/issues+author: Author name here+maintainer: example@example.com+copyright: 2021 Author name here+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ include/pango_log_attr.h++source-repository head+ type: git+ location: https://github.com/githubuser/simple-pango++library+ exposed-modules:+ Data.Font.VariationAxis+ Data.Font.VariationAxis.Internal+ Data.Text.CString+ Data.Text.Foreign.StringPartial+ Foreign.C.String.ForeignCStringLen+ Foreign.C.String.Misc+ Foreign.C.String.Utf8+ Foreign.Ptr.Misc+ Graphics.Pango.Basic.BidirectionalText+ Graphics.Pango.Basic.Fonts.PangoFontDescription+ Graphics.Pango.Basic.Fonts.PangoFontDescription.Type+ Graphics.Pango.Basic.Fonts.PangoFontDescription.Variations+ Graphics.Pango.Basic.GlyphStorage+ Graphics.Pango.Basic.GlyphStorage.Internal+ Graphics.Pango.Basic.GlyphStorage.PangoMatrix+ Graphics.Pango.Basic.GlyphStorage.PangoMatrix.Internal+ Graphics.Pango.Basic.LayoutObjects.PangoLayout+ Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal+ Graphics.Pango.Basic.LayoutObjects.PangoLayoutIter+ Graphics.Pango.Basic.LayoutObjects.PangoLayoutIter.Internal+ Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine+ Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine.Internal+ Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage+ Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage.Internal+ Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript+ Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum+ Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Internal+ Graphics.Pango.Basic.TextAttributes+ Graphics.Pango.Basic.TextAttributes.Internal+ Graphics.Pango.Basic.VerticalText+ Graphics.Pango.LowLevel.Contexts+ Graphics.Pango.LowLevel.Contexts.Internal+ Graphics.Pango.LowLevel.TabStops+ Graphics.Pango.LowLevel.TabStops.Internal+ Graphics.Pango.Rendering.Cairo+ other-modules:+ Paths_simple_pango+ hs-source-dirs:+ src+ include-dirs:+ include+ c-sources:+ csrc/pango_log_attr.c+ pkgconfig-depends:+ pangocairo+ build-depends:+ array+ , base >=4.7 && <5+ , bytestring+ , c-enum+ , c-struct+ , containers+ , glib-stopgap+ , primitive+ , simple-cairo+ , template-haskell+ , text+ , union-angle+ , union-color+ default-language: Haskell2010++test-suite simple-pango-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_simple_pango+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ array+ , base >=4.7 && <5+ , bytestring+ , c-enum+ , c-struct+ , containers+ , glib-stopgap+ , primitive+ , simple-cairo+ , simple-pango+ , template-haskell+ , text+ , union-angle+ , union-color+ default-language: Haskell2010
+ src/Data/Font/VariationAxis.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.Font.VariationAxis (+ -- * AXIS CLASS+ FontDescriptionAxis,+ -- * ADD AXIS+ fontDescriptionAddAxis,+ -- * SET AND GET AXIS+ Variations, variationsEmpty, variationsSetAxis, variationsGetAxis,+ -- * SHOW AND READ VARIATIONS+ showVariations, readVariations,+ -- * DEFAULT AXES+ Weight(..), Width(..), Slant(..), Italic(..), OpticalSize(..)+ ) where++import Data.Font.VariationAxis.Internal++fontDescriptionAddAxis "Weight" "wght"+fontDescriptionAddAxis "Width" "wdth"+fontDescriptionAddAxis "Italic" "ital"+fontDescriptionAddAxis "OpticalSize" "opsz"+fontDescriptionAddAxis "Slant" "slnt"
+ src/Data/Font/VariationAxis/Internal.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.Font.VariationAxis.Internal (+ -- * AXIS CLASS+ FontDescriptionAxis,+ -- * ADD AXIS+ fontDescriptionAddAxis,+ -- * SET AND GET AXIS+ Variations, variationsEmpty, variationsSetAxis, variationsGetAxis,+ -- * SHOW AND READ VARIATIONS+ showVariations, readVariations ) where++import Control.Arrow++import qualified Data.Map as M+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC++import Language.Haskell.TH++class FontDescriptionAxis a where+ fontDescriptionAxisTag :: BS.ByteString+ fontDescriptionAxisToDouble :: a -> Double+ fontDescriptionAxisFromDouble :: Double -> a++newtype Variations = Variations { getVariations :: M.Map BS.ByteString Double }+ deriving Show++variationsEmpty :: Variations+variationsEmpty = Variations M.empty++fontDescriptionAddAxis :: String -> String -> DecsQ+fontDescriptionAddAxis a t = (\n i -> [n, i])+ <$> fontDescriptionAddAxisNewtype a+ <*> fontDescriptionAddAxisInstance a t++fontDescriptionAddAxisNewtype :: String -> DecQ+fontDescriptionAddAxisNewtype a =+ newtypeD (cxt [])+ (mkName a) [] Nothing (recC (mkName a) [+ varBangType (mkName $ "get" ++ a)+ $ bangType (bang noSourceUnpackedness noSourceStrictness) (conT ''Double) ])+ [derivClause Nothing [conT ''Show]]++fontDescriptionAddAxisInstance :: String -> String -> DecQ+fontDescriptionAddAxisInstance a t = instanceD (cxt []) (conT ''FontDescriptionAxis `appT` conT (mkName a)) [+ valD (varP 'fontDescriptionAxisTag) (normalB . litE $ StringL t) [],+ valD (varP 'fontDescriptionAxisToDouble) (normalB . varE . mkName $ "get" ++ a) [],+ valD (varP 'fontDescriptionAxisFromDouble) (normalB . conE $ mkName a) []+ ]++showVariations :: Variations -> BS.ByteString+showVariations = BS.intercalate "," . ((\(a, v) -> a <> "=" <> v) . (id *** BSC.pack . show) <$>) . M.toList . getVariations++readVariations :: BS.ByteString -> Variations+readVariations = Variations . M.fromList . ((\[a, v] -> (a, read $ BSC.unpack v)) . BSC.split '=' <$>) . BSC.split ','++variationsSetAxis :: forall a . FontDescriptionAxis a => a -> Variations -> Variations+variationsSetAxis a = Variations . M.insert+ (fontDescriptionAxisTag @a)+ (fontDescriptionAxisToDouble a) . getVariations++variationsGetAxis ::+ forall a . FontDescriptionAxis a => Variations -> Maybe a+variationsGetAxis (Variations as) = fontDescriptionAxisFromDouble+ <$> M.lookup (fontDescriptionAxisTag @a) as
+ src/Data/Text/CString.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE LambdaCase, TupleSections #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.Text.CString (peekCStringText) where++import Foreign.C.String+import Foreign.C.String.Misc+import Control.Monad++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++peekCStringText :: CString -> IO T.Text+peekCStringText = T.peekCStringLen <=< toCStringLen
+ src/Data/Text/Foreign/StringPartial.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Data.Text.Foreign.StringPartial (+ CStringPart, emptyOrCStringPart, peekCStringPart, withCStringPart+ ) where++import Foreign.Ptr+import Foreign.C.Types++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++type CStringPart = (Ptr CChar, Ptr CChar)++emptyOrCStringPart :: a -> a -> CStringPart -> a+emptyOrCStringPart d f (s, e) | s == e = d | otherwise = f++peekCStringPart :: CStringPart -> IO T.Text+peekCStringPart (s, e) = T.peekCStringLen (s, e `minusPtr` s)++withCStringPart :: T.Text -> (CStringPart -> IO a) -> IO a+withCStringPart t f = T.withCStringLen t \(p, l) -> f (p, p `plusPtr` l)
+ src/Foreign/C/String/ForeignCStringLen.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE LambdaCase, TupleSections #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Foreign.C.String.ForeignCStringLen (+ ForeignCStringLen, copyToForeignCStringLen, withForeignCStringLen+ ) where++import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.C.String+import Foreign.C.Types++type ForeignCStringLen = (ForeignPtr CChar, Int)++copyToForeignCStringLen :: CStringLen -> IO ForeignCStringLen+copyToForeignCStringLen (cs, n) = do+ p <- mallocBytes n+ copyBytes p cs n+ newForeignCStringLen (p, n) (free p)++newForeignCStringLen :: CStringLen -> IO () -> IO ForeignCStringLen+newForeignCStringLen (p, l) fr = (, l) <$> newForeignPtr p fr++withForeignCStringLen :: ForeignCStringLen -> (CStringLen -> IO a) -> IO a+withForeignCStringLen (fp, l) f = withForeignPtr fp $ f . (, l)
+ src/Foreign/C/String/Misc.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE LambdaCase, TupleSections #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Foreign.C.String.Misc (toCStringLen, copyCString) where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.String++toCStringLen :: CString -> IO CStringLen+toCStringLen cs = (cs ,) <$> cStringLength cs++cStringLength :: CString -> IO Int+cStringLength p = peek p >>= \case+ 0 -> pure 0+ _ -> (+ 1) <$> cStringLength (p `plusPtr` 1)++copyCString :: CString -> Int -> IO CString+copyCString cs n = do+ cs' <- mallocBytes n+ cs' <$ copyBytes cs' cs n
+ src/Foreign/C/String/Utf8.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Foreign.C.String.Utf8 (byteIndices) where++import Foreign.Ptr+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Data.Bits++byteIndices :: CStringLen -> IO [Int]+byteIndices = ((0 :) <$>) . go+ where+ go (_, n) | n <= 0 = pure []+ go (p, n) = do+ d <- byteToLen <$> peek p+ (d :) . ((+ d) <$>) <$> go (p `plusPtr` d, n - d)++byteToLen :: Num n => CChar -> n+byteToLen c+ | c .&. 0x80 == 0 = 1+ | c .&. 0xe0 == 0xc0 = 2+ | c .&. 0xf0 == 0xe0 = 3+ | c .&. 0xf8 == 0xf0 = 4+ | otherwise = error "Invalid UTF-8"
+ src/Foreign/Ptr/Misc.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Foreign.Ptr.Misc (pattern NullPtr) where++import Foreign.Ptr++pattern NullPtr :: Ptr a+pattern NullPtr <- ((== nullPtr) -> True) where NullPtr = nullPtr
+ src/Graphics/Pango/Basic/BidirectionalText.hsc view
@@ -0,0 +1,92 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.BidirectionalText (+ -- * ENUM+ -- ** PangoDirection+ PangoDirection,+ pattern PangoDirectionLtr, pattern PangoDirectionRtl,+ pattern PangoDirectionTtbLtr, pattern PangoDirectionTtbRtl,+ pattern PangoDirectionWeakLtr, pattern PangoDirectionWeakRtl,+ pattern PangoDirectionNeutral,++ -- ** PangoBidiType+ PangoBidiType,+ pattern PangoBidiTypeL, pattern PangoBidiTypeLre,+ pattern PangoBidiTypeLro, pattern PangoBidiTypeR,+ pattern PangoBidiTypeAl, pattern PangoBidiTypeRle,+ pattern PangoBidiTypeRlo, pattern PangoBidiTypePdf,+ pattern PangoBidiTypeEn, pattern PangoBidiTypeEs,+ pattern PangoBidiTypeEt, pattern PangoBidiTypeAn,+ pattern PangoBidiTypeCs, pattern PangoBidiTypeNsm,+ pattern PangoBidiTypeBn, pattern PangoBidiTypeB,+ pattern PangoBidiTypeS, pattern PangoBidiTypeWs,+ pattern PangoBidiTypeOn,++ -- * FUNCTION+ pangoUnicharDirection, pangoFindBaseDir, pangoBidiTypeForUnichar ) where++import Foreign.C.Types+import Foreign.C.String+import Foreign.C.Enum+import Data.Word+import Data.Char+import System.IO.Unsafe++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++#include <pango/pango.h>++enum "PangoDirection" ''#{type PangoDirection} [''Show, ''Read] [+ ("PangoDirectionLtr", #{const PANGO_DIRECTION_LTR}),+ ("PangoDirectionRtl", #{const PANGO_DIRECTION_RTL}),+ ("PangoDirectionTtbLtr", #{const PANGO_DIRECTION_TTB_LTR}),+ ("PangoDirectionTtbRtl", #{const PANGO_DIRECTION_TTB_RTL}),+ ("PangoDirectionWeakLtr", #{const PANGO_DIRECTION_WEAK_LTR}),+ ("PangoDirectionWeakRtl", #{const PANGO_DIRECTION_WEAK_RTL}),+ ("PangoDirectionNeutral", #{const PANGO_DIRECTION_NEUTRAL}) ]++enum "PangoBidiType" ''#{type PangoBidiType} [''Show, ''Read] [+ ("PangoBidiTypeL", #{const PANGO_BIDI_TYPE_L}),+ ("PangoBidiTypeLre", #{const PANGO_BIDI_TYPE_LRE}),+ ("PangoBidiTypeLro", #{const PANGO_BIDI_TYPE_LRO}),+ ("PangoBidiTypeR", #{const PANGO_BIDI_TYPE_R}),+ ("PangoBidiTypeAl", #{const PANGO_BIDI_TYPE_AL}),+ ("PangoBidiTypeRle", #{const PANGO_BIDI_TYPE_RLE}),+ ("PangoBidiTypeRlo", #{const PANGO_BIDI_TYPE_RLO}),+ ("PangoBidiTypePdf", #{const PANGO_BIDI_TYPE_PDF}),+ ("PangoBidiTypeEn", #{const PANGO_BIDI_TYPE_EN}),+ ("PangoBidiTypeEs", #{const PANGO_BIDI_TYPE_ES}),+ ("PangoBidiTypeEt", #{const PANGO_BIDI_TYPE_ET}),+ ("PangoBidiTypeAn", #{const PANGO_BIDI_TYPE_AN}),+ ("PangoBidiTypeCs", #{const PANGO_BIDI_TYPE_CS}),+ ("PangoBidiTypeNsm", #{const PANGO_BIDI_TYPE_NSM}),+ ("PangoBidiTypeBn", #{const PANGO_BIDI_TYPE_BN}),+ ("PangoBidiTypeB", #{const PANGO_BIDI_TYPE_B}),+ ("PangoBidiTypeS", #{const PANGO_BIDI_TYPE_S}),+ ("PangoBidiTypeWs", #{const PANGO_BIDI_TYPE_WS}),+ ("PangoBidiTypeOn", #{const PANGO_BIDI_TYPE_ON}) ]++pangoUnicharDirection :: Char -> PangoDirection+pangoUnicharDirection =+ unsafePerformIO . c_pango_unichar_direction . fromIntegral . ord++foreign import ccall "pango_unichar_direction" c_pango_unichar_direction ::+ #{type gunichar} -> IO PangoDirection++pangoFindBaseDir :: T.Text -> PangoDirection+pangoFindBaseDir t = unsafePerformIO+ $ T.withCStringLen t \(cs, l) -> c_pango_find_base_dir cs $ fromIntegral l++foreign import ccall "pango_find_base_dir" c_pango_find_base_dir ::+ CString -> CInt -> IO PangoDirection++pangoBidiTypeForUnichar :: Char -> PangoBidiType+pangoBidiTypeForUnichar =+ unsafePerformIO . c_pango_bidi_type_for_unichar . fromIntegral . ord++foreign import ccall "pango_bidi_type_for_unichar"+ c_pango_bidi_type_for_unichar :: #{type gunichar} -> IO PangoBidiType
+ src/Graphics/Pango/Basic/Fonts/PangoFontDescription.hsc view
@@ -0,0 +1,398 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.Fonts.PangoFontDescription (+ -- * TYPE+ -- ** PangoFontDescription+ PangoFontDescription,++ -- ** PangoFontDescriptionNullable+ PangoFontDescriptionNullable,+ pangoFontDescriptionFromNullable, pangoFontDescriptionToNullable,++ -- ** PangoFontDescriptionPrim+ PangoFontDescriptionPrim,+ PangoFontDescriptionST, PangoFontDescriptionIO,+ pangoFontDescriptionFreeze, pangoFontDescriptionThaw,+ pangoFontDescriptionCopy,++ -- * FUNCTION+ pangoFontDescriptionNew,+ PangoFontDescriptionSetting,+ pangoFontDescriptionSet, pangoFontDescriptionGet,+ pangoFontDescriptionUnset,+ pangoFontDescriptionMerge, pangoFontDescriptionBetterMatch,+ pangoFontDescriptionToString, pangoFontDescriptionToFilename,++ -- * SETTING+ -- ** Family+ Family(..),++ -- ** Style+ PangoStyle(..),+ pattern PangoStyleNormal, pattern PangoStyleOblique,+ pattern PangoStyleItalic,++ -- ** Variant+ PangoVariant(..),+ pattern PangoVariantNormal, pattern PangoVariantSmallCaps,++ -- ** Weight+ PangoWeight(..),+ pattern PangoWeightThin, pattern PangoWeightUltralight,+ pattern PangoWeightLight, pattern PangoWeightSemilight,+ pattern PangoWeightBook, pattern PangoWeightNormal,+ pattern PangoWeightMedium, pattern PangoWeightSemibold,+ pattern PangoWeightBold, pattern PangoWeightUltrabold,+ pattern PangoWeightHeavy, pattern PangoWeightUltraheavy,++ -- ** Stretch+ PangoStretch(..),+ pattern PangoStretchUltraCondensed, pattern PangoStretchExtraCondensed,+ pattern PangoStretchCondensed, pattern PangoStretchSemiCondensed,+ pattern PangoStretchNormal, pattern PangoStretchSemiExpanded,+ pattern PangoStretchExpanded, pattern PangoStretchExtraExpanded,+ pattern PangoStretchUltraExpanded,++ -- ** Size+ Size(..)++ ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr, addForeignPtrFinalizer)+import Foreign.C.Types+import Foreign.C.String+import Foreign.C.Enum+import Control.Monad.Primitive+import Data.Bits+import Data.Bool+import Data.Word+import Data.Int++import System.GLib.Bool+import Graphics.Pango.Basic.Fonts.PangoFontDescription.Type+import Graphics.Pango.Basic.VerticalText++import System.IO.Unsafe++#include <pango/pango.h>++enum "PangoFontMask" ''#{type PangoFontMask} [''Show] [+ ("PangoFontMaskFamily", #{const PANGO_FONT_MASK_FAMILY}),+ ("PangoFontMaskStyle", #{const PANGO_FONT_MASK_STYLE}),+ ("PangoFontMaskVariant", #{const PANGO_FONT_MASK_VARIANT}),+ ("PangoFontMaskWeight", #{const PANGO_FONT_MASK_WEIGHT}),+ ("PangoFontMaskStretch", #{const PANGO_FONT_MASK_STRETCH}),+ ("PangoFontMaskSize", #{const PANGO_FONT_MASK_SIZE}),+ ("PangoFontMaskGravity", #{const PANGO_FONT_MASK_GRAVITY}),+ ("PangoFontMaskVariations", #{const PANGO_FONT_MASK_VARIATIONS}) ]++pangoFontDescriptionNew ::+ PrimMonad m => m (PangoFontDescriptionPrim (PrimState m))+pangoFontDescriptionNew = unsafeIOToPrim+ $ mkPangoFontDescriptionPrim =<< c_pango_font_description_new++foreign import ccall "pango_font_description_new"+ c_pango_font_description_new :: IO (Ptr PangoFontDescription)++class PangoFontDescriptionSetting s where+ pangoFontDescriptionSet :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> s -> m ()+ pangoFontDescriptionGetUnsafe :: PangoFontDescription -> s+ pangoFontDescriptionMaskBit :: PangoFontMask++pangoFontDescriptionGet :: forall s . PangoFontDescriptionSetting s =>+ PangoFontDescription -> Maybe s+pangoFontDescriptionGet = \case+ fd -> let+ PangoFontMask fm = pangoFontDescriptionGetSetFields fd+ PangoFontMask mb = pangoFontDescriptionMaskBit @s in+ bool Nothing (Just $ pangoFontDescriptionGetUnsafe fd) $ fm .&. mb /= zeroBits++pangoFontDescriptionGetSetFields :: PangoFontDescription -> PangoFontMask+pangoFontDescriptionGetSetFields (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ PangoFontMask <$> c_pango_font_description_get_set_fields pfd++foreign import ccall "pango_font_description_get_set_fields"+ c_pango_font_description_get_set_fields ::+ Ptr PangoFontDescription -> IO #type PangoFontMask++pangoFontDescriptionUnset :: forall s m . (PangoFontDescriptionSetting s, PrimMonad m) =>+ PangoFontDescriptionPrim (PrimState m) -> m ()+pangoFontDescriptionUnset fd = pangoFontDescriptionUnsetFields fd (pangoFontDescriptionMaskBit @s)++pangoFontDescriptionUnsetFields :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoFontMask -> m ()+pangoFontDescriptionUnsetFields (PangoFontDescriptionPrim fpfd) (PangoFontMask msk) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd ->+ c_pango_font_description_unset_fields pfd msk++foreign import ccall "pango_font_description_unset_fields"+ c_pango_font_description_unset_fields ::+ Ptr PangoFontDescription -> #{type PangoFontMask} -> IO ()++newtype Family = Family String deriving Show++instance PangoFontDescriptionSetting Family where+ pangoFontDescriptionSet fd (Family f) = pangoFontDescriptionSetFamily fd f+ pangoFontDescriptionGetUnsafe fd = Family $ pangoFontDescriptionGetFamily fd+ pangoFontDescriptionMaskBit = PangoFontMaskFamily++pangoFontDescriptionSetFamily :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> String -> m ()+pangoFontDescriptionSetFamily (PangoFontDescriptionPrim fpfd) f = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd -> withCString f \cf ->+ c_pango_font_description_set_family pfd cf++foreign import ccall "pango_font_description_set_family" c_pango_font_description_set_family ::+ Ptr PangoFontDescription -> CString -> IO ()++pangoFontDescriptionGetFamily :: PangoFontDescription -> String+pangoFontDescriptionGetFamily (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ peekCString =<< c_pango_font_description_get_family pfd++foreign import ccall "pango_font_description_get_family" c_pango_font_description_get_family ::+ Ptr PangoFontDescription -> IO CString++enum "PangoStyle" ''#{type PangoStyle} [''Show] [+ ("PangoStyleNormal", #{const PANGO_STYLE_NORMAL}),+ ("PangoStyleOblique", #{const PANGO_STYLE_OBLIQUE}),+ ("PangoStyleItalic", #{const PANGO_STYLE_ITALIC}) ]++instance PangoFontDescriptionSetting PangoStyle where+ pangoFontDescriptionSet = pangoFontDescriptionSetStyle+ pangoFontDescriptionGetUnsafe = pangoFontDescriptionGetStyle+ pangoFontDescriptionMaskBit = PangoFontMaskStyle++pangoFontDescriptionSetStyle :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoStyle -> m ()+pangoFontDescriptionSetStyle (PangoFontDescriptionPrim fpfd) (PangoStyle s) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd -> c_pango_font_description_set_style pfd s++foreign import ccall "pango_font_description_set_style" c_pango_font_description_set_style ::+ Ptr PangoFontDescription -> #{type PangoStyle} -> IO ()++pangoFontDescriptionGetStyle :: PangoFontDescription -> PangoStyle+pangoFontDescriptionGetStyle (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd -> PangoStyle <$> c_pango_font_description_get_style pfd++foreign import ccall "pango_font_description_get_style" c_pango_font_description_get_style ::+ Ptr PangoFontDescription -> IO #type PangoStyle++enum "PangoVariant" ''#{type PangoVariant} [''Show] [+ ("PangoVariantNormal", #{const PANGO_VARIANT_NORMAL}),+ ("PangoVariantSmallCaps", #{const PANGO_VARIANT_SMALL_CAPS}) ]++instance PangoFontDescriptionSetting PangoVariant where+ pangoFontDescriptionSet = pangoFontDescriptionSetVariant+ pangoFontDescriptionGetUnsafe = pangoFontDescriptionGetVariant+ pangoFontDescriptionMaskBit = PangoFontMaskVariant++pangoFontDescriptionSetVariant :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoVariant -> m ()+pangoFontDescriptionSetVariant (PangoFontDescriptionPrim fpfd) (PangoVariant pv) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd -> c_pango_font_description_set_variant pfd pv++foreign import ccall "pango_font_description_set_variant" c_pango_font_description_set_variant ::+ Ptr PangoFontDescription -> #{type PangoVariant} -> IO ()++pangoFontDescriptionGetVariant :: PangoFontDescription -> PangoVariant+pangoFontDescriptionGetVariant (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ PangoVariant <$> c_pango_font_description_get_variant pfd++foreign import ccall "pango_font_description_get_variant" c_pango_font_description_get_variant ::+ Ptr PangoFontDescription -> IO #type PangoVariant++enum "PangoWeight" ''#{type PangoWeight} [''Show] [+ ("PangoWeightThin", #{const PANGO_WEIGHT_THIN}),+ ("PangoWeightUltralight", #{const PANGO_WEIGHT_ULTRALIGHT}),+ ("PangoWeightLight", #{const PANGO_WEIGHT_LIGHT}),+ ("PangoWeightSemilight", #{const PANGO_WEIGHT_SEMILIGHT}),+ ("PangoWeightBook", #{const PANGO_WEIGHT_BOOK}),+ ("PangoWeightNormal", #{const PANGO_WEIGHT_NORMAL}),+ ("PangoWeightMedium", #{const PANGO_WEIGHT_MEDIUM}),+ ("PangoWeightSemibold", #{const PANGO_WEIGHT_SEMIBOLD}),+ ("PangoWeightBold", #{const PANGO_WEIGHT_BOLD}),+ ("PangoWeightUltrabold", #{const PANGO_WEIGHT_ULTRABOLD}),+ ("PangoWeightHeavy", #{const PANGO_WEIGHT_HEAVY}),+ ("PangoWeightUltraheavy", #{const PANGO_WEIGHT_ULTRAHEAVY}) ]++instance PangoFontDescriptionSetting PangoWeight where+ pangoFontDescriptionSet = pangoFontDescriptionSetWeight+ pangoFontDescriptionGetUnsafe = pangoFontDescriptionGetWeight+ pangoFontDescriptionMaskBit = PangoFontMaskWeight++pangoFontDescriptionSetWeight :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoWeight -> m ()+pangoFontDescriptionSetWeight (PangoFontDescriptionPrim fpfd) (PangoWeight wt) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd -> c_pango_font_description_set_weight pfd wt++foreign import ccall "pango_font_description_set_weight" c_pango_font_description_set_weight ::+ Ptr PangoFontDescription -> #{type PangoWeight} -> IO ()++pangoFontDescriptionGetWeight :: PangoFontDescription -> PangoWeight+pangoFontDescriptionGetWeight (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ PangoWeight <$> c_pango_font_description_get_weight pfd++foreign import ccall "pango_font_description_get_weight" c_pango_font_description_get_weight ::+ Ptr PangoFontDescription -> IO #type PangoWeight++enum "PangoStretch" ''#{type PangoStretch} [''Show] [+ ("PangoStretchUltraCondensed", #{const PANGO_STRETCH_ULTRA_CONDENSED}),+ ("PangoStretchExtraCondensed", #{const PANGO_STRETCH_EXTRA_CONDENSED}),+ ("PangoStretchCondensed", #{const PANGO_STRETCH_CONDENSED}),+ ("PangoStretchSemiCondensed", #{const PANGO_STRETCH_SEMI_CONDENSED}),+ ("PangoStretchNormal", #{const PANGO_STRETCH_NORMAL}),+ ("PangoStretchSemiExpanded", #{const PANGO_STRETCH_SEMI_EXPANDED}),+ ("PangoStretchExpanded", #{const PANGO_STRETCH_EXPANDED}),+ ("PangoStretchExtraExpanded", #{const PANGO_STRETCH_EXTRA_EXPANDED}),+ ("PangoStretchUltraExpanded", #{const PANGO_STRETCH_ULTRA_EXPANDED}) ]++instance PangoFontDescriptionSetting PangoStretch where+ pangoFontDescriptionSet = pangoFontDescriptionSetStretch+ pangoFontDescriptionGetUnsafe = pangoFontDescriptionGetStretch+ pangoFontDescriptionMaskBit = PangoFontMaskStretch++pangoFontDescriptionSetStretch :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoStretch -> m ()+pangoFontDescriptionSetStretch (PangoFontDescriptionPrim fpfd) (PangoStretch ps) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd -> c_pango_font_description_set_stretch pfd ps++foreign import ccall "pango_font_description_set_stretch" c_pango_font_description_set_stretch ::+ Ptr PangoFontDescription -> #{type PangoStretch} -> IO ()++pangoFontDescriptionGetStretch :: PangoFontDescription -> PangoStretch+pangoFontDescriptionGetStretch (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd -> PangoStretch <$> c_pango_font_description_get_stretch pfd++foreign import ccall "pango_font_description_get_stretch" c_pango_font_description_get_stretch ::+ Ptr PangoFontDescription -> IO #type PangoStretch++data Size = Size CDouble | AbsoluteSize CDouble deriving Show++instance PangoFontDescriptionSetting Size where+ pangoFontDescriptionSet fd = \case+ Size s -> pangoFontDescriptionSetSize fd . round $ s * #{const PANGO_SCALE}+ AbsoluteSize as -> pangoFontDescriptionSetAbsoluteSize fd $ as * #{const PANGO_SCALE}+ pangoFontDescriptionGetUnsafe fd =+ let a = pangoFontDescriptionGetSizeIsAbsolute fd+ s = pangoFontDescriptionGetSize fd in+ bool (Size $ fromIntegral s / #{const PANGO_SCALE}) (AbsoluteSize $ fromIntegral s / #{const PANGO_SCALE}) a+ pangoFontDescriptionMaskBit = PangoFontMaskSize++pangoFontDescriptionSetSize :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> CInt -> m ()+pangoFontDescriptionSetSize (PangoFontDescriptionPrim fpfd) n = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd ->+ c_pango_font_description_set_size pfd n++foreign import ccall "pango_font_description_set_size" c_pango_font_description_set_size ::+ Ptr PangoFontDescription -> CInt -> IO ()++pangoFontDescriptionGetSize :: PangoFontDescription -> CInt+pangoFontDescriptionGetSize (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd c_pango_font_description_get_size++foreign import ccall "pango_font_description_get_size" c_pango_font_description_get_size ::+ Ptr PangoFontDescription -> IO CInt++pangoFontDescriptionSetAbsoluteSize :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> CDouble -> m ()+pangoFontDescriptionSetAbsoluteSize (PangoFontDescriptionPrim fpfd) sz = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd ->+ c_pango_font_description_set_absolute_size pfd sz++foreign import ccall "pango_font_description_set_absolute_size" c_pango_font_description_set_absolute_size ::+ Ptr PangoFontDescription -> CDouble -> IO ()++pangoFontDescriptionGetSizeIsAbsolute :: PangoFontDescription -> Bool+pangoFontDescriptionGetSizeIsAbsolute (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ gbooleanToBool <$> c_pango_font_description_get_size_is_absolute pfd++foreign import ccall "pango_font_description_get_size_is_absolute"+ c_pango_font_description_get_size_is_absolute ::+ Ptr PangoFontDescription -> IO #type gboolean++instance PangoFontDescriptionSetting PangoGravity where+ pangoFontDescriptionSet = pangoFontDescriptionSetGravity+ pangoFontDescriptionGetUnsafe = pangoFontDescriptionGetGravity+ pangoFontDescriptionMaskBit = PangoFontMaskGravity++pangoFontDescriptionSetGravity :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> PangoGravity -> m ()+pangoFontDescriptionSetGravity (PangoFontDescriptionPrim fpfd) (PangoGravity gr) = unsafeIOToPrim+ $ withForeignPtr fpfd \pfd ->+ c_pango_font_description_set_gravity pfd gr++foreign import ccall "pango_font_description_set_gravity"+ c_pango_font_description_set_gravity ::+ Ptr PangoFontDescription -> #{type PangoGravity} -> IO ()++pangoFontDescriptionGetGravity :: PangoFontDescription -> PangoGravity+pangoFontDescriptionGetGravity (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ PangoGravity <$> c_pango_font_description_get_gravity pfd++foreign import ccall "pango_font_description_get_gravity"+ c_pango_font_description_get_gravity ::+ Ptr PangoFontDescription -> IO #type PangoGravity++pangoFontDescriptionMerge :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) ->+ PangoFontDescriptionPrim (PrimState m) -> Bool -> m ()+pangoFontDescriptionMerge (PangoFontDescriptionPrim fdsc)+ (PangoFontDescriptionPrim fdsctm) re = unsafeIOToPrim+ $ withForeignPtr fdsc \pdsc -> withForeignPtr fdsctm \pdsctm ->+ c_pango_font_description_merge pdsc pdsctm $ boolToGboolean re++foreign import ccall "pango_font_description_merge"+ c_pango_font_description_merge ::+ Ptr PangoFontDescription -> Ptr PangoFontDescription -> #{type gboolean} -> IO ()++pangoFontDescriptionBetterMatch :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) ->+ Maybe (PangoFontDescriptionPrim (PrimState m)) ->+ PangoFontDescriptionPrim (PrimState m) -> m Bool+pangoFontDescriptionBetterMatch+ (PangoFontDescriptionPrim fdsc) mom (PangoFontDescriptionPrim fnm) = unsafeIOToPrim+ $ gbooleanToBool <$> withForeignPtr fdsc \pdsc -> withMaybePangoFontDescriptionPrim mom \pom -> withForeignPtr fnm \pnm ->+ c_pango_font_description_better_match pdsc pom pnm++withMaybePangoFontDescriptionPrim ::+ Maybe (PangoFontDescriptionPrim s) -> (Ptr PangoFontDescription -> IO a) -> IO a+withMaybePangoFontDescriptionPrim = \case+ Nothing -> ($ nullPtr)+ Just (PangoFontDescriptionPrim ffd) -> withForeignPtr ffd++foreign import ccall "pango_font_description_better_match"+ c_pango_font_description_better_match ::+ Ptr PangoFontDescription -> Ptr PangoFontDescription ->+ Ptr PangoFontDescription -> IO #{type gboolean}++pangoFontDescriptionToString :: PangoFontDescription -> String+pangoFontDescriptionToString (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ peekCString =<< c_pango_font_description_to_string pfd++foreign import ccall "pango_font_description_to_string"+ c_pango_font_description_to_string ::+ Ptr PangoFontDescription -> IO CString++pangoFontDescriptionToFilename :: PangoFontDescription -> String+pangoFontDescriptionToFilename (PangoFontDescription_ fpfd) = unsafePerformIO+ $ withForeignPtr fpfd \pfd ->+ peekCString =<< c_pango_font_description_to_filename pfd++foreign import ccall "pango_font_description_to_filename"+ c_pango_font_description_to_filename ::+ Ptr PangoFontDescription -> IO CString
+ src/Graphics/Pango/Basic/Fonts/PangoFontDescription/Type.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.Fonts.PangoFontDescription.Type (+ -- * PANGO FONT DESCRIPTION+ PangoFontDescription(..), mkPangoFontDescription,++ -- * PANGO FONT DESCRIPTION NULLABLE+ PangoFontDescriptionNullable(..),+ mkPangoFontDescriptionNullable,+ pangoFontDescriptionFromNullable, pangoFontDescriptionToNullable,++ -- * PANGO FONT DESCRIPTION FOR PRIMITIVE MONAD+ PangoFontDescriptionPrim(..),+ mkPangoFontDescriptionPrim,+ PangoFontDescriptionST, PangoFontDescriptionIO,+ pangoFontDescriptionFreeze, pangoFontDescriptionThaw,+ pangoFontDescriptionCopy+ ) where++import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr, addForeignPtrFinalizer)+import Foreign.Concurrent+import Foreign.C.Struct++data PangoFontDescription+ = PangoFontDescription_ (ForeignPtr PangoFontDescription)+ deriving Show++mkPangoFontDescription :: Ptr PangoFontDescription -> IO PangoFontDescription+mkPangoFontDescription = \case+ NullPtr -> error "bad"+ p -> PangoFontDescription_+ <$> newForeignPtr p (c_pango_font_description_free p)++data PangoFontDescriptionNullable+ = PangoFontDescriptionNull+ | PangoFontDescriptionNotNull (ForeignPtr PangoFontDescription)+ deriving Show++mkPangoFontDescriptionNullable :: Ptr PangoFontDescription -> IO PangoFontDescriptionNullable+mkPangoFontDescriptionNullable = \case+ NullPtr -> pure PangoFontDescriptionNull+ p -> PangoFontDescriptionNotNull+ <$> newForeignPtr p (c_pango_font_description_free p)++pangoFontDescriptionToNullable :: Maybe PangoFontDescription -> PangoFontDescriptionNullable+pangoFontDescriptionToNullable Nothing = PangoFontDescriptionNull+pangoFontDescriptionToNullable (Just (PangoFontDescription_ f)) =+ PangoFontDescriptionNotNull f++pangoFontDescriptionFromNullable :: PangoFontDescriptionNullable -> Maybe PangoFontDescription+pangoFontDescriptionFromNullable PangoFontDescriptionNull = Nothing+pangoFontDescriptionFromNullable (PangoFontDescriptionNotNull f) =+ Just $ PangoFontDescription_ f++foreign import ccall "pango_font_description_copy"+ c_pango_font_description_copy ::+ Ptr PangoFontDescription -> IO (Ptr PangoFontDescription)++foreign import ccall "pango_font_description_free"+ c_pango_font_description_free :: Ptr PangoFontDescription -> IO ()++structPrim "PangoFontDescription"+ 'c_pango_font_description_copy 'c_pango_font_description_free [''Show]++mkPangoFontDescriptionPrim ::+ Ptr PangoFontDescription -> IO (PangoFontDescriptionPrim s)+mkPangoFontDescriptionPrim p = PangoFontDescriptionPrim+ <$> newForeignPtr p (c_pango_font_description_free p)
+ src/Graphics/Pango/Basic/Fonts/PangoFontDescription/Variations.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.Fonts.PangoFontDescription.Variations (+ -- * SET AND GET AXIS+ pangoFontDescriptionSetAxis, pangoFontDescriptionGetAxis,+ -- * SET AND GET VARIATIONS+ Variations,+ pangoFontDescriptionSetVariationsMap,+ pangoFontDescriptionGetVariationsMap,+ -- * DEFAULT AXES+ Weight(..), Width(..), Slant(..), Italic(..), OpticalSize(..)+ ) where++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.String+import Control.Monad.Primitive++import Graphics.Pango.Basic.Fonts.PangoFontDescription.Type++import qualified Data.ByteString as BS++import System.IO.Unsafe++import Data.Font.VariationAxis++pangoFontDescriptionSetAxis :: forall a m .+ (FontDescriptionAxis a, PrimMonad m) =>+ PangoFontDescriptionPrim (PrimState m) -> a -> m ()+pangoFontDescriptionSetAxis fd a = do+ as <- pangoFontDescriptionGetVariationsMap fd+ pangoFontDescriptionSetVariationsMap fd $ variationsSetAxis a as++pangoFontDescriptionGetAxis ::+ forall a . FontDescriptionAxis a => PangoFontDescription -> Maybe a+pangoFontDescriptionGetAxis fd = unsafePerformIO do+ pangoFontDescriptionThaw fd >>= \case+ fd' -> do+ as <- pangoFontDescriptionGetVariationsMap fd'+ pure $ variationsGetAxis as++pangoFontDescriptionSetVariationsMap :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> Variations -> m ()+pangoFontDescriptionSetVariationsMap (PangoFontDescriptionPrim ffd) v = unsafeIOToPrim+ $ withForeignPtr ffd \pfd -> BS.useAsCString (showVariations v) \cv ->+ c_pango_font_description_set_variations pfd cv++foreign import ccall "pango_font_description_set_variations"+ c_pango_font_description_set_variations ::+ Ptr PangoFontDescription -> CString -> IO ()++pangoFontDescriptionGetVariationsMap :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> m Variations+pangoFontDescriptionGetVariationsMap (PangoFontDescriptionPrim ffd) = unsafeIOToPrim+ $ withForeignPtr ffd \pfd -> readVariations <$>+ (myPackCString =<< c_pango_font_description_get_variations pfd)++myPackCString :: CString -> IO BS.ByteString+myPackCString cs | cs == nullPtr = pure "" | otherwise = BS.packCString cs++foreign import ccall "pango_font_description_get_variations"+ c_pango_font_description_get_variations ::+ Ptr PangoFontDescription -> IO CString
+ src/Graphics/Pango/Basic/GlyphStorage.hsc view
@@ -0,0 +1,36 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.GlyphStorage (+ -- * PANGO FIXED+ PangoFixed, PU, fromCInt, toCInt,++ -- * PANGO RECTANGLE AND EXTENTS+ -- ** PangoRectangleFixed+ PangoRectangleFixed,+ pattern PangoRectangleFixed,+ pangoRectangleFixedX, pangoRectangleFixedY,+ pangoRectangleFixedWidth, pangoRectangleFixedHeight,++ PangoRectangleFixedPrim, PangoRectangleFixedST, PangoRectangleFixedIO,+ pangoRectangleFixedFreeze, pangoRectangleFixedThaw, pangoRectangleFixedCopy,++ -- ** PangoRectanglePixel+ PangoRectanglePixel,+ pattern PangoRectanglePixel,+ pangoRectanglePixelX, pangoRectanglePixelY,+ pangoRectanglePixelWidth, pangoRectanglePixelHeight,++ PangoRectanglePixelPrim,+ PangoRectanglePixelST, PangoRectanglePixelIO,+ pangoRectanglePixelFreeze, pangoRectanglePixelThaw,+ pangoRectanglePixelCopy,++ -- ** Extents and PixelExtents+ Extents(..), PixelExtents(..),++ -- * PANGO GLYPH ITEM+ PangoGlyphItem, PangoLayoutRun,+ ) where++import Graphics.Pango.Basic.GlyphStorage.Internal
+ src/Graphics/Pango/Basic/GlyphStorage/Internal.hsc view
@@ -0,0 +1,172 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.GlyphStorage.Internal (+ -- * PANGO FIXED+ PangoFixed, PU, fromCInt, toCInt,++ -- * PANGO RECTANGLE AND EXTENTS+ -- ** PangoRectangleFixed+ PangoRectangleFixed(..),+ pattern PangoRectangleFixed,+ pangoRectangleFixedX, pangoRectangleFixedY,+ pangoRectangleFixedWidth, pangoRectangleFixedHeight,++ PangoRectangleFixedPrim(..), PangoRectangleFixedST, PangoRectangleFixedIO,+ pangoRectangleFixedFreeze, pangoRectangleFixedThaw, pangoRectangleFixedCopy,++ -- ** PangoRectanglePixel+ PangoRectanglePixel(..),+ pattern PangoRectanglePixel,+ pangoRectanglePixelX, pangoRectanglePixelY,+ pangoRectanglePixelWidth, pangoRectanglePixelHeight,++ PangoRectanglePixelPrim(..),+ PangoRectanglePixelST, PangoRectanglePixelIO,+ pangoRectanglePixelFreeze, pangoRectanglePixelThaw,+ pangoRectanglePixelCopy,++ -- ** Extents and PixelExtents+ Extents(..), PixelExtents(..),+ pangoExtentsToPixelsInclusive, pangoExtentsToPixelsNearest,++ -- * PANGO GLYPH ITEM+ PangoGlyphItem(..), PangoLayoutRun,+ mkPangoGlyphItemMaybe0+ ) where++import GHC.Stack+import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.Struct+import Control.Monad.Primitive+import Control.Exception+import Data.Fixed+import System.IO.Unsafe++#include <pango/pango.h>++data PU++instance HasResolution PU where resolution _ = #{const PANGO_SCALE}++type PangoFixed = Fixed PU++minCInt, maxCInt :: Integer+minCInt = fromIntegral (minBound @CInt)+maxCInt = fromIntegral (maxBound @CInt)++fromCInt :: CInt -> PangoFixed+fromCInt = MkFixed . fromIntegral++toCInt :: HasCallStack => PangoFixed -> CInt+toCInt (MkFixed i)+ | minCInt <= i && i <= maxCInt = fromIntegral i+ | otherwise = unsafePerformIO do+ putStrLn $ prettyCallStack callStack+ throw Overflow++struct "PangoRectangleFixed" #{size PangoRectangle} #{alignment PangoRectangle}+ [ ("x", ''PangoFixed, [| (fromCInt <$>) . #{peek PangoRectangle, x} |],+ [| \p -> #{poke PangoRectangle, x} p . toCInt |]),+ ("y", ''PangoFixed, [| (fromCInt <$>) . #{peek PangoRectangle, y} |],+ [| \p -> #{poke PangoRectangle, y} p . toCInt |]),+ ("width", ''PangoFixed, [| (fromCInt <$>) . #{peek PangoRectangle, width} |],+ [| \p -> #{poke PangoRectangle, width} p . toCInt |]),+ ("height", ''PangoFixed, [| (fromCInt <$>) . #{peek PangoRectangle, height} |],+ [| \p -> #{poke PangoRectangle, height} p . toCInt |]) ]+ [''Show]++c_pango_rectangle_copy :: Ptr PangoRectangleFixed -> IO (Ptr PangoRectangleFixed)+c_pango_rectangle_copy s = mallocBytes #{size PangoRectangle} >>= \d ->+ d <$ copyBytes d s #{size PangoRectangle}++c_pango_rectangle_free :: Ptr PangoRectangleFixed -> IO ()+c_pango_rectangle_free = free++structPrim "PangoRectangleFixed" 'c_pango_rectangle_copy 'c_pango_rectangle_free+ [''Show]++{-+pattern PangoRectangleFixed ::+ PangoFixed -> PangoFixed -> PangoFixed -> PangoFixed -> PangoRectangle+pattern PangoRectangleFixed {+ pangoRectangleFixedX, pangoRectangleFixedY,+ pangoRectangleFixedWidth, pangoRectangleFixedHeight } <- (pangoRectangleFixed -> (+ pangoRectangleFixedX, pangoRectangleFixedY,+ pangoRectangleFixedWidth, pangoRectangleFixedHeight )) where+ PangoRectangleFixed x y w h =+ PangoRectangle (toCInt x) (toCInt y) (toCInt w) (toCInt h)++pangoRectangleFixed ::+ PangoRectangle -> (PangoFixed, PangoFixed, PangoFixed, PangoFixed)+pangoRectangleFixed (PangoRectangle+ (fromCInt -> x) (fromCInt -> y)+ (fromCInt -> w) (fromCInt -> h)) = (x, y, w, h)+ -}++struct "PangoRectanglePixel" #{size PangoRectangle} #{alignment PangoRectangle}+ [ ("x", ''CInt, [| #{peek PangoRectangle, x} |],+ [| #{poke PangoRectangle, x} |]),+ ("y", ''CInt, [| #{peek PangoRectangle, y} |],+ [| #{poke PangoRectangle, y} |]),+ ("width", ''CInt, [| #{peek PangoRectangle, width} |],+ [| #{poke PangoRectangle, width} |]),+ ("height", ''CInt, [| #{peek PangoRectangle, height} |],+ [| #{poke PangoRectangle, height} |]) ]+ [''Show]++c_pango_rectangle_pixel_copy :: Ptr PangoRectanglePixel -> IO (Ptr PangoRectanglePixel)+c_pango_rectangle_pixel_copy s = castPtr <$> c_pango_rectangle_copy (castPtr s)++c_pango_rectangle_pixel_free :: Ptr PangoRectanglePixel -> IO ()+c_pango_rectangle_pixel_free = c_pango_rectangle_free . castPtr++structPrim "PangoRectanglePixel" 'c_pango_rectangle_pixel_copy+ 'c_pango_rectangle_pixel_free [''Show]++data Extents = Extents {+ extentsInkRect :: PangoRectangleFixed,+ extentsLogicalRect :: PangoRectangleFixed } deriving Show++data PixelExtents = PixelExtents {+ pixelExtentsInkRect :: PangoRectanglePixel,+ pixelExtentsLogicalRect :: PangoRectanglePixel } deriving Show++newtype PangoGlyphItem = PangoGlyphItem (ForeignPtr PangoGlyphItem) deriving Show++mkPangoGlyphItemMaybe0 :: Ptr PangoGlyphItem -> IO (Maybe PangoGlyphItem)+mkPangoGlyphItemMaybe0 = \case+ NullPtr -> pure Nothing+ p -> Just . PangoGlyphItem <$> do+ p' <- c_pango_glyph_item_copy p+ newForeignPtr p' $ c_pango_glyph_item_free p'++foreign import ccall "pango_glyph_item_free" c_pango_glyph_item_free ::+ Ptr PangoGlyphItem -> IO ()++foreign import ccall "pango_glyph_item_copy" c_pango_glyph_item_copy ::+ Ptr PangoGlyphItem -> IO (Ptr PangoGlyphItem)++type PangoLayoutRun = PangoGlyphItem++pangoExtentsToPixelsInclusive ::+ PrimMonad m => PangoRectangleFixedPrim (PrimState m) -> m ()+pangoExtentsToPixelsInclusive (PangoRectangleFixedPrim fr) = unsafeIOToPrim+ $ withForeignPtr fr (`c_pango_extents_to_pixels` nullPtr)++pangoExtentsToPixelsNearest ::+ PrimMonad m => PangoRectangleFixedPrim (PrimState m) -> m ()+pangoExtentsToPixelsNearest (PangoRectangleFixedPrim fr) = unsafeIOToPrim+ . withForeignPtr fr $ c_pango_extents_to_pixels nullPtr++foreign import ccall "pango_extents_to_pixels" c_pango_extents_to_pixels ::+ Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()
+ src/Graphics/Pango/Basic/GlyphStorage/PangoMatrix.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.GlyphStorage.PangoMatrix (++ -- * TYPE+ -- ** PangoMatrix+ PangoMatrix, pattern PangoMatrix,+ pangoMatrixXx, pangoMatrixXy, pangoMatrixYx, pangoMatrixYy,+ pangoMatrixX0, pangoMatrixY0,++ -- ** PangoMatrixPrim+ PangoMatrixPrim, PangoMatrixST, PangoMatrixIO,+ pangoMatrixFreeze, pangoMatrixThaw, pangoMatrixCopy,++ -- ** PangoMatrixNullable+ PangoMatrixNullable, pangoMatrixFromNullable, pangoMatrixToNullable,++ -- * FUNCTION+ pangoMatrixTranslate, pangoMatrixScale, pangoMatrixRotate,+ pangoMatrixConcat,++ pangoMatrixTransformPoint, pangoMatrixTransformDistance,+ pangoMatrixTransformRectangle, pangoMatrixTransformPixelRectangle,+ pangoMatrixGetFontScaleFactor, pangoMatrixGetFontScaleFactors++ ) where++import Graphics.Pango.Basic.GlyphStorage.PangoMatrix.Internal
+ src/Graphics/Pango/Basic/GlyphStorage/PangoMatrix/Internal.hsc view
@@ -0,0 +1,188 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.GlyphStorage.PangoMatrix.Internal (++ -- * TYPE+ -- ** PangoMatrix+ PangoMatrix(..), pattern PangoMatrix,+ pangoMatrixXx, pangoMatrixXy, pangoMatrixYx, pangoMatrixYy,+ pangoMatrixX0, pangoMatrixY0,++ -- ** PangoMatrixPrim+ PangoMatrixPrim, PangoMatrixST, PangoMatrixIO,+ pangoMatrixFreeze, pangoMatrixThaw, pangoMatrixCopy,++ -- ** PangoMatrixNullable+ PangoMatrixNullable(..), pangoMatrixFromNullable, pangoMatrixToNullable,+ mkPangoMatrixNullable0,++ -- * FUNCTION+ pangoMatrixTranslate, pangoMatrixScale, pangoMatrixRotate,+ pangoMatrixConcat,++ pangoMatrixTransformPoint, pangoMatrixTransformDistance,+ pangoMatrixTransformRectangle, pangoMatrixTransformPixelRectangle,+ pangoMatrixGetFontScaleFactor, pangoMatrixGetFontScaleFactors++ ) where++import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Control.Monad.Primitive+import Data.Angle+import System.IO.Unsafe++import Foreign.C.Struct++import Graphics.Pango.Basic.GlyphStorage.Internal++#include <pango/pango.h>++struct "PangoMatrix" #{size PangoMatrix} #{alignment PangoMatrix}+ [ ("xx", ''CDouble, [| #{peek PangoMatrix, xx} |],+ [| #{poke PangoMatrix, xx} |]),+ ("xy", ''CDouble, [| #{peek PangoMatrix, xy} |],+ [| #{poke PangoMatrix, xy} |]),+ ("yx", ''CDouble, [| #{peek PangoMatrix, yx} |],+ [| #{poke PangoMatrix, yx} |]),+ ("yy", ''CDouble, [| #{peek PangoMatrix, yy} |],+ [| #{poke PangoMatrix, yy} |]),+ ("x0", ''CDouble, [| #{peek PangoMatrix, x0} |],+ [| #{poke PangoMatrix, x0} |]),+ ("y0", ''CDouble, [| #{peek PangoMatrix, y0} |],+ [| #{poke PangoMatrix, y0} |]) ]+ [''Show]++foreign import ccall "pango_matrix_copy" c_pango_matrix_copy ::+ Ptr PangoMatrix -> IO (Ptr PangoMatrix)++foreign import ccall "pango_matrix_free" c_pango_matrix_free ::+ Ptr PangoMatrix -> IO ()++structPrim "PangoMatrix" 'c_pango_matrix_copy 'c_pango_matrix_free [''Show]++pangoMatrixTranslate :: PrimMonad m =>+ PangoMatrixPrim (PrimState m) -> CDouble -> CDouble -> m ()+pangoMatrixTranslate (PangoMatrixPrim fm) tx ty = unsafeIOToPrim+ $ withForeignPtr fm \pm -> c_pango_matrix_translate pm tx ty++foreign import ccall "pango_matrix_translate" c_pango_matrix_translate ::+ Ptr PangoMatrix -> CDouble -> CDouble -> IO ()++pangoMatrixScale :: PrimMonad m =>+ PangoMatrixPrim (PrimState m) -> CDouble -> CDouble -> m ()+pangoMatrixScale (PangoMatrixPrim fm) sx sy = unsafeIOToPrim+ $ withForeignPtr fm \pm -> c_pango_matrix_scale pm sx sy++foreign import ccall "pango_matrix_scale" c_pango_matrix_scale ::+ Ptr PangoMatrix -> CDouble -> CDouble -> IO ()++pangoMatrixRotate :: PrimMonad m =>+ PangoMatrixPrim (PrimState m) -> Angle CDouble -> m ()+pangoMatrixRotate (PangoMatrixPrim fm) (Degree dgr) = unsafeIOToPrim+ $ withForeignPtr fm \pm -> c_pango_matrix_rotate pm dgr++foreign import ccall "pango_matrix_rotate" c_pango_matrix_rotate ::+ Ptr PangoMatrix -> CDouble -> IO ()++pangoMatrixConcat :: PrimMonad m =>+ PangoMatrixPrim (PrimState m) -> PangoMatrix -> m ()+pangoMatrixConcat (PangoMatrixPrim fm) (PangoMatrix_ fnm) = unsafeIOToPrim+ $ withForeignPtr fm \pm -> withForeignPtr fnm \pnm ->+ c_pango_matrix_concat pm pnm++foreign import ccall "pango_matrix_concat" c_pango_matrix_concat ::+ Ptr PangoMatrix -> Ptr PangoMatrix -> IO ()++pangoMatrixTransformPoint ::+ PangoMatrix -> CDouble -> CDouble -> (CDouble, CDouble)+pangoMatrixTransformPoint (PangoMatrix_ fm) x y = unsafePerformIO+ $ withForeignPtr fm \pm -> alloca \px -> alloca \py -> do+ poke px x; poke py y+ c_pango_matrix_transform_point pm px py+ (,) <$> peek px <*> peek py++foreign import ccall "pango_matrix_transform_point"+ c_pango_matrix_transform_point ::+ Ptr PangoMatrix -> Ptr CDouble -> Ptr CDouble -> IO ()++pangoMatrixTransformDistance ::+ PangoMatrix -> CDouble -> CDouble -> (CDouble, CDouble)+pangoMatrixTransformDistance (PangoMatrix_ fm) dx dy = unsafePerformIO+ $ withForeignPtr fm \pm -> alloca \pdx -> alloca \pdy -> do+ poke pdx dx; poke pdy dy+ c_pango_matrix_transform_distance pm pdx pdy+ (,) <$> peek pdx <*> peek pdy++foreign import ccall "pango_matrix_transform_distance"+ c_pango_matrix_transform_distance ::+ Ptr PangoMatrix -> Ptr CDouble -> Ptr CDouble -> IO ()++pangoMatrixTransformRectangle ::+ PrimMonad m => PangoMatrix -> PangoRectangleFixedPrim (PrimState m) -> m ()+pangoMatrixTransformRectangle (PangoMatrix_ fm) (PangoRectangleFixedPrim fr) =+ unsafeIOToPrim $ withForeignPtr fm \pm -> withForeignPtr fr \pr ->+ c_pango_matrix_transform_rectangle pm pr++foreign import ccall "pango_matrix_transform_rectangle"+ c_pango_matrix_transform_rectangle ::+ Ptr PangoMatrix -> Ptr PangoRectangleFixed -> IO ()++pangoMatrixTransformPixelRectangle :: PrimMonad m =>+ PangoMatrix -> PangoRectanglePixelPrim (PrimState m) -> m ()+pangoMatrixTransformPixelRectangle+ (PangoMatrix_ fm) (PangoRectanglePixelPrim fr) =+ unsafeIOToPrim $ withForeignPtr fm \pm -> withForeignPtr fr \pr ->+ c_pango_matrix_transform_pixel_rectangle pm pr++foreign import ccall "pango_matrix_transform_pixel_rectangle"+ c_pango_matrix_transform_pixel_rectangle ::+ Ptr PangoMatrix -> Ptr PangoRectanglePixel -> IO ()++pangoMatrixGetFontScaleFactor :: PangoMatrix -> CDouble+pangoMatrixGetFontScaleFactor (PangoMatrix_ fm) = unsafePerformIO+ $ withForeignPtr fm c_pango_matrix_get_font_scale_factor++foreign import ccall "pango_matrix_get_font_scale_factor"+ c_pango_matrix_get_font_scale_factor ::+ Ptr PangoMatrix -> IO CDouble++pangoMatrixGetFontScaleFactors :: PangoMatrix -> (CDouble, CDouble)+pangoMatrixGetFontScaleFactors (PangoMatrix_ fm) = unsafePerformIO+ $ withForeignPtr fm \pm -> alloca \xs -> alloca \ys -> do+ c_pango_matrix_get_font_scale_factors pm xs ys+ (,) <$> peek xs <*> peek ys++foreign import ccall "pango_matrix_get_font_scale_factors"+ c_pango_matrix_get_font_scale_factors ::+ Ptr PangoMatrix -> Ptr CDouble -> Ptr CDouble -> IO ()++data PangoMatrixNullable+ = PangoMatrixNull+ | PangoMatrixNotNull (ForeignPtr PangoMatrix)+ deriving Show++pangoMatrixToNullable :: Maybe PangoMatrix -> PangoMatrixNullable+pangoMatrixToNullable = \case+ Nothing -> PangoMatrixNull+ Just (PangoMatrix_ f) -> PangoMatrixNotNull f++pangoMatrixFromNullable :: PangoMatrixNullable -> Maybe PangoMatrix+pangoMatrixFromNullable = \case+ PangoMatrixNull -> Nothing+ PangoMatrixNotNull f -> Just $ PangoMatrix_ f++mkPangoMatrixNullable0 :: Ptr PangoMatrix -> IO PangoMatrixNullable+mkPangoMatrixNullable0 = \case+ NullPtr -> pure PangoMatrixNull+ pm -> PangoMatrixNotNull <$> do+ pm' <- c_pango_matrix_copy pm+ newForeignPtr pm' $ c_pango_matrix_free pm'
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayout.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayout (+ -- * TYPE+ PangoLayout,+ PangoLayoutPrim, PangoLayoutST, PangoLayoutIO,+ pangoLayoutFreeze, pangoLayoutThaw, pangoLayoutCopy,++ -- * CLASS+ -- ** PangoLayoutSetting+ PangoLayoutSetting, pangoLayoutSet, pangoLayoutGet,++ -- ** PangoLayoutInfo+ PangoLayoutInfo, pangoLayoutInfo,++ -- * FUNCTION+ pangoLayoutNew, pangoLayoutContextChanged,+ pangoLayoutSetMarkup, pangoLayoutSetMarkupWithAccel,++ pangoLayoutIndexToPos,+ pangoLayoutIndexToLineX,+ pangoLayoutXyToIndex,+ pangoLayoutGetCursorPos,+ pangoLayoutMoveCursorVisually, Dir(..),++ -- * SETTING++ -- ** Width and Height+ Width(..), Height(..),++ -- ** PangoWrapMode+ PangoWrapMode(..),+ pattern PangoWrapWord, pattern PangoWrapChar, pattern PangoWrapWordChar,++ -- ** PangoEllipsizeMode+ PangoEllipsizeMode(..),+ pattern PangoEllipsizeNone, pattern PangoEllipsizeStart,+ pattern PangoEllipsizeMiddle, pattern PangoEllipsizeEnd,++ -- ** Indent, Spacing, LineSpacing, Justify and AutoDir+ Indent(..), Spacing(..), LineSpacing(..), Justify(..), AutoDir(..),++ -- ** PangoAlignment+ PangoAlignment(..),+ pattern PangoAlignLeft, pattern PangoAlignCenter,+ pattern PangoAlignRight,++ -- ** SingleParagraphMode+ SingleParagraphMode(..),++ -- * INFO++ -- ** CharacterCount, IsWrapped, IsEllipsized and UnknownGlyphCount+ CharacterCount(..), IsWrapped(..), IsEllipsized(..), UnknownGlyphsCount(..),++ -- ** PangoLogAttrs+ PangoLogAttrs, pangoLogAttrsGetLogAttr, pangoLogAttrsGetSize,+ PangoLogAttr,+ pattern PangoLogAttr,+ pangoLogAttrIsLineBreak, pangoLogAttrIsMandatoryBreak,+ pangoLogAttrIsCharBreak, pangoLogAttrIsWhite,+ pangoLogAttrIsCursorPosition,+ pangoLogAttrIsWordStart, pangoLogAttrIsWordEnd,+ pangoLogAttrIsSentenceBoundary,+ pangoLogAttrIsSentenceStart, pangoLogAttrIsSentenceEnd,+ pangoLogAttrBackspaceDeleteCharacter, pangoLogAttrIsExpandableSpace,+ pangoLogAttrIsWordBoundary,++ -- ** LayoutSize, LayoutPixelSize, Baseline and LineCount+ LayoutSize(..), LayoutPixelSize(..), Baseline(..), LineCount(..),++ ) where++import Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayout/Internal.hsc view
@@ -0,0 +1,883 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal (+ -- * TYPE+ PangoLayout(..),+ PangoLayoutPrim(..), PangoLayoutST, PangoLayoutIO, mkPangoLayoutPrim,+ pangoLayoutFreeze, pangoLayoutThaw, pangoLayoutCopy,++ -- * CLASS+ -- ** PangoLayoutSetting+ PangoLayoutSetting, pangoLayoutSet, pangoLayoutGet,++ -- ** PangoLayoutInfo+ PangoLayoutInfo, pangoLayoutInfo,++ -- * FUNCTION+ pangoLayoutNew, pangoLayoutContextChanged,+ pangoLayoutSetMarkup, pangoLayoutSetMarkupWithAccel,++ pangoLayoutIndexToPos,+ pangoLayoutIndexToLineX,+ pangoLayoutXyToIndex,+ pangoLayoutGetCursorPos,+ pangoLayoutMoveCursorVisually, Dir(..),++ -- * SETTING++ -- ** Width and Height+ Width(..), Height(..),++ -- ** PangoWrapMode+ PangoWrapMode(..),+ pattern PangoWrapWord, pattern PangoWrapChar, pattern PangoWrapWordChar,++ -- ** PangoEllipsizeMode+ PangoEllipsizeMode(..),+ pattern PangoEllipsizeNone, pattern PangoEllipsizeStart,+ pattern PangoEllipsizeMiddle, pattern PangoEllipsizeEnd,++ -- ** Indent, Spacing, LineSpacing, Justify and AutoDir+ Indent(..), Spacing(..), LineSpacing(..), Justify(..), AutoDir(..),++ -- ** PangoAlignment+ PangoAlignment(..),+ pattern PangoAlignLeft, pattern PangoAlignCenter,+ pattern PangoAlignRight,++ -- ** SingleParagraphMode+ SingleParagraphMode(..),++ -- * INFO++ -- ** CharacterCount, IsWrapped, IsEllipsized and UnknownGlyphCount+ CharacterCount(..), IsWrapped(..), IsEllipsized(..), UnknownGlyphsCount(..),++ -- ** PangoLogAttrs+ PangoLogAttrs, pangoLogAttrsGetLogAttr, pangoLogAttrsGetSize,+ PangoLogAttr,+ pattern PangoLogAttr,+ pangoLogAttrIsLineBreak, pangoLogAttrIsMandatoryBreak,+ pangoLogAttrIsCharBreak, pangoLogAttrIsWhite,+ pangoLogAttrIsCursorPosition,+ pangoLogAttrIsWordStart, pangoLogAttrIsWordEnd,+ pangoLogAttrIsSentenceBoundary,+ pangoLogAttrIsSentenceStart, pangoLogAttrIsSentenceEnd,+ pangoLogAttrBackspaceDeleteCharacter, pangoLogAttrIsExpandableSpace,+ pangoLogAttrIsWordBoundary,++ -- ** LayoutSize, LayoutPixelSize, Baseline and LineCount+ LayoutSize(..), LayoutPixelSize(..), Baseline(..), LineCount(..),++ ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr, addForeignPtrFinalizer)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Foreign.C.String.Utf8+import Foreign.C.String.ForeignCStringLen+import Foreign.C.String.Misc+import Foreign.C.Enum+import Foreign.C.Struct+import Control.Monad.Primitive+import Data.Maybe+import Data.List+import Data.Bool+import Data.Word+import Data.Int+import Data.Char+import Data.Text.CString+import System.IO.Unsafe+import System.GLib.Bool+import System.GLib.GObject++import Graphics.Pango.Basic.GlyphStorage.Internal+import Graphics.Pango.Basic.Fonts.PangoFontDescription.Type+import Graphics.Pango.Basic.TextAttributes.Internal+import Graphics.Pango.LowLevel.Contexts.Internal+import Graphics.Pango.LowLevel.TabStops.Internal++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++#include <pango/pango.h>+#include "pango_log_attr.h"++newtype PangoLayout = PangoLayout_ (ForeignPtr PangoLayout) deriving Show++foreign import ccall "pango_layout_copy" c_pango_layout_copy ::+ Ptr PangoLayout -> IO (Ptr PangoLayout)++foreign import ccall "g_object_unref" c_pango_layout_free ::+ Ptr PangoLayout -> IO ()++structPrim "PangoLayout" 'c_pango_layout_copy 'c_pango_layout_free [''Show]++mkPangoLayoutPrim :: Ptr PangoLayout -> IO (PangoLayoutPrim s)+mkPangoLayoutPrim p = PangoLayoutPrim <$> newForeignPtr p (c_g_object_unref p)++pangoLayoutNew :: PrimMonad m => PangoContext -> m (PangoLayoutPrim (PrimState m))+pangoLayoutNew (PangoContext fc) = unsafeIOToPrim+ $ mkPangoLayoutPrim =<< withForeignPtr fc c_pango_layout_new++foreign import ccall "pango_layout_new" c_pango_layout_new ::+ Ptr PangoContext -> IO (Ptr PangoLayout)++pangoLayoutContextChanged ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> m ()+pangoLayoutContextChanged (PangoLayoutPrim fl) = unsafeIOToPrim+ $ withForeignPtr fl c_pango_layout_context_changed++foreign import ccall "pango_layout_context_changed"+ c_pango_layout_context_changed ::+ Ptr PangoLayout -> IO ()++class PangoLayoutSetting s where+ pangoLayoutSet ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> s -> m ()+ pangoLayoutGet :: PangoLayout -> s++instance PangoLayoutSetting T.Text where+ pangoLayoutSet = (unsafeIOToPrim .) . pangoLayoutSetText+ pangoLayoutGet = pangoLayoutGetText++pangoLayoutSetText :: PangoLayoutPrim s -> T.Text -> IO ()+pangoLayoutSetText (PangoLayoutPrim fpl) s =+ withForeignPtr fpl \pl -> T.withCStringLen s \(cs, n) -> do+ cs' <- copyCString cs n+ addForeignPtrFinalizer fpl $ free cs'+ c_pango_layout_set_text pl cs' $ fromIntegral n++foreign import ccall "pango_layout_set_text" c_pango_layout_set_text ::+ Ptr PangoLayout -> CString -> CInt -> IO ()++pangoLayoutGetText :: PangoLayout -> T.Text+pangoLayoutGetText (PangoLayout_ fpl) = unsafePerformIO+ $ withForeignPtr fpl \pl -> peekCStringText =<< c_pango_layout_get_text pl++foreign import ccall "pango_layout_get_text" c_pango_layout_get_text ::+ Ptr PangoLayout -> IO CString++pangoLayoutSetMarkup ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> T.Text -> m ()+pangoLayoutSetMarkup (PangoLayoutPrim fpl) mu = unsafeIOToPrim+ $ withForeignPtr fpl \ppl -> T.withCStringLen mu \(cs, cl) ->+ c_pango_layout_set_markup ppl cs $ fromIntegral cl++foreign import ccall "pango_layout_set_markup"+ c_pango_layout_set_markup :: Ptr PangoLayout -> CString -> CInt -> IO ()++pangoLayoutSetMarkupWithAccel ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> T.Text -> Char -> m Char+pangoLayoutSetMarkupWithAccel (PangoLayoutPrim fpl) mu am = unsafeIOToPrim+ $ withForeignPtr fpl \ppl ->+ T.withCStringLen mu \(cs, cl) -> alloca \pa -> do+ c_pango_layout_set_markup_with_accel ppl cs (fromIntegral cl) (fromIntegral $ ord am) pa+ chr . fromIntegral <$> peek pa++foreign import ccall "pango_layout_set_markup_with_accel"+ c_pango_layout_set_markup_with_accel ::+ Ptr PangoLayout -> CString -> CInt ->+ #{type gunichar} -> Ptr #{type gunichar} -> IO ()++instance PangoLayoutSetting PangoTextAttrList where+ pangoLayoutSet = pangoLayoutSetTextAttributes+ pangoLayoutGet = pangoLayoutGetTextAttributes++pangoLayoutSetTextAttributes :: PrimMonad m =>+ PangoLayoutPrim (PrimState m) -> PangoTextAttrList -> m ()+pangoLayoutSetTextAttributes+ l@(PangoLayoutPrim fl) (PangoTextAttrList (cs, ln) al) = unsafeIOToPrim do+ withForeignPtr fl \pl -> withForeignPtr cs \cs' -> c_pango_layout_set_text pl cs' $ fromIntegral ln+ pangoLayoutSetAttributes l al++pangoLayoutGetTextAttributes :: PangoLayout -> PangoTextAttrList+pangoLayoutGetTextAttributes l@(PangoLayout_ fl) = unsafePerformIO $ PangoTextAttrList+ <$> (copyToForeignCStringLen =<< toCStringLen =<< withForeignPtr fl c_pango_layout_get_text)+ <*> pangoLayoutGetAttributes l++pangoLayoutSetAttributes :: PangoLayoutPrim s -> PangoAttrList -> IO ()+pangoLayoutSetAttributes (PangoLayoutPrim fl) al =+ withForeignPtr fl \pl -> ($ c_pango_layout_set_attributes pl) case al of+ PangoAttrListNull -> ($ nullPtr)+ PangoAttrList fal -> withForeignPtr fal++foreign import ccall "pango_layout_set_attributes"+ c_pango_layout_set_attributes ::+ Ptr PangoLayout -> Ptr PangoAttrList -> IO ()++pangoLayoutGetAttributes :: PangoLayout -> IO PangoAttrList+pangoLayoutGetAttributes (PangoLayout_ fpl) =+ mkPangoAttrList =<< do+ p <- withForeignPtr fpl c_pango_layout_get_attributes+ p <$ c_pango_attr_list_ref p++foreign import ccall "pango_layout_get_attributes"+ c_pango_layout_get_attributes ::+ Ptr PangoLayout -> IO (Ptr PangoAttrList)++foreign import ccall "pango_attr_list_ref" c_pango_attr_list_ref ::+ Ptr PangoAttrList -> IO (Ptr PangoAttrList)++instance PangoLayoutSetting PangoFontDescriptionNullable where+ pangoLayoutSet = pangoLayoutSetFontDescription+ pangoLayoutGet = pangoLayoutGetFontDescription++pangoLayoutSetFontDescription :: PrimMonad m =>+ PangoLayoutPrim (PrimState m) -> PangoFontDescriptionNullable -> m ()+pangoLayoutSetFontDescription (PangoLayoutPrim fpl) fd = unsafeIOToPrim+ $ withForeignPtr fpl \pl -> case fd of+ PangoFontDescriptionNull -> c_pango_layout_set_font_description pl nullPtr+ PangoFontDescriptionNotNull ffd -> do+ addForeignPtrFinalizer fpl $ touchForeignPtr ffd+ withForeignPtr ffd $ c_pango_layout_set_font_description pl++foreign import ccall "pango_layout_set_font_description" c_pango_layout_set_font_description ::+ Ptr PangoLayout -> Ptr PangoFontDescription -> IO ()++pangoLayoutGetFontDescription :: PangoLayout -> PangoFontDescriptionNullable+pangoLayoutGetFontDescription (PangoLayout_ fpl) = unsafePerformIO+ $ mkPangoFontDescriptionNullable =<< withForeignPtr fpl \ppl ->+ c_pango_font_description_copy+ =<< c_pango_layout_get_font_description ppl++foreign import ccall "pango_layout_get_font_description" c_pango_layout_get_font_description ::+ Ptr PangoLayout -> IO (Ptr PangoFontDescription)++foreign import ccall "pango_font_description_copy" c_pango_font_description_copy ::+ Ptr PangoFontDescription -> IO (Ptr PangoFontDescription)++data Width = WidthDefault | Width PangoFixed deriving Show++getWidth :: Width -> CInt+getWidth = \case WidthDefault -> - 1; Width w -> toCInt w++width :: CInt -> Width+width = \case - 1 -> WidthDefault; w -> Width $ fromCInt w++instance PangoLayoutSetting Width where+ pangoLayoutSet l = pangoLayoutSetWidth l . getWidth+ pangoLayoutGet l = width $ pangoLayoutGetWidth l++data Height = HeightDefault | Height PangoFixed | LinesPerParagraph CInt+ deriving Show++toHeight :: CInt -> Height+toHeight n+ | n < 0 = LinesPerParagraph $ - n+ | otherwise = Height $ fromCInt n++fromHeight :: Height -> CInt+fromHeight = \case+ HeightDefault -> - 1+ Height d -> toCInt d+ LinesPerParagraph n -> - n++instance PangoLayoutSetting Height where+ pangoLayoutSet l = pangoLayoutSetHeight l . fromHeight+ pangoLayoutGet l = toHeight $ pangoLayoutGetHeight l++pangoLayoutSetWidth, pangoLayoutSetHeight ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> CInt -> m ()+pangoLayoutSetWidth (PangoLayoutPrim fl) w = unsafeIOToPrim+ $ withForeignPtr fl \pl -> c_pango_layout_set_width pl w++pangoLayoutSetHeight (PangoLayoutPrim fl) h = unsafeIOToPrim+ $ withForeignPtr fl \pl -> c_pango_layout_set_height pl h++pangoLayoutGetWidth, pangoLayoutGetHeight :: PangoLayout -> CInt+pangoLayoutGetWidth (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl c_pango_layout_get_width++pangoLayoutGetHeight (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl c_pango_layout_get_height++foreign import ccall "pango_layout_set_width" c_pango_layout_set_width ::+ Ptr PangoLayout -> CInt -> IO ()++foreign import ccall "pango_layout_get_width" c_pango_layout_get_width ::+ Ptr PangoLayout -> IO CInt++foreign import ccall "pango_layout_set_height" c_pango_layout_set_height ::+ Ptr PangoLayout -> CInt -> IO ()++foreign import ccall "pango_layout_get_height" c_pango_layout_get_height ::+ Ptr PangoLayout -> IO CInt++enum "PangoWrapMode" ''#{type PangoWrapMode} [''Show] [+ ("PangoWrapWord", #{const PANGO_WRAP_WORD}),+ ("PangoWrapChar", #{const PANGO_WRAP_CHAR}),+ ("PangoWrapWordChar", #{const PANGO_WRAP_WORD_CHAR}) ]++instance PangoLayoutSetting PangoWrapMode where+ pangoLayoutSet = pangoLayoutSetWrap+ pangoLayoutGet = pangoLayoutGetWrap++pangoLayoutSetWrap ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> PangoWrapMode -> m ()+pangoLayoutSetWrap (PangoLayoutPrim fl) (PangoWrapMode wm) = unsafeIOToPrim+ $ withForeignPtr fl \pl -> c_pango_layout_set_wrap pl wm++pangoLayoutGetWrap :: PangoLayout -> PangoWrapMode+pangoLayoutGetWrap (PangoLayout_ fl) = unsafePerformIO $ PangoWrapMode+ <$> withForeignPtr fl c_pango_layout_get_wrap++foreign import ccall "pango_layout_set_wrap" c_pango_layout_set_wrap ::+ Ptr PangoLayout -> #{type PangoWrapMode} -> IO ()++foreign import ccall "pango_layout_get_wrap" c_pango_layout_get_wrap ::+ Ptr PangoLayout -> IO #{type PangoWrapMode}++enum "PangoEllipsizeMode" ''#{type PangoEllipsizeMode} [''Show] [+ ("PangoEllipsizeNone", #{const PANGO_ELLIPSIZE_NONE}),+ ("PangoEllipsizeStart", #{const PANGO_ELLIPSIZE_START}),+ ("PangoEllipsizeMiddle", #{const PANGO_ELLIPSIZE_MIDDLE}),+ ("PangoEllipsizeEnd", #{const PANGO_ELLIPSIZE_END}) ]++instance PangoLayoutSetting PangoEllipsizeMode where+ pangoLayoutSet = pangoLayoutSetEllipsize+ pangoLayoutGet = pangoLayoutGetEllipsize++pangoLayoutSetEllipsize :: PrimMonad m =>+ PangoLayoutPrim (PrimState m) -> PangoEllipsizeMode -> m ()+pangoLayoutSetEllipsize (PangoLayoutPrim fpl) (PangoEllipsizeMode pem) = unsafeIOToPrim+ $ withForeignPtr fpl \pl -> c_pango_layout_set_ellipsize pl pem++pangoLayoutGetEllipsize :: PangoLayout -> PangoEllipsizeMode+pangoLayoutGetEllipsize (PangoLayout_ fl) = unsafePerformIO $ PangoEllipsizeMode+ <$> withForeignPtr fl c_pango_layout_get_ellipsize++foreign import ccall "pango_layout_set_ellipsize" c_pango_layout_set_ellipsize ::+ Ptr PangoLayout -> #{type PangoEllipsizeMode} -> IO ()++foreign import ccall "pango_layout_get_ellipsize" c_pango_layout_get_ellipsize ::+ Ptr PangoLayout -> IO #{type PangoEllipsizeMode}++newtype Indent = Indent { getIndent :: PangoFixed } deriving Show++instance PangoLayoutSetting Indent where+ pangoLayoutSet l = pangoLayoutSetIndent l . toCInt . getIndent+ pangoLayoutGet l = Indent . fromCInt $ pangoLayoutGetIndent l++pangoLayoutSetIndent ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> CInt -> m ()+pangoLayoutSetIndent (PangoLayoutPrim fl) idt = unsafeIOToPrim+ $ withForeignPtr fl \pl -> c_pango_layout_set_indent pl idt++pangoLayoutGetIndent :: PangoLayout -> CInt+pangoLayoutGetIndent (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl c_pango_layout_get_indent++foreign import ccall "pango_layout_set_indent" c_pango_layout_set_indent ::+ Ptr PangoLayout -> CInt -> IO ()++foreign import ccall "pango_layout_get_indent" c_pango_layout_get_indent ::+ Ptr PangoLayout -> IO CInt++newtype Spacing = Spacing { getSpacing :: PangoFixed } deriving Show++instance PangoLayoutSetting Spacing where+ pangoLayoutSet l = pangoLayoutSetSpacing l . toCInt . getSpacing+ pangoLayoutGet l = Spacing . fromCInt $ pangoLayoutGetSpacing l++pangoLayoutSetSpacing ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> CInt -> m ()+pangoLayoutSetSpacing (PangoLayoutPrim fl) sp = unsafeIOToPrim+ $ withForeignPtr fl \pl -> c_pango_layout_set_spacing pl sp++pangoLayoutGetSpacing :: PangoLayout -> CInt+pangoLayoutGetSpacing (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl c_pango_layout_get_spacing++foreign import ccall "pango_layout_set_spacing" c_pango_layout_set_spacing ::+ Ptr PangoLayout -> CInt -> IO ()++foreign import ccall "pango_layout_get_spacing" c_pango_layout_get_spacing ::+ Ptr PangoLayout -> IO CInt++newtype LineSpacing = LineSpacing { getLineSpacing :: CFloat } deriving Show++instance PangoLayoutSetting LineSpacing where+ pangoLayoutSet l = pangoLayoutSetLineSpacing l . getLineSpacing+ pangoLayoutGet l = LineSpacing $ pangoLayoutGetLineSpacing l++pangoLayoutSetLineSpacing ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> CFloat -> m ()+pangoLayoutSetLineSpacing (PangoLayoutPrim fpl) fct = unsafeIOToPrim+ $ withForeignPtr fpl \pl -> c_pango_layout_set_line_spacing pl fct++pangoLayoutGetLineSpacing :: PangoLayout -> CFloat+pangoLayoutGetLineSpacing (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl c_pango_layout_get_line_spacing++foreign import ccall "pango_layout_set_line_spacing" c_pango_layout_set_line_spacing ::+ Ptr PangoLayout -> CFloat -> IO ()++foreign import ccall "pango_layout_get_line_spacing" c_pango_layout_get_line_spacing ::+ Ptr PangoLayout -> IO CFloat++newtype Justify = Justify { getJustify :: Bool } deriving Show++instance PangoLayoutSetting Justify where+ pangoLayoutSet l = pangoLayoutSetJustify l . getJustify+ pangoLayoutGet l = Justify $ pangoLayoutGetJustify l++pangoLayoutSetJustify ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> Bool -> m ()+pangoLayoutSetJustify (PangoLayoutPrim fl) b = unsafeIOToPrim $ withForeignPtr fl \pl ->+ c_pango_layout_set_justify pl $ bool #{const FALSE} #{const TRUE} b++pangoLayoutGetJustify :: PangoLayout -> Bool+pangoLayoutGetJustify (PangoLayout_ fl) = unsafePerformIO+ $ (<$> withForeignPtr fl c_pango_layout_get_justify) \case+ #{const FALSE} -> False+ #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_layout_set_justify" c_pango_layout_set_justify ::+ Ptr PangoLayout -> #{type gboolean} -> IO ()++foreign import ccall "pango_layout_get_justify" c_pango_layout_get_justify ::+ Ptr PangoLayout -> IO #{type gboolean}++newtype AutoDir = AutoDir { getAutoDir :: Bool } deriving Show++instance PangoLayoutSetting AutoDir where+ pangoLayoutSet l = pangoLayoutSetAutoDir l . getAutoDir+ pangoLayoutGet l = AutoDir $ pangoLayoutGetAutoDir l++pangoLayoutSetAutoDir ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> Bool -> m ()+pangoLayoutSetAutoDir (PangoLayoutPrim fl) b = unsafeIOToPrim $ withForeignPtr fl \pl ->+ c_pango_layout_set_auto_dir pl $ bool #{const FALSE} #{const TRUE} b++pangoLayoutGetAutoDir :: PangoLayout -> Bool+pangoLayoutGetAutoDir (PangoLayout_ fl) = unsafePerformIO+ $ (<$> withForeignPtr fl c_pango_layout_get_auto_dir) \case+ #{const FALSE} -> False+ #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_layout_set_auto_dir" c_pango_layout_set_auto_dir ::+ Ptr PangoLayout -> #{type gboolean} -> IO ()++foreign import ccall "pango_layout_get_auto_dir" c_pango_layout_get_auto_dir ::+ Ptr PangoLayout -> IO #{type gboolean}++enum "PangoAlignment" ''#{type PangoAlignment} [''Show] [+ ("PangoAlignLeft", #{const PANGO_ALIGN_LEFT}),+ ("PangoAlignCenter", #{const PANGO_ALIGN_CENTER}),+ ("PangoAlignRight", #{const PANGO_ALIGN_RIGHT}) ]++instance PangoLayoutSetting PangoAlignment where+ pangoLayoutSet = pangoLayoutSetAlignment+ pangoLayoutGet = pangoLayoutGetAlignment++pangoLayoutSetAlignment ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> PangoAlignment -> m ()+pangoLayoutSetAlignment (PangoLayoutPrim fpl) (PangoAlignment pa) = unsafeIOToPrim+ $ withForeignPtr fpl \pl -> c_pango_layout_set_alignment pl pa++pangoLayoutGetAlignment :: PangoLayout -> PangoAlignment+pangoLayoutGetAlignment (PangoLayout_ fl) = unsafePerformIO+ $ PangoAlignment <$> withForeignPtr fl c_pango_layout_get_alignment++foreign import ccall "pango_layout_set_alignment" c_pango_layout_set_alignment ::+ Ptr PangoLayout -> #{type PangoAlignment} -> IO ()++foreign import ccall "pango_layout_get_alignment" c_pango_layout_get_alignment ::+ Ptr PangoLayout -> IO #{type PangoAlignment}++instance PangoLayoutSetting PangoTabArrayNullable where+ pangoLayoutSet = pangoLayoutSetTabs+ pangoLayoutGet = pangoLayoutGetTabs++pangoLayoutSetTabs ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> PangoTabArrayNullable -> m ()+pangoLayoutSetTabs (PangoLayoutPrim fl) ta = unsafeIOToPrim+ $ withForeignPtr fl \pl -> case ta of+ PangoTabArrayNull -> c_pango_layout_set_tabs pl nullPtr+ PangoTabArrayNotNull fta -> do+ addForeignPtrFinalizer fl $ touchForeignPtr fta+ withForeignPtr fta $ c_pango_layout_set_tabs pl++pangoLayoutGetTabs :: PangoLayout -> PangoTabArrayNullable+pangoLayoutGetTabs (PangoLayout_ fl) = unsafePerformIO+ $ makePangoTabArrayNullable =<< withForeignPtr fl c_pango_layout_get_tabs++foreign import ccall "pango_layout_set_tabs" c_pango_layout_set_tabs ::+ Ptr PangoLayout -> Ptr PangoTabArray -> IO ()++foreign import ccall "pango_layout_get_tabs" c_pango_layout_get_tabs ::+ Ptr PangoLayout -> IO (Ptr PangoTabArray)++newtype SingleParagraphMode =+ SingleParagraphMode { getSingleParagraphMode :: Bool } deriving Show++instance PangoLayoutSetting SingleParagraphMode where+ pangoLayoutSet l =+ pangoLayoutSetSingleParagraphMode l . getSingleParagraphMode+ pangoLayoutGet l =+ SingleParagraphMode $ pangoLayoutGetSingleParagraphMode l++pangoLayoutSetSingleParagraphMode ::+ PrimMonad m => PangoLayoutPrim (PrimState m) -> Bool -> m ()+pangoLayoutSetSingleParagraphMode (PangoLayoutPrim fl) spm = unsafeIOToPrim+ $ withForeignPtr fl \pl ->+ c_pango_layout_set_single_paragraph_mode pl (boolToGboolean spm)++pangoLayoutGetSingleParagraphMode :: PangoLayout -> Bool+pangoLayoutGetSingleParagraphMode (PangoLayout_ fl) = unsafePerformIO+ $ (<$> withForeignPtr fl c_pango_layout_get_single_paragraph_mode) \case+ #{const FALSE} -> False; #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_layout_set_single_paragraph_mode"+ c_pango_layout_set_single_paragraph_mode ::+ Ptr PangoLayout -> #{type gboolean} -> IO ()++foreign import ccall "pango_layout_get_single_paragraph_mode"+ c_pango_layout_get_single_paragraph_mode ::+ Ptr PangoLayout -> IO #{type gboolean}++class PangoLayoutInfo i where pangoLayoutInfo :: PangoLayout -> i++newtype CharacterCount = CharacterCount CInt deriving Show++instance PangoLayoutInfo CharacterCount where+ pangoLayoutInfo = unsafePerformIO . (CharacterCount <$>) . pangoLayoutGetCharacterCount++pangoLayoutGetCharacterCount :: PangoLayout -> IO CInt+pangoLayoutGetCharacterCount (PangoLayout_ fpl) =+ withForeignPtr fpl c_pango_layout_get_character_count++foreign import ccall "pango_layout_get_character_count"+ c_pango_layout_get_character_count :: Ptr PangoLayout -> IO CInt++newtype IsEllipsized = IsEllipsized Bool deriving Show++instance PangoLayoutInfo IsEllipsized where+ pangoLayoutInfo = unsafePerformIO . (IsEllipsized <$>) . pangoLayoutIsEllipsized++pangoLayoutIsEllipsized :: PangoLayout -> IO Bool+pangoLayoutIsEllipsized (PangoLayout_ fl) =+ (<$> withForeignPtr fl c_pango_layout_is_ellipsized) \case+ #{const FALSE} -> False+ #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_layout_is_ellipsized"+ c_pango_layout_is_ellipsized :: Ptr PangoLayout -> IO #{type gboolean}++newtype IsWrapped = IsWrapped Bool deriving Show++instance PangoLayoutInfo IsWrapped where+ pangoLayoutInfo = unsafePerformIO . (IsWrapped <$>) . pangoLayoutIsWrapped++pangoLayoutIsWrapped :: PangoLayout -> IO Bool+pangoLayoutIsWrapped (PangoLayout_ fl) =+ (<$> withForeignPtr fl c_pango_layout_is_wrapped) \case+ #{const FALSE} -> False+ #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_layout_is_wrapped" c_pango_layout_is_wrapped ::+ Ptr PangoLayout -> IO #{type gboolean}++newtype UnknownGlyphsCount = UnknownGlyphsCount CInt deriving Show++instance PangoLayoutInfo UnknownGlyphsCount where+ pangoLayoutInfo = unsafePerformIO . (UnknownGlyphsCount <$>) . pangoLayoutGetUnknownGlyphsCount++pangoLayoutGetUnknownGlyphsCount :: PangoLayout -> IO CInt+pangoLayoutGetUnknownGlyphsCount (PangoLayout_ fpl) =+ withForeignPtr fpl c_pango_layout_get_unknown_glyphs_count++foreign import ccall "pango_layout_get_unknown_glyphs_count"+ c_pango_layout_get_unknown_glyphs_count :: Ptr PangoLayout -> IO CInt++data PangoLogAttr = PangoLogAttr_ (ForeignPtr PangoLogAttr) Int deriving Show+data PangoLogAttrStruct++pattern PangoLogAttr ::+ Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool ->+ Bool -> Bool -> Bool -> Bool -> PangoLogAttr+pattern PangoLogAttr { + pangoLogAttrIsLineBreak,+ pangoLogAttrIsMandatoryBreak,+ pangoLogAttrIsCharBreak,+ pangoLogAttrIsWhite,+ pangoLogAttrIsCursorPosition,+ pangoLogAttrIsWordStart,+ pangoLogAttrIsWordEnd,+ pangoLogAttrIsSentenceBoundary,+ pangoLogAttrIsSentenceStart,+ pangoLogAttrIsSentenceEnd,+ pangoLogAttrBackspaceDeleteCharacter,+ pangoLogAttrIsExpandableSpace,+ pangoLogAttrIsWordBoundary } <- (pangoLogAttrExpand -> PangoLogAttrExpand+ pangoLogAttrIsLineBreak+ pangoLogAttrIsMandatoryBreak+ pangoLogAttrIsCharBreak+ pangoLogAttrIsWhite+ pangoLogAttrIsCursorPosition+ pangoLogAttrIsWordStart+ pangoLogAttrIsWordEnd+ pangoLogAttrIsSentenceBoundary+ pangoLogAttrIsSentenceStart+ pangoLogAttrIsSentenceEnd+ pangoLogAttrBackspaceDeleteCharacter+ pangoLogAttrIsExpandableSpace+ pangoLogAttrIsWordBoundary)++data PangoLogAttrExpand = PangoLogAttrExpand {+ pangoLogAttrExpandIsLineBreak :: Bool,+ pangoLogAttrExpandIsMandatoryBreak :: Bool,+ pangoLogAttrExpandIsCharBreak :: Bool,+ pangoLogAttrExpandIsWhite :: Bool,+ pangoLogAttrExpandIsCursorPosition :: Bool,+ pangoLogAttrExpandIsWordStart :: Bool,+ pangoLogAttrExpandIsWordEnd :: Bool,+ pangoLogAttrExpandIsSentenceBoundary :: Bool,+ pangoLogAttrExpandIsSentenceStart :: Bool,+ pangoLogAttrExpandIsSentenceEnd :: Bool,+ pangoLogAttrExpandBackspaceDeletesCharacter :: Bool,+ pangoLogAttrExpandIsExpandableSpace :: Bool,+ pangoLogAttrExpandIsWordBoundary :: Bool+ } deriving Show++pangoLogAttrExpand :: PangoLogAttr -> PangoLogAttrExpand+pangoLogAttrExpand (PangoLogAttr_ fb i) = unsafePerformIO+ $ withForeignPtr fb \pb_ -> let pb = pb_ `plusPtr` (i * #{size PangoLogAttr}) in+ allocaBytes #{size PangoLogAttrStr} \ps -> do+ c_pango_log_attr_to_struct pb ps+ PangoLogAttrExpand+ <$> #{peek PangoLogAttrStr, is_line_break} ps+ <*> #{peek PangoLogAttrStr, is_mandatory_break} ps+ <*> #{peek PangoLogAttrStr, is_char_break} ps+ <*> #{peek PangoLogAttrStr, is_white} ps+ <*> #{peek PangoLogAttrStr, is_cursor_position} ps+ <*> #{peek PangoLogAttrStr, is_word_start} ps+ <*> #{peek PangoLogAttrStr, is_word_end} ps+ <*> #{peek PangoLogAttrStr, is_sentence_boundary} ps+ <*> #{peek PangoLogAttrStr, is_sentence_start} ps+ <*> #{peek PangoLogAttrStr, is_sentence_end} ps+ <*> #{peek PangoLogAttrStr, backspace_deletes_character} ps+ <*> #{peek PangoLogAttrStr, is_expandable_space} ps+ <*> #{peek PangoLogAttrStr, is_word_boundary} ps++foreign import ccall "pango_log_attr_to_struct" c_pango_log_attr_to_struct ::+ Ptr PangoLogAttr -> Ptr PangoLogAttrStruct -> IO ()++instance PangoLayoutInfo PangoLogAttrs where+ pangoLayoutInfo = pangoLayoutGetLogAttrs++data PangoLogAttrs = PangoLogAttrs (ForeignPtr PangoLogAttr) CInt deriving Show++mkPangoLogAttrs :: Ptr PangoLogAttr -> CInt -> IO PangoLogAttrs+mkPangoLogAttrs p n =+ (`PangoLogAttrs` n) <$> newForeignPtr p (c_g_free_pango_log_attr p)++foreign import ccall "g_free" c_g_free_pango_log_attr ::+ Ptr PangoLogAttr -> IO ()++pangoLayoutGetLogAttrs :: PangoLayout -> PangoLogAttrs+pangoLayoutGetLogAttrs (PangoLayout_ fl) = unsafePerformIO+ $ withForeignPtr fl \pl -> alloca \plas -> alloca \pn -> do+ c_pango_layout_get_log_attrs pl plas pn+ uncurry mkPangoLogAttrs =<< (,) <$> peek plas <*> peek pn++foreign import ccall "pango_layout_get_log_attrs" c_pango_layout_get_log_attrs ::+ Ptr PangoLayout -> Ptr (Ptr PangoLogAttr) -> Ptr CInt -> IO ()++pangoLogAttrsGetSize :: PangoLogAttrs -> Int+pangoLogAttrsGetSize (PangoLogAttrs _ sz) = fromIntegral sz++pangoLogAttrsGetLogAttr :: PangoLogAttrs -> Int -> Maybe PangoLogAttr+pangoLogAttrsGetLogAttr (PangoLogAttrs fla sz) i+ | 0 <= i && i < fromIntegral sz = Just $ PangoLogAttr_ fla i+ | otherwise = Nothing++instance PangoLayoutInfo Extents where+ pangoLayoutInfo = unsafePerformIO . (uncurry Extents <$>) . pangoLayoutGetExtents++pangoLayoutGetExtents :: PangoLayout -> IO (PangoRectangleFixed, PangoRectangleFixed)+pangoLayoutGetExtents (PangoLayout_ fpl) = withForeignPtr fpl \pl -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_get_extents pl irct lrct+ (,) <$> (PangoRectangleFixed_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectangleFixed_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_get_extents" c_pango_layout_get_extents ::+ Ptr PangoLayout -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()++instance PangoLayoutInfo PixelExtents where+ pangoLayoutInfo = unsafePerformIO . (uncurry PixelExtents <$>) . pangoLayoutGetPixelExtents++pangoLayoutGetPixelExtents :: PangoLayout -> IO (PangoRectanglePixel, PangoRectanglePixel)+pangoLayoutGetPixelExtents (PangoLayout_ fpl) =+ withForeignPtr fpl \pl -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_get_pixel_extents pl irct lrct+ (,) <$> (PangoRectanglePixel_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectanglePixel_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_get_pixel_extents" c_pango_layout_get_pixel_extents ::+ Ptr PangoLayout -> Ptr PangoRectanglePixel -> Ptr PangoRectanglePixel -> IO ()++data LayoutSize = LayoutSize {+ layoutSizeWidth :: PangoFixed, layoutSizeHeight :: PangoFixed }+ deriving Show++instance PangoLayoutInfo LayoutSize where+ pangoLayoutInfo = unsafePerformIO . (uncurry LayoutSize <$>) . pangoLayoutGetSize++pangoLayoutGetSize :: PangoLayout -> IO (PangoFixed, PangoFixed)+pangoLayoutGetSize (PangoLayout_ fpl) =+ withForeignPtr fpl \pl -> alloca \pw -> alloca \ph -> do+ c_pango_layout_get_size pl pw ph+ (\w h -> (fromCInt w, fromCInt h)) <$> peek pw <*> peek ph++foreign import ccall "pango_layout_get_size" c_pango_layout_get_size ::+ Ptr PangoLayout -> Ptr CInt -> Ptr CInt -> IO ()++data LayoutPixelSize = LayoutPixelSize {+ layoutPixelSizeWidth :: CInt, layoutPixelSizeHeight :: CInt }+ deriving Show++instance PangoLayoutInfo LayoutPixelSize where+ pangoLayoutInfo = unsafePerformIO . (uncurry LayoutPixelSize <$>) . pangoLayoutGetPixelSize++pangoLayoutGetPixelSize :: PangoLayout -> IO (CInt, CInt)+pangoLayoutGetPixelSize (PangoLayout_ fpl) =+ withForeignPtr fpl \pl -> alloca \w -> alloca \h -> do+ c_pango_layout_get_pixel_size pl w h+ (,) <$> peek w <*> peek h++foreign import ccall "pango_layout_get_pixel_size" c_pango_layout_get_pixel_size ::+ Ptr PangoLayout -> Ptr CInt -> Ptr CInt -> IO ()++newtype Baseline = Baseline PangoFixed deriving Show++instance PangoLayoutInfo Baseline where+ pangoLayoutInfo = unsafePerformIO . (Baseline . fromCInt <$>) . pangoLayoutGetBaseline++pangoLayoutGetBaseline :: PangoLayout -> IO CInt+pangoLayoutGetBaseline (PangoLayout_ fpl) =+ withForeignPtr fpl c_pango_layout_get_baseline++foreign import ccall "pango_layout_get_baseline" c_pango_layout_get_baseline ::+ Ptr PangoLayout -> IO CInt++newtype LineCount = LineCount CInt deriving Show++instance PangoLayoutInfo LineCount where+ pangoLayoutInfo = unsafePerformIO . (LineCount <$>) . pangoLayoutGetLineCount++pangoLayoutGetLineCount :: PangoLayout -> IO CInt+pangoLayoutGetLineCount (PangoLayout_ fpl) =+ withForeignPtr fpl c_pango_layout_get_line_count++foreign import ccall "pango_layout_get_line_count" c_pango_layout_get_line_count ::+ Ptr PangoLayout -> IO CInt++pangoLayoutIndexToPos :: PangoLayout -> Int -> IO (Maybe PangoRectangleFixed)+pangoLayoutIndexToPos (PangoLayout_ fl) idx = withForeignPtr fl \pl -> do+ pos <- mallocBytes #{size PangoRectangle}+ t <- c_pango_layout_get_text pl+ is <- byteIndices =<< toCStringLen t+ case is `maybeIndex` idx of+ Nothing -> pure Nothing+ Just i -> do+ c_pango_layout_index_to_pos pl (fromIntegral i) pos+ Just . PangoRectangleFixed_ <$> newForeignPtr pos (free pos)++maybeIndex :: [a] -> Int -> Maybe a+maybeIndex _ i | i < 0 = Nothing+maybeIndex [] _ = Nothing+maybeIndex (x : _) 0 = Just x+maybeIndex (_ : xs) i = maybeIndex xs (i - 1)++foreign import ccall "pango_layout_index_to_pos" c_pango_layout_index_to_pos ::+ Ptr PangoLayout -> CInt -> Ptr PangoRectangleFixed -> IO ()++pangoLayoutIndexToLineX :: PangoLayout -> Int -> Bool -> IO (Maybe (CInt, PangoFixed))+pangoLayoutIndexToLineX (PangoLayout_ fpl) idx tr =+ withForeignPtr fpl \pl -> alloca \ln -> alloca \xpos -> do+ t <- c_pango_layout_get_text pl+ is <- byteIndices =<< toCStringLen t+ case is `maybeIndex` idx of+ Nothing -> pure Nothing+ Just i -> do+ c_pango_layout_index_to_line_x pl (fromIntegral i) (boolToGboolean tr) ln xpos+ Just <$> ((,) <$> peek ln <*> (fromCInt <$> peek xpos))++foreign import ccall "pango_layout_index_to_line_x"+ c_pango_layout_index_to_line_x ::+ Ptr PangoLayout -> CInt -> #{type gboolean} -> Ptr CInt -> Ptr CInt -> IO ()++pangoLayoutXyToIndex :: PangoLayout -> PangoFixed -> PangoFixed -> IO (Int, CInt, Bool)+pangoLayoutXyToIndex (PangoLayout_ fpl) x_ y_ =+ withForeignPtr fpl \pl -> alloca \idx -> alloca \tr -> do+ t <- c_pango_layout_get_text pl+ is <- byteIndices =<< toCStringLen t+ isd <- c_pango_layout_xy_to_index pl x y idx tr+ (,,) <$> (fromJust . (`elemIndex` is) . fromIntegral <$> peek idx) <*> peek tr <*> pure (gbooleanToBool isd)+ where+ [x, y] = toCInt <$> [x_, y_]++foreign import ccall "pango_layout_xy_to_index" c_pango_layout_xy_to_index ::+ Ptr PangoLayout -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO #type gboolean++pangoLayoutGetCursorPos :: PangoLayout -> Int -> IO (Maybe (PangoRectangleFixed, PangoRectangleFixed))+pangoLayoutGetCursorPos (PangoLayout_ fpl) idx = withForeignPtr fpl \pl -> do+ spos <- mallocBytes #{size PangoRectangle}+ wpos <- mallocBytes #{size PangoRectangle}+ t <- c_pango_layout_get_text pl+ is <- byteIndices =<< toCStringLen t+ case is `maybeIndex` idx of+ Nothing -> pure Nothing+ Just i -> do+ c_pango_layout_get_cursor_pos pl (fromIntegral i) spos wpos+ (Just <$>) $ (,)+ <$> (PangoRectangleFixed_ <$> newForeignPtr spos (free spos))+ <*> (PangoRectangleFixed_ <$> newForeignPtr wpos (free wpos))++foreign import ccall "pango_layout_get_cursor_pos" c_pango_layout_get_cursor_pos ::+ Ptr PangoLayout -> CInt -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()++data MinMax a = Min | Jst a | Max deriving Show+data Dir = L | R deriving Show++pangoLayoutMoveCursorVisually ::+ PangoLayout -> Bool -> Int -> Bool -> Dir -> IO (Maybe (MinMax Int, CInt))+pangoLayoutMoveCursorVisually (PangoLayout_ fpl) str oidx otr dir =+ withForeignPtr fpl \pl -> alloca \nidx -> alloca \ntr -> do+ t <- c_pango_layout_get_text pl+ is <- byteIndices =<< toCStringLen t+ case is `maybeIndex` oidx of+ Nothing -> pure Nothing+ Just i -> do+ c_pango_layout_move_cursor_visually pl+ (boolToGboolean str) (fromIntegral i) (bool 0 1 otr)+ (case dir of L -> - 1; R -> 1) nidx ntr+ nidx' <- peek nidx+ let mnidx = case nidx of+ _ | nidx' < 0 -> Min+ | nidx' < maxBound -> Jst . fromJust . (`elemIndex` is) $ fromIntegral nidx'+ | otherwise -> Max+ ntr' <- peek ntr+ pure . Just $ (mnidx, ntr')++foreign import ccall "pango_layout_move_cursor_visually" c_pango_layout_move_cursor_visually ::+ Ptr PangoLayout -> #{type gboolean} -> CInt -> CInt -> CInt ->+ Ptr CInt -> Ptr CInt -> IO ()
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutIter.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayoutIter (+ -- * TYPE+ PangoLayoutIter,++ -- * GET ITERATOR+ pangoLayoutGetIter,++ -- * NEXT+ pangoLayoutIterNextRun, pangoLayoutIterNextChar,+ pangoLayoutIterNextCluster, pangoLayoutIterNextLine,+ pangoLayoutIterAtLastLine,++ -- * GET FROM ITERATOR+ -- ** Get Index and Baseline+ pangoLayoutIterGetIndex, pangoLayoutIterGetBaseline,++ -- ** Get Run and Line+ pangoLayoutIterGetRun, pangoLayoutIterGetLine,++ -- ** Get Extents+ pangoLayoutIterGetCharExtents, pangoLayoutIterGetClusterExtents,+ pangoLayoutIterGetRunExtents,+ pangoLayoutIterGetLineYrange, pangoLayoutIterGetLineExtents ) where++import Graphics.Pango.Basic.LayoutObjects.PangoLayoutIter.Internal
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutIter/Internal.hsc view
@@ -0,0 +1,196 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayoutIter.Internal (+ -- * TYPE+ PangoLayoutIter(..),++ -- * GET ITERATOR+ pangoLayoutGetIter,++ -- * NEXT+ pangoLayoutIterNextRun, pangoLayoutIterNextChar,+ pangoLayoutIterNextCluster, pangoLayoutIterNextLine,+ pangoLayoutIterAtLastLine,++ -- * GET FROM ITERATOR+ -- ** Get Index and Baseline+ pangoLayoutIterGetIndex, pangoLayoutIterGetBaseline,++ -- ** Get Run and Line+ pangoLayoutIterGetRun, pangoLayoutIterGetLine,++ -- ** Get Extents+ pangoLayoutIterGetCharExtents, pangoLayoutIterGetClusterExtents,+ pangoLayoutIterGetRunExtents,+ pangoLayoutIterGetLineYrange, pangoLayoutIterGetLineExtents ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Data.Int++import System.GLib.Bool+import Graphics.Pango.Basic.GlyphStorage.Internal+import Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal+import Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine.Internal++#include <pango/pango.h>++newtype PangoLayoutIter = PangoLayoutIter (ForeignPtr PangoLayoutIter)+ deriving Show++makePangoLayoutIter :: ForeignPtr PangoLayout -> Ptr PangoLayoutIter -> IO PangoLayoutIter+makePangoLayoutIter fl p =+ PangoLayoutIter <$> newForeignPtr p (c_pango_layout_iter_free p >> touchForeignPtr fl)++foreign import ccall "pango_layout_iter_free" c_pango_layout_iter_free ::+ Ptr PangoLayoutIter -> IO ()++pangoLayoutGetIter :: PangoLayout -> IO PangoLayoutIter+pangoLayoutGetIter (PangoLayout_ fl) =+ makePangoLayoutIter fl =<< withForeignPtr fl c_pango_layout_get_iter++foreign import ccall "pango_layout_get_iter" c_pango_layout_get_iter ::+ Ptr PangoLayout -> IO (Ptr PangoLayoutIter)++pangoLayoutIterNextRun :: PangoLayoutIter -> IO Bool+pangoLayoutIterNextRun (PangoLayoutIter fli) =+ gbooleanToBool <$> withForeignPtr fli c_pango_layout_iter_next_run++foreign import ccall "pango_layout_iter_next_run"+ c_pango_layout_iter_next_run ::+ Ptr PangoLayoutIter -> IO #type gboolean++pangoLayoutIterNextChar :: PangoLayoutIter -> IO Bool+pangoLayoutIterNextChar (PangoLayoutIter fli) =+ gbooleanToBool <$> withForeignPtr fli c_pango_layout_iter_next_char++foreign import ccall "pango_layout_iter_next_char"+ c_pango_layout_iter_next_char ::+ Ptr PangoLayoutIter -> IO #type gboolean++pangoLayoutIterNextCluster :: PangoLayoutIter -> IO Bool+pangoLayoutIterNextCluster (PangoLayoutIter fli) =+ gbooleanToBool <$> withForeignPtr fli c_pango_layout_iter_next_cluster++foreign import ccall "pango_layout_iter_next_cluster"+ c_pango_layout_iter_next_cluster ::+ Ptr PangoLayoutIter -> IO #type gboolean++pangoLayoutIterNextLine :: PangoLayoutIter -> IO Bool+pangoLayoutIterNextLine (PangoLayoutIter fli) =+ gbooleanToBool <$> withForeignPtr fli c_pango_layout_iter_next_line++foreign import ccall "pango_layout_iter_next_line"+ c_pango_layout_iter_next_line ::+ Ptr PangoLayoutIter -> IO #type gboolean++pangoLayoutIterAtLastLine :: PangoLayoutIter -> IO Bool+pangoLayoutIterAtLastLine (PangoLayoutIter fli) =+ gbooleanToBool <$> withForeignPtr fli c_pango_layout_iter_at_last_line++foreign import ccall "pango_layout_iter_at_last_line"+ c_pango_layout_iter_at_last_line ::+ Ptr PangoLayoutIter -> IO #type gboolean++pangoLayoutIterGetIndex :: PangoLayoutIter -> IO CInt+pangoLayoutIterGetIndex (PangoLayoutIter fli) =+ withForeignPtr fli c_pango_layout_iter_get_index++foreign import ccall "pango_layout_iter_get_index"+ c_pango_layout_iter_get_index ::+ Ptr PangoLayoutIter -> IO CInt++pangoLayoutIterGetBaseline :: PangoLayoutIter -> IO CInt+pangoLayoutIterGetBaseline (PangoLayoutIter fli) =+ withForeignPtr fli c_pango_layout_iter_get_baseline++foreign import ccall "pango_layout_iter_get_baseline"+ c_pango_layout_iter_get_baseline ::+ Ptr PangoLayoutIter -> IO CInt++pangoLayoutIterGetRun :: PangoLayoutIter -> IO (Maybe PangoLayoutRun)+pangoLayoutIterGetRun (PangoLayoutIter fli) = mkPangoGlyphItemMaybe0+ =<< withForeignPtr fli c_pango_layout_iter_get_run++foreign import ccall "pango_layout_iter_get_run" c_pango_layout_iter_get_run ::+ Ptr PangoLayoutIter -> IO (Ptr PangoLayoutRun)++pangoLayoutIterGetLine :: PangoLayoutIter -> IO PangoLayoutLine+pangoLayoutIterGetLine (PangoLayoutIter fli) =+ makePangoLayoutLine' fli =<< withForeignPtr fli c_pango_layout_iter_get_line++makePangoLayoutLine' :: ForeignPtr PangoLayoutIter -> Ptr PangoLayoutLine -> IO PangoLayoutLine+makePangoLayoutLine' fli p = PangoLayoutLine <$> newForeignPtr p (touchForeignPtr fli)++foreign import ccall "pango_layout_iter_get_line"+ c_pango_layout_iter_get_line ::+ Ptr PangoLayoutIter -> IO (Ptr PangoLayoutLine)++pangoLayoutIterGetCharExtents :: PangoLayoutIter -> IO PangoRectangleFixed+pangoLayoutIterGetCharExtents (PangoLayoutIter fli) =+ withForeignPtr fli \pli -> do+ rct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_iter_get_char_extents pli rct+ PangoRectangleFixed_ <$> newForeignPtr rct (free rct)++foreign import ccall "pango_layout_iter_get_char_extents"+ c_pango_layout_iter_get_char_extents ::+ Ptr PangoLayoutIter -> Ptr PangoRectangleFixed -> IO ()++pangoLayoutIterGetClusterExtents ::+ PangoLayoutIter -> IO (PangoRectangleFixed, PangoRectangleFixed)+pangoLayoutIterGetClusterExtents (PangoLayoutIter fli) =+ withForeignPtr fli \pli -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_iter_get_cluster_extents pli irct lrct+ (,) <$> (PangoRectangleFixed_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectangleFixed_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_iter_get_cluster_extents"+ c_pango_layout_iter_get_cluster_extents ::+ Ptr PangoLayoutIter -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()++pangoLayoutIterGetRunExtents ::+ PangoLayoutIter -> IO (PangoRectangleFixed, PangoRectangleFixed)+pangoLayoutIterGetRunExtents (PangoLayoutIter fli) =+ withForeignPtr fli \pli -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_iter_get_run_extents pli irct lrct+ (,) <$> (PangoRectangleFixed_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectangleFixed_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_iter_get_run_extents"+ c_pango_layout_iter_get_run_extents ::+ Ptr PangoLayoutIter -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()++pangoLayoutIterGetLineYrange :: PangoLayoutIter -> IO (CInt, CInt)+pangoLayoutIterGetLineYrange (PangoLayoutIter fli) =+ withForeignPtr fli \pli -> alloca \y0 -> alloca \y1 -> do+ c_pango_layout_iter_get_line_yrange pli y0 y1+ (,) <$> peek y0 <*> peek y1++foreign import ccall "pango_layout_iter_get_line_yrange"+ c_pango_layout_iter_get_line_yrange ::+ Ptr PangoLayoutIter -> Ptr CInt -> Ptr CInt -> IO ()++pangoLayoutIterGetLineExtents ::+ PangoLayoutIter -> IO (PangoRectangleFixed, PangoRectangleFixed)+pangoLayoutIterGetLineExtents (PangoLayoutIter fli) =+ withForeignPtr fli \pli -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_iter_get_line_extents pli irct lrct+ (,) <$> (PangoRectangleFixed_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectangleFixed_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_iter_get_line_extents"+ c_pango_layout_iter_get_line_extents ::+ Ptr PangoLayoutIter -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutLine.hsc view
@@ -0,0 +1,16 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine (++ -- * TYPE+ PangoLayoutLine,++ -- * GET LINE+ pangoLayoutGetLine, pangoLayoutGetLines,++ -- * GET FROM LINE+ pangoLayoutLineGetExtents, pangoLayoutLineGetPixelExtents,+ pangoLayoutLineIndexToX, pangoLayoutLineXToIndex,+ pangoLayoutLineGetXRanges ) where++import Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine.Internal
+ src/Graphics/Pango/Basic/LayoutObjects/PangoLayoutLine/Internal.hsc view
@@ -0,0 +1,117 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine.Internal (++ -- * TYPE+ PangoLayoutLine(..),++ -- * GET LINE+ pangoLayoutGetLine, pangoLayoutGetLines,++ -- * GET FROM LINE+ pangoLayoutLineGetExtents, pangoLayoutLineGetPixelExtents,+ pangoLayoutLineIndexToX, pangoLayoutLineXToIndex,+ pangoLayoutLineGetXRanges ) where++import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Data.Int++import System.GLib.Bool+import Graphics.Pango.Basic.GlyphStorage.Internal+import Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal+import System.GLib.SinglyLinkedLists++#include <pango/pango.h>++pangoLayoutGetLine :: PangoLayout -> CInt -> IO (Maybe PangoLayoutLine)+pangoLayoutGetLine (PangoLayout_ fl) ln = makePangoLayoutLineMaybe fl+ =<< withForeignPtr fl \pl -> c_pango_layout_get_line pl ln++foreign import ccall "pango_layout_get_line" c_pango_layout_get_line ::+ Ptr PangoLayout -> CInt -> IO (Ptr PangoLayoutLine)++newtype PangoLayoutLine = PangoLayoutLine (ForeignPtr PangoLayoutLine) deriving Show++makePangoLayoutLine :: ForeignPtr PangoLayout -> Ptr PangoLayoutLine -> IO PangoLayoutLine+makePangoLayoutLine fl p = PangoLayoutLine <$> newForeignPtr p (touchForeignPtr fl)++makePangoLayoutLineMaybe :: ForeignPtr PangoLayout -> Ptr PangoLayoutLine -> IO (Maybe PangoLayoutLine)+makePangoLayoutLineMaybe fl = \case+ NullPtr -> pure Nothing+ p -> Just . PangoLayoutLine+ <$> newForeignPtr p (touchForeignPtr fl)++pangoLayoutGetLines :: PangoLayout -> IO [PangoLayoutLine]+pangoLayoutGetLines (PangoLayout_ fl) = withForeignPtr fl \pl ->+ (makePangoLayoutLine fl `mapM`) =<< g_slist_to_list =<< c_pango_layout_get_lines pl++foreign import ccall "pango_layout_get_lines" c_pango_layout_get_lines ::+ Ptr PangoLayout -> IO (Ptr (GSList PangoLayoutLine))++pangoLayoutLineGetExtents :: PangoLayoutLine -> IO Extents+pangoLayoutLineGetExtents (PangoLayoutLine fll) =+ withForeignPtr fll \pll -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_line_get_extents pll irct lrct+ Extents <$> (PangoRectangleFixed_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectangleFixed_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_line_get_extents"+ c_pango_layout_line_get_extents ::+ Ptr PangoLayoutLine -> Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO ()++pangoLayoutLineGetPixelExtents :: PangoLayoutLine -> IO PixelExtents+pangoLayoutLineGetPixelExtents (PangoLayoutLine fpll) =+ withForeignPtr fpll \pll -> do+ irct <- mallocBytes #{size PangoRectangle}+ lrct <- mallocBytes #{size PangoRectangle}+ c_pango_layout_line_get_pixel_extents pll irct lrct+ PixelExtents+ <$> (PangoRectanglePixel_ <$> newForeignPtr irct (free irct))+ <*> (PangoRectanglePixel_ <$> newForeignPtr lrct (free lrct))++foreign import ccall "pango_layout_line_get_pixel_extents"+ c_pango_layout_line_get_pixel_extents ::+ Ptr PangoLayoutLine ->+ Ptr PangoRectanglePixel -> Ptr PangoRectanglePixel -> IO ()++pangoLayoutLineIndexToX :: PangoLayoutLine -> CInt -> Bool -> IO CInt+pangoLayoutLineIndexToX (PangoLayoutLine fpll) idx trl =+ withForeignPtr fpll \pll -> alloca \xpos -> do+ c_pango_layout_line_index_to_x pll idx (boolToGboolean trl) xpos+ peek xpos++foreign import ccall "pango_layout_line_index_to_x"+ c_pango_layout_line_index_to_x ::+ Ptr PangoLayoutLine -> CInt -> #{type gboolean} -> Ptr CInt -> IO ()++pangoLayoutLineXToIndex :: PangoLayoutLine -> CInt -> IO (CInt, CInt, Bool)+pangoLayoutLineXToIndex (PangoLayoutLine fpll) xpos =+ withForeignPtr fpll \pll -> alloca \idx -> alloca \trl -> do+ isd <- c_pango_layout_line_x_to_index pll xpos idx trl+ (,,) <$> peek idx <*> peek trl <*> pure (gbooleanToBool isd)++foreign import ccall "pango_layout_line_x_to_index"+ c_pango_layout_line_x_to_index ::+ Ptr PangoLayoutLine -> CInt -> Ptr CInt -> Ptr CInt -> IO #type gboolean++pangoLayoutLineGetXRanges :: PangoLayoutLine -> CInt -> CInt -> IO [CInt]+pangoLayoutLineGetXRanges (PangoLayoutLine fpll) st ed =+ withForeignPtr fpll \pll -> alloca \prngs -> alloca \pn -> do+ c_pango_layout_line_get_x_ranges pll st ed prngs pn+ rngs <- peek prngs+ n <- peek pn+ peekArray (fromIntegral $ 2 * n) rngs <* c_g_free rngs++foreign import ccall "pango_layout_line_get_x_ranges" c_pango_layout_line_get_x_ranges ::+ Ptr PangoLayoutLine -> CInt -> CInt -> Ptr (Ptr CInt) -> Ptr CInt -> IO ()++foreign import ccall "g_free" c_g_free :: Ptr a -> IO ()
+ src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoLanguage.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage (+ -- * TYPE+ PangoLanguage, pattern PangoLanguage, getPangoLanguage,++ -- * FUNCTION+ pangoLanguageMatches, pangoLanguageIncludesScript,+ pangoLanguageGetScripts, pangoLanguageGetDefault,+ pangoLanguageGetSampleString ) where++import Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage.Internal
+ src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoLanguage/Internal.hsc view
@@ -0,0 +1,103 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage.Internal (+ -- * TYPE+ PangoLanguage(..), pattern PangoLanguage, getPangoLanguage,++ -- * FUNCTION+ pangoLanguageMatches, pangoLanguageIncludesScript,+ pangoLanguageGetScripts, pangoLanguageGetDefault,+ pangoLanguageGetSampleString ) where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Data.Int+import Data.Text.CString+import Text.Read+import System.IO.Unsafe++import Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum++import qualified Data.Text as T++#include <pango/pango.h>++pangoLanguageGetDefault :: IO PangoLanguage+pangoLanguageGetDefault = PangoLanguage_ <$> c_pango_language_get_default++foreign import ccall "pango_language_get_default"+ c_pango_language_get_default :: IO (Ptr PangoLanguage)++pangoLanguageGetSampleString :: PangoLanguage -> T.Text+pangoLanguageGetSampleString (PangoLanguage_ pl) = unsafePerformIO+ $ peekCStringText =<< c_pango_language_get_sample_string pl++foreign import ccall "pango_language_get_sample_string"+ c_pango_language_get_sample_string :: Ptr PangoLanguage -> IO CString++pangoLanguageMatches :: PangoLanguage -> String -> Bool+pangoLanguageMatches (PangoLanguage_ l) rl = unsafePerformIO+ $ withCString rl \crl -> (<$> c_pango_language_matches l crl) \case+ #{const FALSE} -> False; #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_language_matches" c_pango_language_matches ::+ Ptr PangoLanguage -> CString -> IO #{type gboolean}++pangoLanguageIncludesScript :: PangoLanguage -> PangoScript -> Bool+pangoLanguageIncludesScript (PangoLanguage_ l) (PangoScript s) = unsafePerformIO+ $ (<$> c_pango_language_includes_script l s) \case+ #{const FALSE} -> False; #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_language_includes_script" c_pango_language_includes_script ::+ Ptr PangoLanguage -> #{type PangoScript} -> IO #{type gboolean}++pangoLanguageGetScripts :: PangoLanguage -> [PangoScript]+pangoLanguageGetScripts (PangoLanguage_ l) = unsafePerformIO+ $ (PangoScript <$>) <$> alloca \pn -> do+ ss <- c_pango_language_get_scripts l pn+ n <- peek pn+ peekArray (fromIntegral n) ss++foreign import ccall "pango_language_get_scripts" c_pango_language_get_scripts ::+ Ptr PangoLanguage -> Ptr CInt -> IO (Ptr #{type PangoScript})++newtype PangoLanguage = PangoLanguage_ (Ptr PangoLanguage)++instance Show PangoLanguage where+ showsPrec d l = showParen (d > 10)+ $ ("PangoLanguage " ++) . (show (pangoLanguageToString l) ++)++instance Read PangoLanguage where+ readPrec = parens $ prec appPrec do+ Ident "PangoLanguage" <- lexP+ s <- step readPrec+ pure $ PangoLanguage s+ where appPrec = 10++{-# COMPLETE PangoLanguage #-}++pattern PangoLanguage :: String -> PangoLanguage+pattern PangoLanguage { getPangoLanguage }+ <- (pangoLanguageToString -> getPangoLanguage) where+ PangoLanguage s = pangoLanguageFromString s++pangoLanguageToString :: PangoLanguage -> String+pangoLanguageToString (PangoLanguage_ pl) =+ unsafePerformIO $ peekCString =<< c_pango_language_to_string pl++foreign import ccall "pango_language_to_string"+ c_pango_language_to_string :: Ptr PangoLanguage -> IO CString++pangoLanguageFromString :: String -> PangoLanguage+pangoLanguageFromString l = unsafePerformIO $ withCString l \cl ->+ PangoLanguage_ <$> c_pango_language_from_string cl++foreign import ccall "pango_language_from_string"+ c_pango_language_from_string :: CString -> IO (Ptr PangoLanguage)
+ src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript.hsc view
@@ -0,0 +1,9 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript (+ module Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Internal+ ) where++import Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Internal hiding (+ pattern PangoScript )
+ src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript/Enum.hsc view
@@ -0,0 +1,141 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum where++import Foreign.C.Enum+import Data.Int++#include <pango/pango.h>++enum "PangoScript" ''#{type PangoScript} [''Show, ''Read] [+ ("PangoScriptInvaludCode", #{const PANGO_SCRIPT_INVALID_CODE}),+ ("PangoScriptCommon", #{const PANGO_SCRIPT_COMMON}),+ ("PangoScriptInherited", #{const PANGO_SCRIPT_INHERITED}),++ ("PangoScriptArabic", #{const PANGO_SCRIPT_ARABIC}),+ ("PangoScriptArmenian", #{const PANGO_SCRIPT_ARMENIAN}),+ ("PangoScriptBengali", #{const PANGO_SCRIPT_BENGALI}),+ ("PangoScriptBopomofo", #{const PANGO_SCRIPT_BOPOMOFO}),+ ("PangoScriptCherokee", #{const PANGO_SCRIPT_CHEROKEE}),+ ("PangoScriptCoptic", #{const PANGO_SCRIPT_COPTIC}),+ ("PangoScriptCyrillic", #{const PANGO_SCRIPT_CYRILLIC}),+ ("PangoScriptDeseret", #{const PANGO_SCRIPT_DESERET}),+ ("PangoScriptDevanagari", #{const PANGO_SCRIPT_DEVANAGARI}),+ ("PangoScriptEthiopic", #{const PANGO_SCRIPT_ETHIOPIC}),+ ("PangoScriptGeorgian", #{const PANGO_SCRIPT_GEORGIAN}),+ ("PangoScriptGothic", #{const PANGO_SCRIPT_GOTHIC}),+ ("PangoScriptGreek", #{const PANGO_SCRIPT_GREEK}),+ ("PangoScriptGujarati", #{const PANGO_SCRIPT_GUJARATI}),+ ("PangoScriptGurmukhi", #{const PANGO_SCRIPT_GURMUKHI}),+ ("PangoScriptHan", #{const PANGO_SCRIPT_HAN}),+ ("PangoScriptHangul", #{const PANGO_SCRIPT_HANGUL}),+ ("PangoScriptHebrew", #{const PANGO_SCRIPT_HEBREW}),+ ("PangoScriptHiragana", #{const PANGO_SCRIPT_HIRAGANA}),+ ("PangoScriptKannada", #{const PANGO_SCRIPT_KANNADA}),+ ("PangoScriptKatakana", #{const PANGO_SCRIPT_KATAKANA}),+ ("PangoScriptKhmer", #{const PANGO_SCRIPT_KHMER}),+ ("PangoScriptLao", #{const PANGO_SCRIPT_LAO}),+ ("PangoScriptLatin", #{const PANGO_SCRIPT_LATIN}),+ ("PangoScriptMalaylam", #{const PANGO_SCRIPT_MALAYALAM}),+ ("PangoScriptMongolian", #{const PANGO_SCRIPT_MONGOLIAN}),+ ("PangoScriptMyanmar", #{const PANGO_SCRIPT_MYANMAR}),+ ("PangoScriptOgham", #{const PANGO_SCRIPT_OGHAM}),+ ("PangoScriptOldItalic", #{const PANGO_SCRIPT_OLD_ITALIC}),+ ("PangoScriptOriya", #{const PANGO_SCRIPT_ORIYA}),+ ("PangoScriptRunic", #{const PANGO_SCRIPT_RUNIC}),+ ("PangoScriptSinhala", #{const PANGO_SCRIPT_SINHALA}),+ ("PangoScriptSyriac", #{const PANGO_SCRIPT_SYRIAC}),+ ("PangoScriptTamil", #{const PANGO_SCRIPT_TAMIL}),+ ("PangoScriptTelugu", #{const PANGO_SCRIPT_TELUGU}),+ ("PangoScriptThaana", #{const PANGO_SCRIPT_THAANA}),+ ("PangoScriptThai", #{const PANGO_SCRIPT_THAI}),+ ("PangoScriptTibetan", #{const PANGO_SCRIPT_TIBETAN}),+ ("PangoScriptCanadianAboriginal",+ #{const PANGO_SCRIPT_CANADIAN_ABORIGINAL}),+ ("PangoScriptYi", #{const PANGO_SCRIPT_YI}),+ ("PangoScriptTagalog", #{const PANGO_SCRIPT_TAGALOG}),+ ("PangoScriptHanunoo", #{const PANGO_SCRIPT_HANUNOO}),+ ("PangoScriptBuhid", #{const PANGO_SCRIPT_BUHID}),+ ("PangoScriptTagbanwa", #{const PANGO_SCRIPT_TAGBANWA}),+ ("PangoScriptBraille", #{const PANGO_SCRIPT_BRAILLE}),+ ("PangoScriptCypriot", #{const PANGO_SCRIPT_CYPRIOT}),+ ("PangoScriptLimbu", #{const PANGO_SCRIPT_LIMBU}),+ ("PangoScriptOsmanya", #{const PANGO_SCRIPT_OSMANYA}),+ ("PangoscriptShavian", #{const PANGO_SCRIPT_SHAVIAN}),+ ("PangoScriptLinearB", #{const PANGO_SCRIPT_LINEAR_B}),+ ("PangoScriptTaiLe", #{const PANGO_SCRIPT_TAI_LE}),+ ("PangoScriptUgaritic", #{const PANGO_SCRIPT_UGARITIC}),++ ("PangoScriptNewTaiLue", #{const PANGO_SCRIPT_NEW_TAI_LUE}),+ ("PangoScriptBuginese", #{const PANGO_SCRIPT_BUGINESE}),+ ("PangoScriptGlagolitic", #{const PANGO_SCRIPT_GLAGOLITIC}),+ ("PangoScriptTifinagh", #{const PANGO_SCRIPT_TIFINAGH}),+ ("PangoScriptSylotiNagri", #{const PANGO_SCRIPT_SYLOTI_NAGRI}),+ ("PangoScriptOldPersian", #{const PANGO_SCRIPT_OLD_PERSIAN}),+ ("PangoScriptKharoshthi", #{const PANGO_SCRIPT_KHAROSHTHI}),++ ("PangoScriptUnknown", #{const PANGO_SCRIPT_UNKNOWN}),+ ("PangoScriptBalinese", #{const PANGO_SCRIPT_BALINESE}),+ ("PangoScriptCuneiform", #{const PANGO_SCRIPT_CUNEIFORM}),+ ("PangoScriptPhoenician", #{const PANGO_SCRIPT_PHOENICIAN}),+ ("PangoScriptPhagsPa", #{const PANGO_SCRIPT_PHAGS_PA}),+ ("PangoScriptNko", #{const PANGO_SCRIPT_NKO}),++ ("PangoScriptKyahLi", #{const PANGO_SCRIPT_KAYAH_LI}),+ ("PangoScriptLepcha", #{const PANGO_SCRIPT_LEPCHA}),+ ("PangoScriptRejang", #{const PANGO_SCRIPT_REJANG}),+ ("PangoScriptSundanese", #{const PANGO_SCRIPT_SUNDANESE}),+ ("PangoScriptSaurashtra", #{const PANGO_SCRIPT_SAURASHTRA}),+ ("PangoScriptCham", #{const PANGO_SCRIPT_CHAM}),+ ("PangoScriptOlChiki", #{const PANGO_SCRIPT_OL_CHIKI}),+ ("PangoScriptVai", #{const PANGO_SCRIPT_VAI}),+ ("PangoScriptCarian", #{const PANGO_SCRIPT_CARIAN}),+ ("PangoScriptLycian", #{const PANGO_SCRIPT_LYCIAN}),+ ("PangoScriptLydian", #{const PANGO_SCRIPT_LYDIAN}),++ ("PangoScriptBatak", #{const PANGO_SCRIPT_BATAK}),+ ("PangoScriptBraham", #{const PANGO_SCRIPT_BRAHMI}),+ ("PangoScriptMandaic", #{const PANGO_SCRIPT_MANDAIC}),+ ("PangoScriptChakma", #{const PANGO_SCRIPT_CHAKMA}),+ ("PangoScriptMeroiticCursive", #{const PANGO_SCRIPT_MEROITIC_CURSIVE}),+ ("PangoScriptMeroiticHieroglyphs",+ #{const PANGO_SCRIPT_MEROITIC_HIEROGLYPHS}),+ ("PangoScriptMiao", #{const PANGO_SCRIPT_MIAO}),+ ("PangoScriptSharada", #{const PANGO_SCRIPT_SHARADA}),+ ("PangoScriptSoraSompeng", #{const PANGO_SCRIPT_SORA_SOMPENG}),+ ("PangoScriptTakri", #{const PANGO_SCRIPT_TAKRI}),++ ("PangoScriptBassaVah", #{const PANGO_SCRIPT_BASSA_VAH}),+ ("PangoScriptCaucasianAlbanian",+ #{const PANGO_SCRIPT_CAUCASIAN_ALBANIAN}),+ ("PangoScriptDuployan", #{const PANGO_SCRIPT_DUPLOYAN}),+ ("PangoScriptElbasan", #{const PANGO_SCRIPT_ELBASAN}),+ ("PangoScriptGrantha", #{const PANGO_SCRIPT_GRANTHA}),+ ("PangoScriptKhojki", #{const PANGO_SCRIPT_KHOJKI}),+ ("PangoScriptKhudawadi", #{const PANGO_SCRIPT_KHUDAWADI}),+ ("PangoScriptLinearA", #{const PANGO_SCRIPT_LINEAR_A}),+ ("PangoScriptMahajani", #{const PANGO_SCRIPT_MAHAJANI}),+ ("PangoScriptManichaean", #{const PANGO_SCRIPT_MANICHAEAN}),+ ("PangoScriptMendeKikakui", #{const PANGO_SCRIPT_MENDE_KIKAKUI}),+ ("PangoScriptModi", #{const PANGO_SCRIPT_MODI}),+ ("PangoScriptMro", #{const PANGO_SCRIPT_MRO}),+ ("PangoScriptNabataean", #{const PANGO_SCRIPT_NABATAEAN}),+ ("PangoScriptOldNorthArabian", #{const PANGO_SCRIPT_OLD_NORTH_ARABIAN}),+ ("PangoScriptOldPermic", #{const PANGO_SCRIPT_OLD_PERMIC}),+ ("PangoScriptPahawhHmong", #{const PANGO_SCRIPT_PAHAWH_HMONG}),+ ("PangoScriptPalmyrene", #{const PANGO_SCRIPT_PALMYRENE}),+ ("PangoScriptPauCinHau", #{const PANGO_SCRIPT_PAU_CIN_HAU}),+ ("PangoScriptPsalterPahlavi", #{const PANGO_SCRIPT_PSALTER_PAHLAVI}),+ ("PangoScriptSiddham", #{const PANGO_SCRIPT_SIDDHAM}),+ ("PangoScriptTirhuta", #{const PANGO_SCRIPT_TIRHUTA}),+ ("PangoScriptWarangCiti", #{const PANGO_SCRIPT_WARANG_CITI}),+ ("PangoScriptAhom", #{const PANGO_SCRIPT_AHOM}),+ ("PangoScriptAnatolianHieroglyphs",+ #{const PANGO_SCRIPT_ANATOLIAN_HIEROGLYPHS}),+ ("PangoScriptHatran", #{const PANGO_SCRIPT_HATRAN}),+ ("PangoScriptMultani", #{const PANGO_SCRIPT_MULTANI}),+ ("PangoScriptOldHungarian", #{const PANGO_SCRIPT_OLD_HUNGARIAN}),+ ("PangoScriptSignwriting", #{const PANGO_SCRIPT_SIGNWRITING}) ]
+ src/Graphics/Pango/Basic/ScriptsAndLanguages/PangoScript/Internal.hsc view
@@ -0,0 +1,95 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Internal (+ -- * FUNCTION+ pangoScriptForUnichar, pangoScriptGetSampleLanguage, pangoScriptForText,+ -- * ENUM+ module Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum,+ ) where++import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Control.Exception+import Data.Traversable+import Data.Bool+import Data.Word+import Data.Int+import Data.Char+import System.IO.Unsafe++import Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage.Internal+import Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum++import qualified Data.Text as T+import qualified Data.Text.Foreign as T+import qualified Data.Text.Foreign.StringPartial as T++#include <pango/pango.h>++pangoScriptForUnichar :: Char -> PangoScript+pangoScriptForUnichar c = unsafePerformIO+ $ PangoScript <$> c_pango_script_for_unichar (fromIntegral $ ord c)++foreign import ccall "pango_script_for_unichar" c_pango_script_for_unichar ::+ #{type gunichar} -> IO #{type PangoScript}++pangoScriptGetSampleLanguage :: PangoScript -> IO (Maybe PangoLanguage)+pangoScriptGetSampleLanguage (PangoScript s) =+ nullable Nothing (Just . PangoLanguage_)+ <$> c_pango_script_get_sample_language s++foreign import ccall "pango_script_get_sample_language"+ c_pango_script_get_sample_language ::+ #{type PangoScript} -> IO (Ptr PangoLanguage)++pattern NullPtr :: Ptr a+pattern NullPtr <- ((== nullPtr) -> True) where NullPtr = nullPtr++nullable :: b -> (Ptr a -> b) -> Ptr a -> b+nullable d f = \case NullPtr -> d; p -> f p++pangoScriptForText :: T.Text -> [(T.Text, PangoScript)]+pangoScriptForText t = unsafePerformIO $ withPangoScriptIter t \i -> do+ rss <- pangoScriptIterGetRanges i+ for rss \(r, s) -> (, s) <$> T.peekCStringPart r++data PangoScriptIter++withPangoScriptIter :: T.Text -> (Ptr PangoScriptIter -> IO a) -> IO a+withPangoScriptIter t f = T.withCStringLen t \(cs, l) -> bracket+ (c_pango_script_iter_new cs $ fromIntegral l) c_pango_script_iter_free f++foreign import ccall "pango_script_iter_new" c_pango_script_iter_new ::+ CString -> CInt -> IO (Ptr PangoScriptIter)++foreign import ccall "pango_script_iter_free" c_pango_script_iter_free ::+ Ptr PangoScriptIter -> IO ()++pangoScriptIterGetRanges :: Ptr PangoScriptIter -> IO [(T.CStringPart, PangoScript)]+pangoScriptIterGetRanges i = unsafeInterleaveIO do+ rs@(r, _) <- pangoScriptIterGetRange i+ (\r' e f -> T.emptyOrCStringPart e f r') r (pure [])+ $ pangoScriptIterNext i+ >>= bool (pure [rs]) ((rs :) <$> pangoScriptIterGetRanges i)++pangoScriptIterGetRange :: Ptr PangoScriptIter -> IO (T.CStringPart, PangoScript)+pangoScriptIterGetRange i = alloca \st -> alloca \ed -> alloca \s -> do+ c_pango_script_iter_get_range i st ed s+ (,) <$> ((,) <$> peek st <*> peek ed) <*> (PangoScript <$> peek s)++foreign import ccall "pango_script_iter_get_range" c_pango_script_iter_get_range ::+ Ptr PangoScriptIter -> Ptr CString -> Ptr CString -> Ptr #{type PangoScript} -> IO ()++pangoScriptIterNext :: Ptr PangoScriptIter -> IO Bool+pangoScriptIterNext i = (<$> c_pango_script_iter_next i) \case+ #{const FALSE} -> False; #{const TRUE} -> True+ _ -> error "never occur"++foreign import ccall "pango_script_iter_next" c_pango_script_iter_next ::+ Ptr PangoScriptIter -> IO #{type gboolean}
+ src/Graphics/Pango/Basic/TextAttributes.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIOnS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.TextAttributes (+ -- * TYPE+ PangoTextAttrList, PangoTextAttrListPrim,+ pangoTextAttrListNew,+ pangoTextAttrListFreeze, pangoTextAttrListThaw,+ pangoTextAttrListCopy,++ -- * PARSE MARKUP+ pangoParseMarkup, pangoMarkupParserNew, pangoMarkupParserFinish,++ -- * INSERT AN ATTRIBUTE TO PANGO TEXT ATTRIBUTE LIST FOR PRIMITIVE MONAD+ pangoTextAttrListInsert, pangoTextAttrListInsertBefore,+ pangoTextAttrListChange,++ -- * PANGO ATTRIBUTE VALUE+ -- ** Class+ PangoAttributeValue, PangoAttribute, pangoAttrNew,++ -- ** Instance+ -- *** FontDescription+ PangoFontDescriptionPrim,+ pangoAttrFontDescNew,++ -- *** Strikethrough and StrikethroughColor+ Strikethrough(..),+ StrikethroughColor(..),++ -- *** PangoUnderline and UnderlineColor+ PangoUnderline, pattern PangoUnderlineNone,+ pattern PangoUnderlineSingle, pattern PangoUnderlineDouble,+ pattern PangoUnderlineLow, pattern PangoUnderlineError,++ UnderlineColor(..),++ -- *** Shape+ Shape(..),++ -- *** Scale+ Scale(..),++ -- *** Rise+ Rise, pattern Rise,++ -- *** LetterSpacing+ LetterSpacing, pattern LetterSpacing,++ -- *** Color and Alpha of Foreground and Background+ ForegroundColor(..), BackgroundColor(..),+ ForegroundAlpha(..), BackgroundAlpha(..),++ -- * PANGO COLOR+ PangoColor(..), pangoColorParse, pangoColorToString,+ ) where++import Graphics.Pango.Basic.TextAttributes.Internal+import Graphics.Pango.Basic.Fonts.PangoFontDescription
+ src/Graphics/Pango/Basic/TextAttributes/Internal.hsc view
@@ -0,0 +1,650 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.TextAttributes.Internal (+ -- * TYPE+ PangoTextAttrList(..),+ PangoTextAttrListPrim,+ pangoTextAttrListNew,+ pangoTextAttrListFreeze, pangoTextAttrListThaw,+ pangoTextAttrListCopy,++ -- * PARSE MARKUP+ pangoParseMarkup, pangoMarkupParserNew, pangoMarkupParserFinish,++ -- * INSERT AN ATTRIBUTE TO PANGO TEXT ATTRIBUTE LIST FOR PRIMITIVE MONAD+ pangoTextAttrListInsert, pangoTextAttrListInsertBefore,+ pangoTextAttrListChange,++ -- * PANGO ATTRIBUTE VALUE+ -- ** Class+ PangoAttribute, PangoAttributeValue, pangoAttrNew,++ -- ** Instance+ -- *** FontDescription+ pangoAttrFontDescNew,++ -- *** Strikethrough and StrikethroughColor+ Strikethrough(..), StrikethroughColor(..),++ -- *** PangoUnderline and UnderlineColor+ PangoUnderline, pattern PangoUnderlineNone,+ pattern PangoUnderlineSingle, pattern PangoUnderlineDouble,+ pattern PangoUnderlineLow, pattern PangoUnderlineError,+ UnderlineColor(..),++ -- *** Shape+ Shape(..),++ -- *** Scale+ Scale(..),++ -- *** Rise+ Rise, pattern Rise,++ -- *** LetterSpacing+ LetterSpacing, pattern LetterSpacing,++ -- *** Color and Alpha of Foreground and Background+ ForegroundColor(..), BackgroundColor(..),+ ForegroundAlpha(..), BackgroundAlpha(..),++ -- * PANGO COLOR+ PangoColor(..), pangoColorParse, pangoColorToString,++ -- * INTERNAL+ PangoAttrList(..), mkPangoAttrList ) where++import GHC.Stack+import Foreign.Ptr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Foreign.C.String.Utf8+import Foreign.C.String.Misc+import Foreign.C.String.ForeignCStringLen+import Foreign.C.Enum+import Control.Monad.Primitive+import Data.Array+import Data.Bool+import Data.Word+import Data.Int+import Data.Char+import Data.Color+import System.IO.Unsafe++import System.GLib.ErrorReporting+import System.GLib.SimpleXmlSubsetParser++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++import Graphics.Pango.Basic.GlyphStorage.Internal+import Graphics.Pango.Basic.Fonts.PangoFontDescription+import Graphics.Pango.Basic.Fonts.PangoFontDescription.Type+import Graphics.Pango.Basic.ScriptsAndLanguages.PangoLanguage.Internal+import Graphics.Pango.Basic.VerticalText++#include <pango/pango.h>++data PangoTextAttrList = PangoTextAttrList {+ pangoTextAttrListText :: ForeignCStringLen,+ pangoTextAttrListAttrList :: PangoAttrList+ } deriving Show++data PangoAttrList+ = PangoAttrListNull+ | PangoAttrList (ForeignPtr PangoAttrList)+ deriving Show++mkPangoAttrList :: Ptr PangoAttrList -> IO PangoAttrList+mkPangoAttrList p+ | p == nullPtr = pure PangoAttrListNull+ | otherwise = PangoAttrList <$> newForeignPtr p (c_pango_attr_list_unref p)++foreign import ccall "pango_attr_list_unref" c_pango_attr_list_unref ::+ Ptr PangoAttrList -> IO ()++pangoParseMarkup :: T.Text -> Maybe Char -> Either GError (PangoTextAttrList, Maybe Char)+pangoParseMarkup mt am = unsafePerformIO+ $ T.withCStringLen mt \(cmt, cmtl) -> alloca \ppal -> alloca \pt -> alloca \pac -> alloca \pge -> do+ r <- c_pango_parse_markup cmt (fromIntegral cmtl) (toGunichar am) ppal pt pac pge+ pt' <- toCStringLen =<< peek pt+ pt'' <- copyToForeignCStringLen pt'+ case r of+ #{const FALSE} -> Left <$> (mkGError =<< peek pge)+ #{const TRUE} -> (Right <$>) $ (,)+ <$> (PangoTextAttrList pt'' <$> (mkPangoAttrList =<< peek ppal))+ <*> (fromGunichar <$> peek pac)+ _ -> error "never occur"++toGunichar :: Maybe Char -> #{type gunichar}+toGunichar = \case Nothing -> 0; Just c -> fromIntegral $ ord c++fromGunichar :: #{type gunichar} -> Maybe Char+fromGunichar = \case 0 -> Nothing; uc -> Just . chr $ fromIntegral uc++foreign import ccall "pango_parse_markup" c_pango_parse_markup ::+ CString -> CInt -> #{type gunichar} ->+ Ptr (Ptr PangoAttrList) -> Ptr CString -> Ptr #{type gunichar} ->+ Ptr (Ptr GError) -> IO #{type gboolean}++pangoMarkupParserNew :: PrimMonad m => Maybe Char -> m (GMarkupParseContext (PrimState m))+pangoMarkupParserNew am = unsafeIOToPrim+ $ mkGMarkupParseContext =<< c_pango_markup_parser_new (toGunichar am)++foreign import ccall "pango_markup_parser_new" c_pango_markup_parser_new ::+ #{type gunichar} -> IO (Ptr (GMarkupParseContext s))++pangoMarkupParserFinish :: PrimMonad m => GMarkupParseContext (PrimState m) ->+ m (Either GError (PangoTextAttrList, Maybe Char))+pangoMarkupParserFinish (GMarkupParseContext fpc) = unsafeIOToPrim+ $ withForeignPtr fpc \ppc -> alloca \ppal -> alloca \pt -> alloca \pac -> alloca \pge -> do+ r <- c_pango_markup_parser_finish ppc ppal pt pac pge+ pt' <- toCStringLen =<< peek pt+ pt'' <- copyToForeignCStringLen pt'+ case r of+ #{const FALSE} -> Left <$> (mkGError =<< peek pge)+ #{const TRUE} -> (Right <$>) $ (,)+ <$> (PangoTextAttrList pt'' <$> (mkPangoAttrList =<< peek ppal))+ <*> (fromGunichar <$> peek pac)+ _ -> error "never occur"++foreign import ccall "pango_markup_parser_finish"+ c_pango_markup_parser_finish ::+ Ptr (GMarkupParseContext s) -> Ptr (Ptr PangoAttrList) -> Ptr CString ->+ Ptr #{type gunichar} -> Ptr (Ptr GError) -> IO #{type gboolean}++newtype PangoAttribute s = PangoAttribute (ForeignPtr (PangoAttribute s))+ deriving Show++mkPangoAttribute :: Ptr (PangoAttribute s) -> IO (PangoAttribute s)+mkPangoAttribute p =+ PangoAttribute <$> newForeignPtr p (c_pango_attribute_destroy p)++foreign import ccall "pango_attribute_destroy" c_pango_attribute_destroy ::+ Ptr (PangoAttribute s) -> IO ()++pangoAttributeSetStartIndex, pangoAttributeSetEndIndex :: PrimMonad m =>+ PangoAttribute (PrimState m) -> CUInt -> m ()+pangoAttributeSetStartIndex (PangoAttribute fa) si = unsafeIOToPrim+ $ withForeignPtr fa \pa -> #{poke PangoAttribute, start_index} pa si++pangoAttributeSetEndIndex (PangoAttribute fa) ei = unsafeIOToPrim+ $ withForeignPtr fa \pa -> #{poke PangoAttribute, end_index} pa ei++class PangoAttributeValue v where+ pangoAttrNew :: PrimMonad m => v -> m (PangoAttribute (PrimState m))++instance PangoAttributeValue PangoLanguage where+ pangoAttrNew = pangoAttrLanguageNew++pangoAttrLanguageNew :: PrimMonad m =>+ PangoLanguage -> m (PangoAttribute (PrimState m))+pangoAttrLanguageNew (PangoLanguage_ l) =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_language_new l++foreign import ccall "pango_attr_language_new" c_pango_attr_language_new ::+ Ptr PangoLanguage -> IO (Ptr (PangoAttribute s))++-- data Family = Family String deriving Show++instance PangoAttributeValue Family where+ pangoAttrNew (Family f) = pangoAttrFamilyNew f++pangoAttrFamilyNew :: PrimMonad m => String -> m (PangoAttribute (PrimState m))+pangoAttrFamilyNew f =+ unsafeIOToPrim $ mkPangoAttribute =<< withCString f c_pango_attr_family_new++foreign import ccall "pango_attr_family_new" c_pango_attr_family_new ::+ CString -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoStyle where pangoAttrNew = pangoAttrStyleNew++pangoAttrStyleNew :: PrimMonad m => PangoStyle -> m (PangoAttribute (PrimState m))+pangoAttrStyleNew (PangoStyle s) =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_style_new s++foreign import ccall "pango_attr_style_new" c_pango_attr_style_new ::+ #{type PangoStyle} -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoVariant where+ pangoAttrNew = pangoAttrVariantNew++pangoAttrVariantNew :: PrimMonad m => PangoVariant -> m (PangoAttribute (PrimState m))+pangoAttrVariantNew (PangoVariant v) =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_variant_new v++foreign import ccall "pango_attr_variant_new" c_pango_attr_variant_new ::+ #{type PangoVariant} -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoStretch where+ pangoAttrNew = pangoAttrStretchNew++pangoAttrStretchNew :: PrimMonad m => PangoStretch -> m (PangoAttribute (PrimState m))+pangoAttrStretchNew (PangoStretch s) =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_stretch_new s++foreign import ccall "pango_attr_stretch_new" c_pango_attr_stretch_new ::+ #{type PangoStretch} -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoWeight where+ pangoAttrNew = pangoAttrWeightNew++pangoAttrWeightNew :: PrimMonad m => PangoWeight -> m (PangoAttribute (PrimState m))+pangoAttrWeightNew (PangoWeight w) =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_weight_new w++foreign import ccall "pango_attr_weight_new" c_pango_attr_weight_new ::+ #{type PangoWeight} -> IO (Ptr (PangoAttribute s))++-- data Size = Size Double | AbsoluteSize Double deriving Show++instance PangoAttributeValue Size where+ pangoAttrNew = pangoAttrSizeNew++pangoAttrSizeNew :: PrimMonad m => Size -> m (PangoAttribute (PrimState m))+pangoAttrSizeNew = unsafeIOToPrim . (mkPangoAttribute =<<) . \case+ Size s -> c_pango_attr_size_new . round $ s * #{const PANGO_SCALE}+ AbsoluteSize a -> c_pango_attr_size_new_absolute . round $ a * #{const PANGO_SCALE}++foreign import ccall "pango_attr_size_new" c_pango_attr_size_new ::+ CInt -> IO (Ptr (PangoAttribute s))++foreign import ccall "pango_attr_size_new_absolute" c_pango_attr_size_new_absolute ::+ CInt -> IO (Ptr (PangoAttribute s))++pangoAttrFontDescNew :: PrimMonad m =>+ PangoFontDescriptionPrim (PrimState m) -> m (PangoAttribute (PrimState m))+pangoAttrFontDescNew (PangoFontDescriptionPrim ffd) = unsafeIOToPrim+ $ mkPangoAttribute =<< withForeignPtr ffd c_pango_attr_font_desc_new++foreign import ccall "pango_attr_font_desc_new" c_pango_attr_font_desc_new ::+ Ptr PangoFontDescription -> IO (Ptr (PangoAttribute s))++data ForegroundColor d = ForegroundColor (Rgb d) deriving Show++instance RealFrac d => PangoAttributeValue (ForegroundColor d) where+ pangoAttrNew = pangoAttrForegroundNew++pangoAttrForegroundNew :: (PrimMonad m, RealFrac d) =>+ ForegroundColor d -> m (PangoAttribute (PrimState m))+pangoAttrForegroundNew (ForegroundColor (RgbWord16 r g b)) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_foreground_new r g b++foreign import ccall "pango_attr_foreground_new" c_pango_attr_foreground_new ::+ Word16 -> Word16 -> Word16 -> IO (Ptr (PangoAttribute s))++data BackgroundColor d = BackgroundColor (Rgb d) deriving Show++instance RealFrac d => PangoAttributeValue (BackgroundColor d) where+ pangoAttrNew = pangoAttrBackgroundNew++pangoAttrBackgroundNew :: (PrimMonad m, RealFrac d) =>+ BackgroundColor d -> m (PangoAttribute (PrimState m))+pangoAttrBackgroundNew (BackgroundColor (RgbWord16 r g b)) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_background_new r g b++foreign import ccall "pango_attr_background_new" c_pango_attr_background_new ::+ Word16 -> Word16 -> Word16 -> IO (Ptr (PangoAttribute s))++newtype Strikethrough = Strikethrough Bool deriving Show++instance PangoAttributeValue Strikethrough where+ pangoAttrNew (Strikethrough b) = pangoAttrStrikethroughNew b++pangoAttrStrikethroughNew :: PrimMonad m =>+ Bool -> m (PangoAttribute (PrimState m))+pangoAttrStrikethroughNew b = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_strikethrough_new case b of+ False -> #{const FALSE}; True -> #{const TRUE}++foreign import ccall "pango_attr_strikethrough_new" c_pango_attr_strikethrough_new ::+ #{type gboolean} -> IO (Ptr (PangoAttribute s))++data StrikethroughColor d = StrikethroughColor (Rgb d) deriving Show++instance RealFrac d => PangoAttributeValue (StrikethroughColor d) where+ pangoAttrNew = pangoAttrStrikethroughColorNew++pangoAttrStrikethroughColorNew :: (PrimMonad m, RealFrac d) =>+ StrikethroughColor d -> m (PangoAttribute (PrimState m))+pangoAttrStrikethroughColorNew (StrikethroughColor (RgbWord16 r g b)) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_strikethrough_color_new r g b++foreign import ccall "pango_attr_strikethrough_color_new" c_pango_attr_strikethrough_color_new ::+ Word16 -> Word16 -> Word16 -> IO (Ptr (PangoAttribute s))++enum "PangoUnderline" ''#{type PangoUnderline} [''Show] [+ ("PangoUnderlineNone", #{const PANGO_UNDERLINE_NONE}),+ ("PangoUnderlineSingle", #{const PANGO_UNDERLINE_SINGLE}),+ ("PangoUnderlineDouble", #{const PANGO_UNDERLINE_DOUBLE}),+ ("PangoUnderlineLow", #{const PANGO_UNDERLINE_LOW}),+ ("PangoUnderlineError", #{const PANGO_UNDERLINE_ERROR}) ]++instance PangoAttributeValue PangoUnderline where+ pangoAttrNew = pangoAttrUnderlineNew++pangoAttrUnderlineNew :: PrimMonad m =>+ PangoUnderline -> m (PangoAttribute (PrimState m))+pangoAttrUnderlineNew (PangoUnderline ul) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_underline_new ul++foreign import ccall "pango_attr_underline_new" c_pango_attr_underline_new ::+ #{type PangoUnderline} -> IO (Ptr (PangoAttribute s))++data UnderlineColor d = UnderlineColor (Rgb d) deriving Show++instance RealFrac d => PangoAttributeValue (UnderlineColor d) where+ pangoAttrNew = pangoAttrUnderlineColorNew++pangoAttrUnderlineColorNew :: (PrimMonad m, RealFrac d) =>+ UnderlineColor d -> m (PangoAttribute (PrimState m))+pangoAttrUnderlineColorNew (UnderlineColor (RgbWord16 r g b)) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_underline_color_new r g b++foreign import ccall "pango_attr_underline_color_new" c_pango_attr_underline_color_new ::+ Word16 -> Word16 -> Word16 -> IO (Ptr (PangoAttribute s))++data Shape = Shape PangoRectangleFixed PangoRectangleFixed deriving Show++instance PangoAttributeValue Shape where+ pangoAttrNew (Shape ir lr) = pangoAttrShapeNew ir lr++pangoAttrShapeNew :: PrimMonad m =>+ PangoRectangleFixed -> PangoRectangleFixed -> m (PangoAttribute (PrimState m))+pangoAttrShapeNew (PangoRectangleFixed_ fir) (PangoRectangleFixed_ flr) = unsafeIOToPrim+ $ withForeignPtr fir \pir -> withForeignPtr flr \plr ->+ mkPangoAttribute =<< c_pango_attr_shape_new pir plr++foreign import ccall "pango_attr_shape_new" c_pango_attr_shape_new ::+ Ptr PangoRectangleFixed -> Ptr PangoRectangleFixed -> IO (Ptr (PangoAttribute s))++newtype Scale = Scale CDouble deriving Show++instance PangoAttributeValue Scale where+ pangoAttrNew (Scale s) = pangoAttrScaleNew s++pangoAttrScaleNew :: PrimMonad m => CDouble -> m (PangoAttribute (PrimState m))+pangoAttrScaleNew s =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_scale_new s++foreign import ccall "pango_attr_scale_new" c_pango_attr_scale_new ::+ CDouble -> IO (Ptr (PangoAttribute s))++newtype Rise = RiseInPangoUnit { getRiseInPangoUnit :: CInt } deriving Show++pattern Rise :: PangoFixed -> Rise+pattern Rise r <- (fromCInt . getRiseInPangoUnit -> r) where+ Rise = RiseInPangoUnit . toCInt++instance PangoAttributeValue Rise where+ pangoAttrNew = pangoAttrRiseNew . getRiseInPangoUnit++pangoAttrRiseNew :: PrimMonad m => CInt -> m (PangoAttribute (PrimState m))+pangoAttrRiseNew r =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_rise_new r++foreign import ccall "pango_attr_rise_new" c_pango_attr_rise_new ::+ CInt -> IO (Ptr (PangoAttribute s))++newtype LetterSpacing =+ LetterSpacingInPangoUnit { getLetterSpacingInPangoUnit :: CInt }+ deriving Show++instance PangoAttributeValue LetterSpacing where+ pangoAttrNew = pangoAttrLetterSpacingNew . getLetterSpacingInPangoUnit++pattern LetterSpacing :: PangoFixed -> LetterSpacing+pattern LetterSpacing s <-+ (fromCInt . getLetterSpacingInPangoUnit -> s) where+ LetterSpacing = LetterSpacingInPangoUnit . toCInt++pangoAttrLetterSpacingNew ::+ PrimMonad m => CInt -> m (PangoAttribute (PrimState m))+pangoAttrLetterSpacingNew s =+ unsafeIOToPrim $ mkPangoAttribute =<< c_pango_attr_letter_spacing_new s++foreign import ccall "pango_attr_letter_spacing_new"+ c_pango_attr_letter_spacing_new ::+ CInt -> IO (Ptr (PangoAttribute s))++newtype Fallback = Fallback Bool deriving Show++instance PangoAttributeValue Fallback where+ pangoAttrNew (Fallback b) = pangoAttrFallbackNew b++pangoAttrFallbackNew :: PrimMonad m => Bool -> m (PangoAttribute (PrimState m))+pangoAttrFallbackNew b = unsafeIOToPrim $ mkPangoAttribute+ =<< c_pango_attr_fallback_new (bool #{const FALSE} #{const TRUE} b)++foreign import ccall "pango_attr_fallback_new" c_pango_attr_fallback_new ::+ #{type gboolean} -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoGravity where+ pangoAttrNew = pangoAttrGravityNew++pangoAttrGravityNew ::+ PrimMonad m => PangoGravity -> m (PangoAttribute (PrimState m))+pangoAttrGravityNew (PangoGravity g) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_gravity_new g++foreign import ccall "pango_attr_gravity_new" c_pango_attr_gravity_new ::+ #{type PangoGravity} -> IO (Ptr (PangoAttribute s))++instance PangoAttributeValue PangoGravityHint where+ pangoAttrNew = pangoAttrGravityHintNew++pangoAttrGravityHintNew ::+ PrimMonad m => PangoGravityHint -> m (PangoAttribute (PrimState m))+pangoAttrGravityHintNew (PangoGravityHint gh) = unsafeIOToPrim+ $ mkPangoAttribute =<< c_pango_attr_gravity_hint_new gh++foreign import ccall "pango_attr_gravity_hint_new"+ c_pango_attr_gravity_hint_new ::+ #{type PangoGravityHint} -> IO (Ptr (PangoAttribute s))++newtype FontFeatures = FontFeatures { getFontFeatures :: String } deriving Show++instance PangoAttributeValue FontFeatures where+ pangoAttrNew = pangoAttrFontFeaturesNew . getFontFeatures++pangoAttrFontFeaturesNew ::+ PrimMonad m => String -> m (PangoAttribute (PrimState m))+pangoAttrFontFeaturesNew f = unsafeIOToPrim+ $ mkPangoAttribute =<< withCString f c_pango_attr_font_features_new++foreign import ccall "pango_attr_font_features_new"+ c_pango_attr_font_features_new ::+ CString -> IO (Ptr (PangoAttribute s))++newtype ForegroundAlpha d = ForegroundAlpha { getForegroundAlpha :: Alpha d }+ deriving Show++instance RealFrac d => PangoAttributeValue (ForegroundAlpha d) where+ pangoAttrNew = pangoAttrForegroundAlphaNew . getForegroundAlpha++newtype BackgroundAlpha d = BackgroundAlpha { getBackgroundAlpha :: Alpha d }+ deriving Show++instance RealFrac d => PangoAttributeValue (BackgroundAlpha d) where+ pangoAttrNew = pangoAttrBackgroundAlphaNew . getBackgroundAlpha++pangoAttrForegroundAlphaNew, pangoAttrBackgroundAlphaNew ::+ (PrimMonad m, RealFrac d) => Alpha d -> m (PangoAttribute (PrimState m))+pangoAttrForegroundAlphaNew (AlphaWord16 a) = unsafeIOToPrim . (mkPangoAttribute =<<)+ $ c_pango_attr_foreground_alpha_new case a of 0 -> 1; _ -> a++pangoAttrBackgroundAlphaNew (AlphaWord16 a) = unsafeIOToPrim . (mkPangoAttribute =<<)+ $ c_pango_attr_background_alpha_new case a of 0 -> 1; _ -> a++foreign import ccall "pango_attr_foreground_alpha_new"+ c_pango_attr_foreground_alpha_new ::+ Word16 -> IO (Ptr (PangoAttribute s))++foreign import ccall "pango_attr_background_alpha_new"+ c_pango_attr_background_alpha_new ::+ Word16 -> IO (Ptr (PangoAttribute s))++data PangoColor = PangoColor {+ pangoColorRed :: Word16,+ pangoColorGreen :: Word16,+ pangoColorBlue :: Word16 } deriving Show++instance Storable PangoColor where+ sizeOf _ = #{size PangoColor}+ alignment _ = #{alignment PangoColor}+ peek p = PangoColor+ <$> #{peek PangoColor, red} p+ <*> #{peek PangoColor, green} p+ <*> #{peek PangoColor, blue} p+ poke p (PangoColor r g b) = do+ #{poke PangoColor, red} p r+ #{poke PangoColor, green} p g+ #{poke PangoColor, blue} p b++pangoColorParse :: String -> Maybe PangoColor+pangoColorParse s = unsafePerformIO $ withCString s \cs -> alloca \pc ->+ c_pango_color_parse pc cs >>= \case+ #{const FALSE} -> pure Nothing+ #{const TRUE} -> Just <$> peek pc+ _ -> error "never occur"++foreign import ccall "pango_color_parse" c_pango_color_parse ::+ Ptr PangoColor -> CString -> IO #{type gboolean}++pangoColorToString :: PangoColor -> String+pangoColorToString c = unsafePerformIO $ peekCString =<< alloca \cc ->+ poke cc c >> c_pango_color_to_string cc++foreign import ccall "pango_color_to_string" c_pango_color_to_string ::+ Ptr PangoColor -> IO CString++pangoTextAttrListFreeze :: PrimMonad m =>+ PangoTextAttrListPrim (PrimState m) -> m PangoTextAttrList+pangoTextAttrListFreeze (PangoTextAttrListPrim csl _ al) =+ PangoTextAttrList csl <$> pangoAttrListFreeze al++pangoTextAttrListThaw :: PrimMonad m =>+ PangoTextAttrList -> m (Maybe (PangoTextAttrListPrim (PrimState m)))+pangoTextAttrListThaw (PangoTextAttrList csl al) = unsafeIOToPrim do+ ids <- ((\is -> listArray (0, length is - 1) is) . (fromIntegral <$>) <$> withForeignCStringLen csl byteIndices)+ mal <- pangoAttrListThawIo al+ pure $ PangoTextAttrListPrim csl ids <$> mal++data PangoTextAttrListPrim s = PangoTextAttrListPrim {+ pangoTextAttrListPrimText :: ForeignCStringLen,+ pangoTextAttrListPrimUtf8Indices :: Array Int CUInt,+ pangoTextAttrListPrimAttrList :: PangoAttrListPrim s+ } deriving Show++pangoTextAttrListNew ::+ PrimMonad m => T.Text -> m (PangoTextAttrListPrim (PrimState m))+pangoTextAttrListNew t = unsafeIOToPrim $ T.withCStringLen t \csl -> do+ csl' <- copyToForeignCStringLen csl+ PangoTextAttrListPrim csl'+ <$> ((\is -> listArray (0, length is - 1) is) . (fromIntegral <$>)+ <$> byteIndices csl)+ <*> (mkPangoAttrListPrim =<< c_pango_attr_list_new)++pangoTextAttrListCopy :: PrimMonad m =>+ PangoTextAttrListPrim (PrimState m) -> m (PangoTextAttrListPrim (PrimState m))+pangoTextAttrListCopy (PangoTextAttrListPrim t is al) =+ PangoTextAttrListPrim t is <$> pangoAttrListCopy al++toUtf8Index :: HasCallStack => Array Int CUInt -> Int -> CUInt+toUtf8Index t i | i < mn = 0 | i > mx = maxBound | otherwise = t ! i+ where (mn, mx) = bounds t++pangoTextAttrListInsert, pangoTextAttrListInsertBefore,+ pangoTextAttrListChange :: PrimMonad m =>+ PangoTextAttrListPrim (PrimState m) ->+ PangoAttribute (PrimState m) -> Int -> Int -> m ()+pangoTextAttrListInsert = pangoTextAttrListInsertGen pangoAttrListInsert++pangoTextAttrListInsertBefore =+ pangoTextAttrListInsertGen pangoAttrListInsertBefore++pangoTextAttrListChange = pangoTextAttrListInsertGen pangoAttrListChange++pangoTextAttrListInsertGen :: PrimMonad m =>+ (PangoAttrListPrim (PrimState m) ->+ PangoAttribute (PrimState m) -> m ()) ->+ PangoTextAttrListPrim (PrimState m) -> PangoAttribute (PrimState m) ->+ Int -> Int -> m ()+pangoTextAttrListInsertGen pali (PangoTextAttrListPrim _ t al) a s e = do+ pangoAttributeSetStartIndex a (toUtf8Index t s)+ pangoAttributeSetEndIndex a (toUtf8Index t e)+ pali al a+ ++newtype PangoAttrListPrim s = PangoAttrListPrim (ForeignPtr (PangoAttrListPrim s)) deriving Show++mkPangoAttrListPrim :: Ptr (PangoAttrListPrim s) -> IO (PangoAttrListPrim s)+mkPangoAttrListPrim p = PangoAttrListPrim <$> newForeignPtr p (c_pango_attr_list_prim_unref p)++foreign import ccall "pango_attr_list_unref" c_pango_attr_list_prim_unref ::+ Ptr (PangoAttrListPrim s) -> IO ()++foreign import ccall "pango_attr_list_new" c_pango_attr_list_new ::+ IO (Ptr (PangoAttrListPrim s))++pangoAttrListCopy :: PrimMonad m =>+ PangoAttrListPrim (PrimState m) -> m (PangoAttrListPrim (PrimState m))+pangoAttrListCopy (PangoAttrListPrim fal) = unsafeIOToPrim+ $ mkPangoAttrListPrim =<< withForeignPtr fal c_pango_attr_list_copy++foreign import ccall "pango_attr_list_copy" c_pango_attr_list_copy ::+ Ptr (PangoAttrListPrim s) -> IO (Ptr (PangoAttrListPrim s))++pangoAttrListFreeze ::+ PrimMonad m => PangoAttrListPrim (PrimState m) -> m PangoAttrList+pangoAttrListFreeze (PangoAttrListPrim fal) = unsafeIOToPrim+ $ mkPangoAttrList =<< withForeignPtr fal c_pango_attr_list_freeze++foreign import ccall "pango_attr_list_copy" c_pango_attr_list_freeze ::+ Ptr (PangoAttrListPrim s) -> IO (Ptr PangoAttrList)++pangoAttrListThawIo :: PangoAttrList -> IO (Maybe (PangoAttrListPrim s))+pangoAttrListThawIo = \case+ PangoAttrListNull -> pure Nothing+ PangoAttrList fal -> (Just <$>) . mkPangoAttrListPrim+ =<< withForeignPtr fal c_pango_attr_list_thaw++foreign import ccall "pango_attr_list_copy" c_pango_attr_list_thaw ::+ Ptr PangoAttrList -> IO (Ptr (PangoAttrListPrim s))++pangoAttrListInsert, pangoAttrListInsertBefore, pangoAttrListChange ::+ PrimMonad m =>+ PangoAttrListPrim (PrimState m) -> PangoAttribute (PrimState m) -> m ()+pangoAttrListInsert (PangoAttrListPrim fal) (PangoAttribute fa) = unsafeIOToPrim+ $ withForeignPtr fal \pal -> withForeignPtr fa \pa -> do+ pa' <- c_pango_attribute_copy pa+ c_pango_attr_list_insert pal pa'++pangoAttrListInsertBefore (PangoAttrListPrim fal) (PangoAttribute fa) = unsafeIOToPrim+ $ withForeignPtr fal \pal -> withForeignPtr fa \pa -> do+ pa' <- c_pango_attribute_copy pa+ c_pango_attr_list_insert_before pal pa'++pangoAttrListChange (PangoAttrListPrim fal) (PangoAttribute fa) = unsafeIOToPrim+ $ withForeignPtr fal \pal -> withForeignPtr fa \pa -> do+ pa' <- c_pango_attribute_copy pa+ c_pango_attr_list_change pal pa'++foreign import ccall "pango_attr_list_insert" c_pango_attr_list_insert ::+ Ptr (PangoAttrListPrim s) -> Ptr (PangoAttribute s) -> IO ()++foreign import ccall "pango_attr_list_insert_before" c_pango_attr_list_insert_before ::+ Ptr (PangoAttrListPrim s) -> Ptr (PangoAttribute s) -> IO ()++foreign import ccall "pango_attr_list_change" c_pango_attr_list_change ::+ Ptr (PangoAttrListPrim s) -> Ptr (PangoAttribute s) -> IO ()++foreign import ccall "pango_attribute_copy" c_pango_attribute_copy ::+ Ptr (PangoAttribute s) -> IO (Ptr (PangoAttribute s))
+ src/Graphics/Pango/Basic/VerticalText.hsc view
@@ -0,0 +1,91 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Basic.VerticalText (+ -- * ENUM+ -- ** PangoGravity+ PangoGravity(..),+ pattern PangoGravitySouth,+ pattern PangoGravityEast,+ pattern PangoGravityNorth,+ pattern PangoGravityWest,+ pattern PangoGravityAuto,++ -- ** PangoGravityHint+ PangoGravityHint(..),+ pattern PangoGravityHintNatural,+ pattern PangoGravityHintStrong,+ pattern PangoGravityHintLine,++ -- * FUNCTION+ pangoGravityGetForMatrix,+ pangoGravityGetForScript,+ pangoGravityGetForScriptAndWidth,+ pangoGravityToRotation+ ) where++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.Types+import Foreign.C.Enum+import Data.Bool+import Data.Word+import Data.Int+import Data.Angle+import System.IO.Unsafe+import Graphics.Pango.Basic.GlyphStorage.PangoMatrix.Internal+import Graphics.Pango.Basic.ScriptsAndLanguages.PangoScript.Enum++#include <pango/pango.h>++enum "PangoGravity" ''#{type PangoGravity} [''Show] [+ ("PangoGravitySouth", #{const PANGO_GRAVITY_SOUTH}),+ ("PangoGravityEast", #{const PANGO_GRAVITY_EAST}),+ ("PangoGravityNorth", #{const PANGO_GRAVITY_NORTH}),+ ("PangoGravityWest", #{const PANGO_GRAVITY_WEST}),+ ("PangoGravityAuto", #{const PANGO_GRAVITY_AUTO}) ]++enum "PangoGravityHint" ''#{type PangoGravityHint} [''Show] [+ ("PangoGravityHintNatural", #{const PANGO_GRAVITY_HINT_NATURAL}),+ ("PangoGravityHintStrong", #{const PANGO_GRAVITY_HINT_STRONG}),+ ("PangoGravityHintLine", #{const PANGO_GRAVITY_HINT_LINE}) ]++pangoGravityGetForMatrix :: PangoMatrix -> PangoGravity+pangoGravityGetForMatrix (PangoMatrix_ fm) = unsafePerformIO+ $ PangoGravity <$> withForeignPtr fm c_pango_gravity_get_for_matrix++foreign import ccall "pango_gravity_get_for_matrix"+ c_pango_gravity_get_for_matrix ::+ Ptr PangoMatrix -> IO #{type PangoGravity}++pangoGravityGetForScript ::+ PangoScript -> PangoGravity -> PangoGravityHint -> PangoGravity+pangoGravityGetForScript (PangoScript s) (PangoGravity b) (PangoGravityHint h) =+ unsafePerformIO $ PangoGravity <$> c_pango_gravity_get_for_script s b h++foreign import ccall "pango_gravity_get_for_script"+ c_pango_gravity_get_for_script ::+ #{type PangoScript} -> #{type PangoGravity} ->+ #{type PangoGravityHint} -> IO #{type PangoGravity}++pangoGravityGetForScriptAndWidth ::+ PangoScript -> Bool -> PangoGravity -> PangoGravityHint -> PangoGravity+pangoGravityGetForScriptAndWidth+ (PangoScript s) w (PangoGravity b) (PangoGravityHint h) =+ unsafePerformIO $ PangoGravity <$>+ c_pango_gravity_get_for_script_and_width+ s (bool #{const FALSE} #{const TRUE} w) b h++foreign import ccall "pango_gravity_get_for_script_and_width"+ c_pango_gravity_get_for_script_and_width ::+ #{type PangoScript} -> #{type gboolean} -> #{type PangoGravity} ->+ #{type PangoGravityHint} -> IO #{type PangoGravity}++pangoGravityToRotation :: PangoGravity -> Angle CDouble+pangoGravityToRotation (PangoGravity g) =+ unsafePerformIO $ Radian <$> c_pango_gravity_to_rotation g++foreign import ccall "pango_gravity_to_rotation" c_pango_gravity_to_rotation ::+ #{type PangoGravity} -> IO CDouble
+ src/Graphics/Pango/LowLevel/Contexts.hs view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.LowLevel.Contexts (+ PangoContext, PangoContextSetting, pangoContextSet, pangoContextGet,+ BaseGravity(..) ) where++import Graphics.Pango.LowLevel.Contexts.Internal
+ src/Graphics/Pango/LowLevel/Contexts/Internal.hsc view
@@ -0,0 +1,91 @@+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.LowLevel.Contexts.Internal (+ PangoContext(..), mkPangoContext,+ PangoContextSetting(..), BaseGravity(..) ) where++import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Data.Word+import System.GLib.GObject++import Graphics.Pango.Basic.Fonts.PangoFontDescription.Type++import Graphics.Pango.Basic.GlyphStorage.PangoMatrix.Internal+import Graphics.Pango.Basic.VerticalText++#include <pango/pango.h>++newtype PangoContext = PangoContext (ForeignPtr PangoContext) deriving Show++mkPangoContext :: Ptr PangoContext -> IO PangoContext+mkPangoContext p = PangoContext <$> newForeignPtr p (c_g_object_unref p)++class PangoContextSetting s where+ pangoContextSet :: PangoContext -> s -> IO ()+ pangoContextGet :: PangoContext -> IO s++newtype BaseGravity = BaseGravity { getBaseGravity :: PangoGravity } deriving Show++instance PangoContextSetting BaseGravity where+ pangoContextSet c = pangoContextSetBaseGravity c . getBaseGravity+ pangoContextGet c = BaseGravity <$> pangoContextGetBaseGravity c++pangoContextSetBaseGravity :: PangoContext -> PangoGravity -> IO ()+pangoContextSetBaseGravity (PangoContext fc) (PangoGravity g) =+ withForeignPtr fc \pc -> c_pango_context_set_base_gravity pc g++pangoContextGetBaseGravity :: PangoContext -> IO PangoGravity+pangoContextGetBaseGravity (PangoContext fc) =+ PangoGravity <$> withForeignPtr fc c_pango_context_get_base_gravity++foreign import ccall "pango_context_set_base_gravity"+ c_pango_context_set_base_gravity ::+ Ptr PangoContext -> #{type PangoGravity} -> IO ()++foreign import ccall "pango_context_get_base_gravity"+ c_pango_context_get_base_gravity ::+ Ptr PangoContext -> IO #{type PangoGravity}++instance PangoContextSetting PangoFontDescription where+ pangoContextSet = pangoContextSetFontDescription+ pangoContextGet = pangoContextGetFontDescription++pangoContextSetFontDescription :: PangoContext -> PangoFontDescription -> IO ()+pangoContextSetFontDescription (PangoContext fc) (PangoFontDescription_ ffd) =+ withForeignPtr fc \pc -> withForeignPtr ffd \pfd ->+ c_pango_context_set_font_description pc pfd++pangoContextGetFontDescription :: PangoContext -> IO PangoFontDescription+pangoContextGetFontDescription (PangoContext fc) = mkPangoFontDescription+ =<< withForeignPtr fc c_pango_context_get_font_description++foreign import ccall "pango_context_set_font_description"+ c_pango_context_set_font_description ::+ Ptr PangoContext -> Ptr PangoFontDescription -> IO ()++foreign import ccall "pango_context_get_font_description"+ c_pango_context_get_font_description ::+ Ptr PangoContext -> IO (Ptr PangoFontDescription)++instance PangoContextSetting PangoMatrixNullable where+ pangoContextSet = pangoContextSetMatrix+ pangoContextGet = pangoContextGetMatrix++pangoContextGetMatrix :: PangoContext -> IO PangoMatrixNullable+pangoContextGetMatrix (PangoContext fc) = mkPangoMatrixNullable0 =<<+ withForeignPtr fc c_pango_context_get_matrix++foreign import ccall "pango_context_get_matrix" c_pango_context_get_matrix ::+ Ptr PangoContext -> IO (Ptr PangoMatrix)++pangoContextSetMatrix :: PangoContext -> PangoMatrixNullable -> IO ()+pangoContextSetMatrix (PangoContext fc) m = withForeignPtr fc \pc -> case m of+ PangoMatrixNull -> c_pango_context_set_matrix pc NullPtr+ PangoMatrixNotNull fm -> withForeignPtr fm $ c_pango_context_set_matrix pc++foreign import ccall "pango_context_set_matrix" c_pango_context_set_matrix ::+ Ptr PangoContext -> Ptr PangoMatrix -> IO ()
+ src/Graphics/Pango/LowLevel/TabStops.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.LowLevel.TabStops (+ -- * PANGO TAB ARRAY+ PangoTabArray, pangoTabArrayThaw,+ pangoTabArrayGetTab, pangoTabArrayGetTabs,++ -- * PANGO TAB ARRAY NULLABLE+ PangoTabArrayNullable,+ pangoTabArrayFromNullable, pangoTabArrayToNullable,++ -- * PANGO TAB ARRAY FIXED+ PangoTabArrayFixed, pangoTabArrayFixedFreeze,+ pangoTabArrayFixedNew, pangoTabArrayFixedSetTab,++ -- * PANGO TAB ARRAY INT+ PangoTabArrayInt, pangoTabArrayIntFreeze,+ pangoTabArrayIntNew, pangoTabArrayIntSetTab,+ ) where++import Graphics.Pango.LowLevel.TabStops.Internal
+ src/Graphics/Pango/LowLevel/TabStops/Internal.hsc view
@@ -0,0 +1,241 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.LowLevel.TabStops.Internal (+ -- * PANGO TAB ARRAY+ PangoTabArray(..), makePangoTabArray, pangoTabArrayThaw,+ pangoTabArrayGetTab, pangoTabArrayGetTabs,++ -- * PANGO TAB ARRAY NULLABLE+ PangoTabArrayNullable(..), makePangoTabArrayNullable,+ pangoTabArrayFromNullable, pangoTabArrayToNullable,++ -- * PANGO TAB ARRAY FIXED+ PangoTabArrayFixed, pangoTabArrayFixedFreeze,+ pangoTabArrayFixedNew, pangoTabArrayFixedSetTab,++ -- * PANGO TAB ARRAY INT+ PangoTabArrayInt, pangoTabArrayIntFreeze,+ pangoTabArrayIntNew, pangoTabArrayIntSetTab,+ ) where++import Foreign.Ptr+import Foreign.Ptr.Misc+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.Enum+import Control.Arrow+import Control.Monad.Primitive+import Data.Foldable+import Data.Word+import Data.Int+import System.IO.Unsafe++import Graphics.Pango.Basic.GlyphStorage++#include <pango/pango.h>++newtype PangoTabArray = PangoTabArray (ForeignPtr PangoTabArray) deriving Show++makePangoTabArray :: Ptr PangoTabArray -> IO PangoTabArray+makePangoTabArray = \case+ NullPtr -> error "bad"+ p -> PangoTabArray <$> newForeignPtr p (c_pango_tab_array_free p)++data PangoTabArrayNullable+ = PangoTabArrayNull+ | PangoTabArrayNotNull (ForeignPtr PangoTabArray)+ deriving Show++makePangoTabArrayNullable :: Ptr PangoTabArray -> IO PangoTabArrayNullable+makePangoTabArrayNullable = \case+ NullPtr -> pure PangoTabArrayNull+ p -> PangoTabArrayNotNull <$> newForeignPtr p (c_pango_tab_array_free p)++pangoTabArrayFromNullable :: PangoTabArrayNullable -> Maybe PangoTabArray+pangoTabArrayFromNullable = \case+ PangoTabArrayNull -> Nothing+ PangoTabArrayNotNull fta -> Just $ PangoTabArray fta++pangoTabArrayToNullable :: Maybe PangoTabArray -> PangoTabArrayNullable+pangoTabArrayToNullable = \case+ Nothing -> PangoTabArrayNull+ Just (PangoTabArray fta) -> PangoTabArrayNotNull fta++newtype PangoTabArrayFixed s =+ PangoTabArrayFixed (ForeignPtr PangoTabArray) deriving Show++mkPangoTabArrayFixed ::+ Ptr PangoTabArray -> IO (PangoTabArrayFixed s)+mkPangoTabArrayFixed p =+ PangoTabArrayFixed <$> newForeignPtr p (c_pango_tab_array_free p)++newtype PangoTabArrayInt s =+ PangoTabArrayInt (ForeignPtr PangoTabArray) deriving Show++mkPangoTabArrayInt ::+ Ptr PangoTabArray -> IO (PangoTabArrayInt s)+mkPangoTabArrayInt p =+ PangoTabArrayInt <$> newForeignPtr p (c_pango_tab_array_free p)++foreign import ccall "pango_tab_array_free" c_pango_tab_array_free ::+ Ptr PangoTabArray -> IO ()++pangoTabArrayFixedNew ::+ PrimMonad m => m (PangoTabArrayFixed (PrimState m))+pangoTabArrayFixedNew = unsafeIOToPrim+ $ mkPangoTabArrayFixed =<< c_pango_tab_array_new 1 #{const FALSE}++pangoTabArrayIntNew ::+ PrimMonad m => m (PangoTabArrayInt (PrimState m))+pangoTabArrayIntNew = unsafeIOToPrim+ $ mkPangoTabArrayInt =<< c_pango_tab_array_new 1 #{const TRUE}++foreign import ccall "pango_tab_array_new" c_pango_tab_array_new ::+ CInt -> #{type gboolean} -> IO (Ptr PangoTabArray)++pangoTabArrayFixedSetTab :: PrimMonad m =>+ PangoTabArrayFixed (PrimState m) -> CInt -> PangoFixed -> m ()+pangoTabArrayFixedSetTab (PangoTabArrayFixed fta) idx x = unsafeIOToPrim+ $ withForeignPtr fta \pta -> do+ sz <- c_pango_tab_array_get_size_prim pta+ if idx < sz+ then c_pango_tab_array_set_tab pta idx #{const PANGO_TAB_LEFT} $ toCInt x+ else do lst <- tempPangoTabArrayGetTab pta (sz - 1)+ let Just (sz', tss) = calculateFixed sz idx (fromCInt lst) x+ c_pango_tab_array_resize pta sz'+ for_ (zip [sz .. sz' - 1] tss) \(i, xx) ->+ c_pango_tab_array_set_tab pta i #{const PANGO_TAB_LEFT}+ . round $ xx * #{const PANGO_SCALE}++foreign import ccall "pango_tab_array_set_tab" c_pango_tab_array_set_tab ::+ Ptr PangoTabArray -> CInt -> #{type PangoTabAlign} -> CInt -> IO ()++tempPangoTabArrayGetTab :: Ptr PangoTabArray -> CInt -> IO CInt+tempPangoTabArrayGetTab pta idx = alloca \px -> do+ c_pango_tab_array_get_tab_prim pta idx nullPtr px+ peek px++foreign import ccall "pango_tab_array_get_tab" c_pango_tab_array_get_tab_prim ::+ Ptr PangoTabArray -> CInt -> Ptr #{type PangoTabAlign} -> Ptr CInt -> IO ()++calculateFixed :: CInt -> CInt -> PangoFixed -> PangoFixed -> Maybe (CInt, [PangoFixed])+calculateFixed sz idx lst x+ | idx < sz = Nothing+ | otherwise = Just (sz', take (fromIntegral $ sz' - sz) [lst + dx, lst + 2 * dx ..])+ where+ sz' = nextPow2 $ idx + 1+ dx = (x - lst) / fromIntegral (idx - sz + 1)++calculateDouble :: CInt -> CInt -> Double -> Double -> Maybe (CInt, [Double])+calculateDouble sz idx lst x+ | idx < sz = Nothing+ | otherwise = Just (sz', take (fromIntegral $ sz' - sz) [lst + dx, lst + 2 * dx ..])+ where+ sz' = nextPow2 $ idx + 1+ dx = (x - lst) / fromIntegral (idx - sz + 1)++nextPow2 :: (Ord n, Num n) => n -> n+nextPow2 k = head . dropWhile (< k) $ (2 ^) <$> [0 :: Int ..]++pangoTabArrayIntSetTab :: PrimMonad m =>+ PangoTabArrayInt (PrimState m) -> CInt -> CInt -> m ()+pangoTabArrayIntSetTab (PangoTabArrayInt fta) idx x = unsafeIOToPrim+ $ withForeignPtr fta \pta -> do+ sz <- c_pango_tab_array_get_size_prim pta+ if idx < sz+ then c_pango_tab_array_set_tab pta idx #{const PANGO_TAB_LEFT} x+ else do lst <- tempPangoTabArrayGetTab pta (sz - 1)+ let Just (sz', tss) = calculateCInt sz idx lst x+ c_pango_tab_array_resize pta sz'+ for_ (zip [sz .. sz' - 1] tss) \(i, xx) ->+ c_pango_tab_array_set_tab pta i #{const PANGO_TAB_LEFT} xx++calculateCInt :: CInt -> CInt -> CInt -> CInt -> Maybe (CInt, [CInt])+calculateCInt sz idx lst x =+ second (round <$>) <$> calculateDouble sz idx (fromIntegral lst) (fromIntegral x)++foreign import ccall "pango_tab_array_get_size" c_pango_tab_array_get_size_prim ::+ Ptr PangoTabArray -> IO CInt++foreign import ccall "pango_tab_array_get_size" c_pango_tab_array_get_size ::+ Ptr PangoTabArray -> IO CInt++foreign import ccall "pango_tab_array_resize" c_pango_tab_array_resize ::+ Ptr PangoTabArray -> CInt -> IO ()++enum "PangoTabAlign" ''#{type PangoTabAlign} [''Show] [+ ("PangoTabLeft", #{const PANGO_TAB_LEFT}) ]++pangoTabArrayGetTab :: PangoTabArray -> CInt -> Maybe (Either Double CInt)+pangoTabArrayGetTab (PangoTabArray fta) idx = unsafePerformIO+ $ withForeignPtr fta \pta -> alloca \loc -> do+ px <- c_pango_tab_array_get_positions_in_pixels pta+ sz <- c_pango_tab_array_get_size pta+ if 0 <= idx && idx < sz then Just <$> do+ c_pango_tab_array_get_tab pta idx nullPtr loc+ (<$> peek loc) case px of+ #{const FALSE} ->+ Left . (/ #{const PANGO_SCALE}) . fromIntegral+ #{const TRUE} -> Right+ _ -> error "never occur"+ else pure Nothing++foreign import ccall "pango_tab_array_get_tab" c_pango_tab_array_get_tab ::+ Ptr PangoTabArray -> CInt -> Ptr #{type PangoTabAlign} -> Ptr CInt -> IO ()++pangoTabArrayGetTabs :: PangoTabArray -> Either [Double] [CInt]+pangoTabArrayGetTabs (PangoTabArray fta) = unsafePerformIO+ $ withForeignPtr fta \pta -> alloca \locs -> do+ n <- c_pango_tab_array_get_size pta+ px <- c_pango_tab_array_get_positions_in_pixels pta+ c_pango_tab_array_get_tabs pta nullPtr locs+ (<$> (peekArrayAndFree n =<< peek locs)) case px of+ #{const FALSE} -> Left+ . ((/ #{const PANGO_SCALE}) . fromIntegral <$>)+ #{const TRUE} -> Right+ _ -> error "never occur"++foreign import ccall "pango_tab_array_get_tabs" c_pango_tab_array_get_tabs ::+ Ptr PangoTabArray -> Ptr (Ptr #type PangoTabAlign) -> Ptr (Ptr CInt) -> IO ()++peekArrayAndFree :: Storable a => CInt -> Ptr a -> IO [a]+peekArrayAndFree n p = peekArray (fromIntegral n) p <* free p++foreign import ccall "pango_tab_array_get_positions_in_pixels"+ c_pango_tab_array_get_positions_in_pixels ::+ Ptr PangoTabArray -> IO #type gboolean++pangoTabArrayIntFreeze :: PrimMonad m =>+ PangoTabArrayInt (PrimState m) -> m PangoTabArray+pangoTabArrayIntFreeze (PangoTabArrayInt fta) =+ unsafeIOToPrim $ withForeignPtr fta \pta ->+ makePangoTabArray =<< c_pango_tab_array_freeze pta++pangoTabArrayFixedFreeze :: PrimMonad m =>+ PangoTabArrayFixed (PrimState m) -> m PangoTabArray+pangoTabArrayFixedFreeze (PangoTabArrayFixed fta) =+ unsafeIOToPrim $ withForeignPtr fta \pta ->+ makePangoTabArray =<< c_pango_tab_array_freeze pta++pangoTabArrayThaw :: PrimMonad m => PangoTabArray -> m (Either+ (PangoTabArrayFixed (PrimState m))+ (PangoTabArrayInt (PrimState m)))+pangoTabArrayThaw (PangoTabArray fta) =+ unsafeIOToPrim $ withForeignPtr fta \pta -> do+ px <- c_pango_tab_array_get_positions_in_pixels pta+ c_pango_tab_array_thaw pta >>= case px of+ #{const FALSE} -> (Left <$>) . mkPangoTabArrayFixed+ #{const TRUE} -> (Right <$>) . mkPangoTabArrayInt+ _ -> error "never occur"++foreign import ccall "pango_tab_array_copy" c_pango_tab_array_freeze ::+ Ptr PangoTabArray -> IO (Ptr PangoTabArray)++foreign import ccall "pango_tab_array_copy" c_pango_tab_array_thaw ::+ Ptr PangoTabArray -> IO (Ptr PangoTabArray)
+ src/Graphics/Pango/Rendering/Cairo.hsc view
@@ -0,0 +1,159 @@+{-# LANGUAGE BlockArguments #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Graphics.Pango.Rendering.Cairo (+ -- * CREATE+ pangoCairoCreateContext,+ pangoCairoUpdateContext,+ pangoCairoCreateLayout,+ pangoCairoUpdateLayout,++ -- * SHOW+ pangoCairoShowLayout,+ pangoCairoShowErrorUnderline,+ pangoCairoShowGlyphItem,+ pangoCairoShowLayoutLine,++ -- * PATH+ pangoCairoLayoutLinePath,+ pangoCairoLayoutPath,+ pangoCairoErrorUnderlinePath,++ -- * RESOLUTION+ pangoCairoContextGetResolution,+ pangoCairoContextSetResolution++ ) where++import Foreign.Ptr+import Foreign.ForeignPtr hiding (addForeignPtrFinalizer)+import Foreign.Concurrent+import Foreign.Marshal+import Foreign.C+import Foreign.C.String.Misc+import Control.Monad.Primitive+import Data.Maybe+import Data.CairoContext++import Graphics.Pango.Basic.GlyphStorage.Internal+import Graphics.Pango.Basic.LayoutObjects.PangoLayout.Internal+import Graphics.Pango.Basic.LayoutObjects.PangoLayoutLine.Internal+import Graphics.Pango.LowLevel.Contexts.Internal++import qualified Data.Text as T+import qualified Data.Text.Foreign as T++pangoCairoCreateContext :: PrimMonad m => CairoT r (PrimState m) -> m PangoContext+pangoCairoCreateContext (CairoT fcr) = unsafeIOToPrim+ $ withForeignPtr fcr \pcr ->+ mkPangoContext =<< c_pango_cairo_create_context pcr++foreign import ccall "pango_cairo_create_context"+ c_pango_cairo_create_context :: Ptr (CairoT r s) -> IO (Ptr PangoContext)++pangoCairoUpdateContext ::+ PrimMonad m => CairoT r (PrimState m) -> PangoContext -> m ()+pangoCairoUpdateContext (CairoT fcr) (PangoContext fc) = unsafeIOToPrim+ $ withForeignPtr fcr \pcr -> withForeignPtr fc \pc ->+ c_pango_cairo_update_context pcr pc++foreign import ccall "pango_cairo_update_context"+ c_pango_cairo_update_context ::+ Ptr (CairoT r s) -> Ptr PangoContext -> IO ()++pangoCairoCreateLayout ::+ PrimMonad m => CairoT r (PrimState m) -> m (PangoLayoutPrim (PrimState m))+pangoCairoCreateLayout (CairoT fcr) = unsafeIOToPrim+ $ withForeignPtr fcr \pcr ->+ mkPangoLayoutPrim =<< c_pango_cairo_create_layout pcr++foreign import ccall "pango_cairo_create_layout" c_pango_cairo_create_layout ::+ Ptr (CairoT r s) -> IO (Ptr PangoLayout)++pangoCairoUpdateLayout :: PrimMonad m =>+ CairoT r (PrimState m) -> PangoLayoutPrim (PrimState m) -> m ()+pangoCairoUpdateLayout (CairoT fcr) (PangoLayoutPrim fl) = unsafeIOToPrim+ $ withForeignPtr fcr \pcr -> withForeignPtr fl \pl ->+ c_pango_cairo_update_layout pcr pl++foreign import ccall "pango_cairo_update_layout" c_pango_cairo_update_layout ::+ Ptr (CairoT r s) -> Ptr PangoLayout -> IO ()++pangoCairoShowGlyphItem :: CairoTIO r -> T.Text -> PangoGlyphItem -> IO ()+pangoCairoShowGlyphItem (CairoT fcr) t (PangoGlyphItem fgi) =+ withForeignPtr fcr \cr -> T.withCStringLen t \(ct, n) -> do+ cs' <- copyCString ct n+ addForeignPtrFinalizer fcr $ free cs'+ withForeignPtr fgi $ c_pango_cairo_show_glyph_item cr cs'++foreign import ccall "pango_cairo_show_glyph_item"+ c_pango_cairo_show_glyph_item ::+ Ptr (CairoT r s) -> CString -> Ptr PangoGlyphItem -> IO ()++pangoCairoShowLayoutLine :: CairoTIO r -> PangoLayoutLine -> IO ()+pangoCairoShowLayoutLine (CairoT fcr) (PangoLayoutLine fll) =+ withForeignPtr fcr \cr ->+ withForeignPtr fll $ c_pango_cairo_show_layout_line cr++foreign import ccall "pango_cairo_show_layout_line"+ c_pango_cairo_show_layout_line ::+ Ptr (CairoT r s) -> Ptr PangoLayoutLine -> IO ()++pangoCairoShowLayout :: CairoTIO r -> PangoLayout -> IO ()+pangoCairoShowLayout (CairoT fcr) (PangoLayout_ fl) = withForeignPtr fcr \cr ->+ withForeignPtr fl $ c_pango_cairo_show_layout cr++foreign import ccall "pango_cairo_show_layout" c_pango_cairo_show_layout ::+ Ptr (CairoT r s) -> Ptr PangoLayout -> IO ()++pangoCairoShowErrorUnderline ::+ CairoTIO r -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()+pangoCairoShowErrorUnderline (CairoT fcr) x y w h =+ withForeignPtr fcr \cr -> c_pango_cairo_show_error_underline cr x y w h++foreign import ccall "pango_cairo_show_error_underline"+ c_pango_cairo_show_error_underline ::+ Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++pangoCairoLayoutLinePath :: CairoTIO r -> PangoLayoutLine -> IO ()+pangoCairoLayoutLinePath (CairoT fcr) (PangoLayoutLine fll) =+ withForeignPtr fcr \cr ->+ withForeignPtr fll $ c_pango_cairo_layout_line_path cr++foreign import ccall "pango_cairo_layout_line_path"+ c_pango_cairo_layout_line_path ::+ Ptr (CairoT r s) -> Ptr PangoLayoutLine -> IO ()++pangoCairoLayoutPath :: CairoTIO r -> PangoLayout -> IO ()+pangoCairoLayoutPath (CairoT fcr) (PangoLayout_ fl) = withForeignPtr fcr \cr ->+ withForeignPtr fl $ c_pango_cairo_layout_path cr++foreign import ccall "pango_cairo_layout_path" c_pango_cairo_layout_path ::+ Ptr (CairoT r s) -> Ptr PangoLayout -> IO ()++pangoCairoErrorUnderlinePath ::+ CairoTIO r -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()+pangoCairoErrorUnderlinePath (CairoT fcr) x y w h = withForeignPtr fcr \cr ->+ c_pango_cairo_error_underline_path cr x y w h++foreign import ccall "pango_cairo_error_underline_path"+ c_pango_cairo_error_underline_path ::+ Ptr (CairoT r s) -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()++pangoCairoContextGetResolution :: PangoContext -> IO (Maybe CDouble)+pangoCairoContextGetResolution (PangoContext fctx) = do+ r <- withForeignPtr fctx c_pango_cairo_context_get_resolution+ pure if r < 0 then Nothing else Just r++foreign import ccall "pango_cairo_context_get_resolution"+ c_pango_cairo_context_get_resolution ::+ Ptr PangoContext -> IO CDouble++pangoCairoContextSetResolution :: PangoContext -> Maybe CDouble -> IO ()+pangoCairoContextSetResolution (PangoContext fctx) mr =+ withForeignPtr fctx \pctx -> c_pango_cairo_context_set_resolution pctx+ $ fromMaybe (- 1) mr++foreign import ccall "pango_cairo_context_set_resolution"+ c_pango_cairo_context_set_resolution ::+ Ptr PangoContext -> CDouble -> IO ()
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"