{-# LINE 2 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) - pango non-GObject types PangoTypes
--
-- Author : Axel Simon
--
-- Created: 9 February 2003
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- #hide

-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Define types used in Pango which are not derived from GObject.
--
module Graphics.Rendering.Pango.BasicTypes (
  GInt,

  Language(Language),
  emptyLanguage,
  languageFromString,

  FontStyle(..),
  Weight(..),
  Variant(..),
  Stretch(..),
  Underline(..),

  PangoGravity(..),
  PangoGravityHint(..),

  PangoString(PangoString),
  makeNewPangoString,
  withPangoString,

  PangoItem(PangoItem),
  PangoItemRaw(PangoItemRaw),
  makeNewPangoItemRaw,
  withPangoItemRaw,

  GlyphItem(GlyphItem),
  GlyphStringRaw(GlyphStringRaw),
  makeNewGlyphStringRaw,

  PangoLayout(PangoLayout),

  LayoutIter(LayoutIter),
  LayoutIterRaw(LayoutIterRaw),
  makeNewLayoutIterRaw,

  LayoutLine(LayoutLine),
  LayoutLineRaw(LayoutLineRaw),
  makeNewLayoutLineRaw,
  FontDescription(FontDescription),
  makeNewFontDescription,

  PangoAttrList,
  CPangoAttribute,
  ) where

import Control.Monad (liftM)
import Data.IORef ( IORef )
import qualified Data.Text as T (unpack)
import System.Glib.FFI
import System.Glib.UTFString
import Graphics.Rendering.Pango.Types (Font, PangoLayoutRaw)
-- {#import Graphics.Rendering.Pango.Enums#}


{-# LINE 85 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

-- | An RFC-3066 language designator to choose scripts.
--
newtype Language = Language (Ptr (Language)) deriving Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq

-- | Define the gint that c2hs is the Haskell type.
type GInt = (CInt)
{-# LINE 92 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show Language where
  show :: Language -> String
show (Language Ptr Language
ptr)
    | Ptr Language
ptrPtr Language -> Ptr Language -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr Language
forall a. Ptr a
nullPtr = String
""
    | Bool
otherwise = Text -> String
T.unpack (Text -> String) -> (IO Text -> Text) -> IO Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> String) -> IO Text -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO Text
forall s. GlibString s => CString -> IO s
peekUTFString (Ptr Language -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Language
ptr)

-- | Specifying no particular language.
emptyLanguage :: Language
emptyLanguage :: Language
emptyLanguage = Ptr Language -> Language
Language Ptr Language
forall a. Ptr a
nullPtr

-- | Take a RFC-3066 format language tag as a string and convert it to a
-- 'Language' type that can be efficiently passed around and compared with
-- other language tags.
--
-- * This function first canonicalizes the string by converting it to
-- lowercase, mapping \'_\' to \'-\', and stripping all characters
-- other than letters and \'-\'.
--
languageFromString :: GlibString string => string -> IO Language
languageFromString :: forall string. GlibString string => string -> IO Language
languageFromString string
language = (Ptr Language -> Language) -> IO (Ptr Language) -> IO Language
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Language -> Language
Language (IO (Ptr Language) -> IO Language)
-> IO (Ptr Language) -> IO Language
forall a b. (a -> b) -> a -> b
$
  string -> (CString -> IO (Ptr Language)) -> IO (Ptr Language)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
language CString -> IO (Ptr Language)
pango_language_from_string
{-# LINE 113 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

-- | The style of a font.
--
-- * 'StyleOblique' is a slanted font like 'StyleItalic',
-- but in a roman style.
--
data FontStyle = StyleNormal
               | StyleOblique
               | StyleItalic
               deriving (Enum,Eq)

{-# LINE 120 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show FontStyle where
  showsPrec _ StyleNormal = shows "normal"
  showsPrec _ StyleOblique = shows "oblique"
  showsPrec _ StyleItalic = shows "italic"

-- | Define attributes for 'Weight'.
--
data Weight = WeightThin
            | WeightUltralight
            | WeightLight
            | WeightSemilight
            | WeightBook
            | WeightNormal
            | WeightMedium
            | WeightSemibold
            | WeightBold
            | WeightUltrabold
            | WeightHeavy
            | WeightUltraheavy
            deriving (Eq)
instance Enum Weight where
  fromEnum WeightThin = 100
  fromEnum WeightUltralight = 200
  fromEnum WeightLight = 300
  fromEnum WeightSemilight = 350
  fromEnum WeightBook = 380
  fromEnum WeightNormal = 400
  fromEnum WeightMedium = 500
  fromEnum WeightSemibold = 600
  fromEnum WeightBold = 700
  fromEnum WeightUltrabold = 800
  fromEnum WeightHeavy = 900
  fromEnum WeightUltraheavy = 1000

  toEnum :: Int -> Weight
toEnum Int
100 = Weight
WeightThin
  toEnum Int
200 = Weight
WeightUltralight
  toEnum Int
300 = Weight
WeightLight
  toEnum Int
350 = Weight
WeightSemilight
  toEnum Int
380 = Weight
WeightBook
  toEnum Int
400 = Weight
WeightNormal
  toEnum Int
500 = Weight
WeightMedium
  toEnum Int
600 = Weight
WeightSemibold
  toEnum Int
700 = Weight
WeightBold
  toEnum Int
800 = Weight
WeightUltrabold
  toEnum Int
900 = Weight
WeightHeavy
  toEnum Int
1000 = Weight
WeightUltraheavy
  toEnum Int
unmatched = String -> Weight
forall a. HasCallStack => String -> a
error (String
"Weight.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

  succ WeightThin = WeightUltralight
  succ WeightUltralight = WeightLight
  succ WeightLight = WeightSemilight
  succ WeightSemilight = WeightBook
  succ WeightBook = WeightNormal
  succ WeightNormal = WeightMedium
  succ WeightMedium = WeightSemibold
  succ WeightSemibold = WeightBold
  succ WeightBold = WeightUltrabold
  succ WeightUltrabold = WeightHeavy
  succ WeightHeavy = WeightUltraheavy
  succ _ = undefined

  pred WeightUltralight = WeightThin
  pred WeightLight = WeightUltralight
  pred WeightSemilight = WeightLight
  pred WeightBook = WeightSemilight
  pred WeightNormal = WeightBook
  pred WeightMedium = WeightNormal
  pred WeightSemibold = WeightMedium
  pred WeightBold = WeightSemibold
  pred WeightUltrabold = WeightBold
  pred WeightHeavy = WeightUltrabold
  pred WeightUltraheavy = WeightHeavy
  pred _ = undefined

  enumFromTo :: Weight -> Weight -> [Weight]
enumFromTo Weight
x Weight
y | Weight -> Int
forall a. Enum a => a -> Int
fromEnum Weight
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Weight -> Int
forall a. Enum a => a -> Int
fromEnum Weight
y = [ Weight
y ]
                 | Bool
otherwise = Weight
x Weight -> [Weight] -> [Weight]
forall a. a -> [a] -> [a]
: Weight -> Weight -> [Weight]
forall a. Enum a => a -> a -> [a]
enumFromTo (Weight -> Weight
forall a. Enum a => a -> a
succ Weight
x) Weight
y
  enumFrom :: Weight -> [Weight]
enumFrom Weight
x = Weight -> Weight -> [Weight]
forall a. Enum a => a -> a -> [a]
enumFromTo Weight
x Weight
WeightUltraheavy
  enumFromThen :: Weight -> Weight -> [Weight]
enumFromThen Weight
_ Weight
_ =     String -> [Weight]
forall a. HasCallStack => String -> a
error String
"Enum Weight: enumFromThen not implemented"
  enumFromThenTo :: Weight -> Weight -> Weight -> [Weight]
enumFromThenTo Weight
_ Weight
_ Weight
_ =     String -> [Weight]
forall a. HasCallStack => String -> a
error String
"Enum Weight: enumFromThenTo not implemented"

{-# LINE 129 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show Weight where
  showsPrec _ WeightUltralight = shows "ultralight"
  showsPrec _ WeightLight = shows "light"
  showsPrec _ WeightNormal = shows "normal"
  showsPrec _ WeightSemibold = shows "semibold"
  showsPrec _ WeightBold = shows "bold"
  showsPrec _ WeightUltrabold = shows "ultrabold"
  showsPrec _ WeightHeavy = shows "heavy"

  showsPrec _ WeightThin = shows "thin"
  showsPrec _ WeightBook = shows "book"
  showsPrec _ WeightMedium = shows "medium"
  showsPrec _ WeightUltraheavy = shows "ultraheavy"


-- | The variant of a font.
--
-- * The 'VariantSmallCaps' is a version of a font where lower case
-- letters are shown as physically smaller upper case letters.
--
data Variant = VariantNormal
             | VariantSmallCaps
             | VariantAllSmallCaps
             | VariantPetiteCaps
             | VariantAllPetiteCaps
             | VariantUnicase
             | VariantTitleCaps
             deriving (Enum,Eq)

{-# LINE 151 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show Variant where
  showsPrec _ VariantNormal = shows "normal"
  showsPrec _ VariantSmallCaps = shows "smallcaps"

-- | Define how wide characters are.
--
data Stretch = StretchUltraCondensed
             | StretchExtraCondensed
             | StretchCondensed
             | StretchSemiCondensed
             | StretchNormal
             | StretchSemiExpanded
             | StretchExpanded
             | StretchExtraExpanded
             | StretchUltraExpanded
             deriving (Enum,Eq)

{-# LINE 159 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show Stretch where
  showsPrec _ StretchUltraCondensed = shows "ultracondensed"
  showsPrec _ StretchExtraCondensed = shows "extracondensed"
  showsPrec _ StretchCondensed = shows "condensed"
  showsPrec _ StretchSemiCondensed = shows "semicondensed"
  showsPrec _ StretchNormal = shows "normal"
  showsPrec _ StretchSemiExpanded = shows "semiexpanded"
  showsPrec _ StretchExpanded = shows "expanded"
  showsPrec _ StretchExtraExpanded = shows "extraexpanded"
  showsPrec _ StretchUltraExpanded = shows "ultraexpanded"

-- | Define attributes for 'Underline'.
--
-- * The squiggly underline for errors is only available in Gtk 2.4 and higher.
--
data Underline = UnderlineNone
               | UnderlineSingle
               | UnderlineDouble
               | UnderlineLow
               | UnderlineError
               | UnderlineSingleLine
               | UnderlineDoubleLine
               | UnderlineErrorLine
               deriving (Enum,Eq)

{-# LINE 176 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show Underline where
  showsPrec _ UnderlineNone = shows "none"
  showsPrec _ UnderlineSingle = shows "single"
  showsPrec _ UnderlineDouble = shows "double"
  showsPrec _ UnderlineLow = shows "low"
  showsPrec _ UnderlineError = shows "error"


-- | The 'PangoGravity' type represents the orientation of glyphs in a
-- segment of text. The value 'GravitySouth', for instance, indicates that the
-- text stands upright, i.e. that the base of the letter is directed
-- downwards.
--
-- This is useful when rendering vertical text layouts. In those situations,
-- the layout is rotated using a non-identity 'PangoMatrix', and then glyph
-- orientation is controlled using 'PangoGravity'. Not every value in this
-- enumeration makes sense for every usage of 'Gravity'; for example,
-- 'PangoGravityAuto' only can be passed to 'pangoContextSetBaseGravity' and
-- can only be returned by 'pangoContextGetBaseGravity'.
--
-- * See also: 'PangoGravityHint'
--
-- * Gravity is resolved from the context matrix.
--
-- * Since Pango 1.16
--
data PangoGravity = PangoGravitySouth
                  | PangoGravityEast
                  | PangoGravityNorth
                  | PangoGravityWest
                  | PangoGravityAuto
                  deriving (Int -> PangoGravity
PangoGravity -> Int
PangoGravity -> [PangoGravity]
PangoGravity -> PangoGravity
PangoGravity -> PangoGravity -> [PangoGravity]
PangoGravity -> PangoGravity -> PangoGravity -> [PangoGravity]
(PangoGravity -> PangoGravity)
-> (PangoGravity -> PangoGravity)
-> (Int -> PangoGravity)
-> (PangoGravity -> Int)
-> (PangoGravity -> [PangoGravity])
-> (PangoGravity -> PangoGravity -> [PangoGravity])
-> (PangoGravity -> PangoGravity -> [PangoGravity])
-> (PangoGravity -> PangoGravity -> PangoGravity -> [PangoGravity])
-> Enum PangoGravity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PangoGravity -> PangoGravity
succ :: PangoGravity -> PangoGravity
$cpred :: PangoGravity -> PangoGravity
pred :: PangoGravity -> PangoGravity
$ctoEnum :: Int -> PangoGravity
toEnum :: Int -> PangoGravity
$cfromEnum :: PangoGravity -> Int
fromEnum :: PangoGravity -> Int
$cenumFrom :: PangoGravity -> [PangoGravity]
enumFrom :: PangoGravity -> [PangoGravity]
$cenumFromThen :: PangoGravity -> PangoGravity -> [PangoGravity]
enumFromThen :: PangoGravity -> PangoGravity -> [PangoGravity]
$cenumFromTo :: PangoGravity -> PangoGravity -> [PangoGravity]
enumFromTo :: PangoGravity -> PangoGravity -> [PangoGravity]
$cenumFromThenTo :: PangoGravity -> PangoGravity -> PangoGravity -> [PangoGravity]
enumFromThenTo :: PangoGravity -> PangoGravity -> PangoGravity -> [PangoGravity]
Enum,PangoGravity -> PangoGravity -> Bool
(PangoGravity -> PangoGravity -> Bool)
-> (PangoGravity -> PangoGravity -> Bool) -> Eq PangoGravity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PangoGravity -> PangoGravity -> Bool
== :: PangoGravity -> PangoGravity -> Bool
$c/= :: PangoGravity -> PangoGravity -> Bool
/= :: PangoGravity -> PangoGravity -> Bool
Eq)

{-# LINE 204 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show PangoGravity where
  show PangoGravitySouth = "south"
  show PangoGravityEast = "east"
  show PangoGravityNorth = "north"
  show PangoGravityWest = "west"
  show PangoGravityAuto = "auto"

-- | The 'PangoGravityHint' defines how horizontal scripts should behave in a
-- vertical context.
--
-- * 'PangoGravityHintNatural': scripts will take their natural gravity based
-- on the base gravity and the script. This is the default.
--
-- * 'PangoGravityHintStrong': always use the base gravity set, regardless of
-- the script.
--
-- * 'PangoGravityHintLine': for scripts not in their natural direction (eg.
-- Latin in East gravity), choose per-script gravity such that every script
-- respects the line progression. This means, Latin and Arabic will take
-- opposite gravities and both flow top-to-bottom for example.
--
data PangoGravityHint = PangoGravityHintNatural
                      | PangoGravityHintStrong
                      | PangoGravityHintLine
                      deriving (Int -> PangoGravityHint
PangoGravityHint -> Int
PangoGravityHint -> [PangoGravityHint]
PangoGravityHint -> PangoGravityHint
PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
PangoGravityHint
-> PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
(PangoGravityHint -> PangoGravityHint)
-> (PangoGravityHint -> PangoGravityHint)
-> (Int -> PangoGravityHint)
-> (PangoGravityHint -> Int)
-> (PangoGravityHint -> [PangoGravityHint])
-> (PangoGravityHint -> PangoGravityHint -> [PangoGravityHint])
-> (PangoGravityHint -> PangoGravityHint -> [PangoGravityHint])
-> (PangoGravityHint
    -> PangoGravityHint -> PangoGravityHint -> [PangoGravityHint])
-> Enum PangoGravityHint
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PangoGravityHint -> PangoGravityHint
succ :: PangoGravityHint -> PangoGravityHint
$cpred :: PangoGravityHint -> PangoGravityHint
pred :: PangoGravityHint -> PangoGravityHint
$ctoEnum :: Int -> PangoGravityHint
toEnum :: Int -> PangoGravityHint
$cfromEnum :: PangoGravityHint -> Int
fromEnum :: PangoGravityHint -> Int
$cenumFrom :: PangoGravityHint -> [PangoGravityHint]
enumFrom :: PangoGravityHint -> [PangoGravityHint]
$cenumFromThen :: PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
enumFromThen :: PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
$cenumFromTo :: PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
enumFromTo :: PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
$cenumFromThenTo :: PangoGravityHint
-> PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
enumFromThenTo :: PangoGravityHint
-> PangoGravityHint -> PangoGravityHint -> [PangoGravityHint]
Enum,PangoGravityHint -> PangoGravityHint -> Bool
(PangoGravityHint -> PangoGravityHint -> Bool)
-> (PangoGravityHint -> PangoGravityHint -> Bool)
-> Eq PangoGravityHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PangoGravityHint -> PangoGravityHint -> Bool
== :: PangoGravityHint -> PangoGravityHint -> Bool
$c/= :: PangoGravityHint -> PangoGravityHint -> Bool
/= :: PangoGravityHint -> PangoGravityHint -> Bool
Eq)

{-# LINE 227 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

instance Show PangoGravityHint where
  show PangoGravityHintNatural = "natural"
  show PangoGravityHintStrong = "strong"
  show PangoGravityHintLine = "line"



-- A string that is stored with each GlyphString, PangoItem
data PangoString = PangoString UTFCorrection CInt (ForeignPtr CChar)

makeNewPangoString :: GlibString string => string -> IO PangoString
makeNewPangoString :: forall string. GlibString string => string -> IO PangoString
makeNewPangoString string
str = do
  let correct :: UTFCorrection
correct = string -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs string
str
  (CString
strPtr, Int
len) <- string -> IO (CString, Int)
forall s. GlibString s => s -> IO (CString, Int)
newUTFStringLen string
str
  let cLen :: CInt
cLen = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
  (ForeignPtr CChar -> PangoString)
-> IO (ForeignPtr CChar) -> IO PangoString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (UTFCorrection -> CInt -> ForeignPtr CChar -> PangoString
PangoString UTFCorrection
correct CInt
cLen) (IO (ForeignPtr CChar) -> IO PangoString)
-> IO (ForeignPtr CChar) -> IO PangoString
forall a b. (a -> b) -> a -> b
$ CString -> FinalizerPtr CChar -> IO (ForeignPtr CChar)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr CString
strPtr FinalizerPtr CChar
forall a. FinalizerPtr a
finalizerFree

withPangoString :: PangoString ->
                   (UTFCorrection -> CInt -> Ptr CChar -> IO a) -> IO a
withPangoString :: forall a.
PangoString -> (UTFCorrection -> CInt -> CString -> IO a) -> IO a
withPangoString (PangoString UTFCorrection
c CInt
l ForeignPtr CChar
ptr) UTFCorrection -> CInt -> CString -> IO a
act = ForeignPtr CChar -> (CString -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
ptr ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->
  UTFCorrection -> CInt -> CString -> IO a
act UTFCorrection
c CInt
l CString
strPtr

-- paired with PangoString to create a Haskell GlyphString
newtype GlyphStringRaw = GlyphStringRaw (ForeignPtr (GlyphStringRaw))
{-# LINE 252 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

makeNewGlyphStringRaw :: Ptr GlyphStringRaw -> IO GlyphStringRaw
makeNewGlyphStringRaw :: Ptr GlyphStringRaw -> IO GlyphStringRaw
makeNewGlyphStringRaw Ptr GlyphStringRaw
llPtr = do
  (ForeignPtr GlyphStringRaw -> GlyphStringRaw)
-> IO (ForeignPtr GlyphStringRaw) -> IO GlyphStringRaw
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr GlyphStringRaw -> GlyphStringRaw
GlyphStringRaw (IO (ForeignPtr GlyphStringRaw) -> IO GlyphStringRaw)
-> IO (ForeignPtr GlyphStringRaw) -> IO GlyphStringRaw
forall a b. (a -> b) -> a -> b
$ Ptr GlyphStringRaw
-> FinalizerPtr GlyphStringRaw -> IO (ForeignPtr GlyphStringRaw)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr GlyphStringRaw
llPtr FinalizerPtr GlyphStringRaw
pango_glyph_string_free

foreign import ccall unsafe "&pango_glyph_string_free"
  pango_glyph_string_free :: FinalizerPtr GlyphStringRaw

-- paired with PangoString and UTFCorrection to create a Haskell PangoItem
newtype PangoItemRaw = PangoItemRaw (ForeignPtr (PangoItemRaw))
{-# LINE 262 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

makeNewPangoItemRaw :: Ptr PangoItemRaw -> IO PangoItemRaw
makeNewPangoItemRaw :: Ptr PangoItemRaw -> IO PangoItemRaw
makeNewPangoItemRaw Ptr PangoItemRaw
llPtr = do
  (ForeignPtr PangoItemRaw -> PangoItemRaw)
-> IO (ForeignPtr PangoItemRaw) -> IO PangoItemRaw
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr PangoItemRaw -> PangoItemRaw
PangoItemRaw (IO (ForeignPtr PangoItemRaw) -> IO PangoItemRaw)
-> IO (ForeignPtr PangoItemRaw) -> IO PangoItemRaw
forall a b. (a -> b) -> a -> b
$ Ptr PangoItemRaw
-> FinalizerPtr PangoItemRaw -> IO (ForeignPtr PangoItemRaw)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr PangoItemRaw
llPtr FinalizerPtr PangoItemRaw
pango_item_free

withPangoItemRaw :: PangoItemRaw -> (Ptr PangoItemRaw -> IO a) -> IO a
withPangoItemRaw :: forall a. PangoItemRaw -> (Ptr PangoItemRaw -> IO a) -> IO a
withPangoItemRaw (PangoItemRaw ForeignPtr PangoItemRaw
pir) Ptr PangoItemRaw -> IO a
act = ForeignPtr PangoItemRaw -> (Ptr PangoItemRaw -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PangoItemRaw
pir Ptr PangoItemRaw -> IO a
act

foreign import ccall unsafe "&pango_item_free"
  pango_item_free :: FinalizerPtr PangoItemRaw


type GlyphItemRaw = Ptr (())
{-# LINE 275 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}


-- With each GlyphString we pair a UTFCorrection
-- and the marshalled UTF8 string. Together, this data
-- enables us to bind all functions that take or return
-- indices into the CString, rather then unicode position. Note that text
-- handling is particularly horrible with UTF8: Several UTF8 bytes can make
-- up one Unicode character (a Haskell Char), and several Unicode characters
-- can form a cluster (e.g. a letter and an accent). We protect the user from
-- UTF8\/Haskell String conversions, but not from clusters.

-- | A sequence of characters that are rendered with the same settings.
--
-- * A preprocessing stage done by 'itemize' splits the input text into
-- several chunks such that each chunk can be rendered with the same
-- font, direction, slant, etc. Some attributes such as the color,
-- underline or strikethrough do not affect a break into several
-- 'PangoItem's. See also 'GlyphItem'.
--
data PangoItem = PangoItem PangoString PangoItemRaw

-- | A sequence of glyphs for a chunk of a string.
--
-- * A glyph item contains the graphical representation of a 'PangoItem'.
-- Clusters (like @e@ and an accent modifier) as well as legatures
-- (such as @ffi@ turning into a single letter that omits the dot over the
-- @i@) are usually represented as a single glyph.
--
data GlyphItem = GlyphItem PangoItem GlyphStringRaw

-- | A rendered paragraph.
data PangoLayout = PangoLayout (IORef PangoString) PangoLayoutRaw

-- | An iterator to examine a layout.
--
data LayoutIter = LayoutIter (IORef PangoString) LayoutIterRaw

newtype LayoutIterRaw = LayoutIterRaw (ForeignPtr (LayoutIterRaw))
{-# LINE 313 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

makeNewLayoutIterRaw :: Ptr LayoutIterRaw -> IO LayoutIterRaw
makeNewLayoutIterRaw :: Ptr LayoutIterRaw -> IO LayoutIterRaw
makeNewLayoutIterRaw Ptr LayoutIterRaw
liPtr =
  (ForeignPtr LayoutIterRaw -> LayoutIterRaw)
-> IO (ForeignPtr LayoutIterRaw) -> IO LayoutIterRaw
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr LayoutIterRaw -> LayoutIterRaw
LayoutIterRaw (IO (ForeignPtr LayoutIterRaw) -> IO LayoutIterRaw)
-> IO (ForeignPtr LayoutIterRaw) -> IO LayoutIterRaw
forall a b. (a -> b) -> a -> b
$ Ptr LayoutIterRaw
-> FinalizerPtr LayoutIterRaw -> IO (ForeignPtr LayoutIterRaw)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr LayoutIterRaw
liPtr FinalizerPtr LayoutIterRaw
layout_iter_free

foreign import ccall unsafe "&pango_layout_iter_free"
  layout_iter_free :: FinalizerPtr LayoutIterRaw

-- | A single line in a 'PangoLayout'.
--
data LayoutLine = LayoutLine (IORef PangoString) LayoutLineRaw

newtype LayoutLineRaw = LayoutLineRaw (ForeignPtr (LayoutLineRaw))
{-# LINE 326 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

makeNewLayoutLineRaw :: Ptr LayoutLineRaw -> IO LayoutLineRaw
makeNewLayoutLineRaw :: Ptr LayoutLineRaw -> IO LayoutLineRaw
makeNewLayoutLineRaw Ptr LayoutLineRaw
llPtr = do
  (ForeignPtr LayoutLineRaw -> LayoutLineRaw)
-> IO (ForeignPtr LayoutLineRaw) -> IO LayoutLineRaw
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr LayoutLineRaw -> LayoutLineRaw
LayoutLineRaw (IO (ForeignPtr LayoutLineRaw) -> IO LayoutLineRaw)
-> IO (ForeignPtr LayoutLineRaw) -> IO LayoutLineRaw
forall a b. (a -> b) -> a -> b
$ Ptr LayoutLineRaw
-> FinalizerPtr LayoutLineRaw -> IO (ForeignPtr LayoutLineRaw)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr LayoutLineRaw
llPtr FinalizerPtr LayoutLineRaw
pango_layout_line_unref

foreign import ccall unsafe "&pango_layout_line_unref"
  pango_layout_line_unref :: FinalizerPtr LayoutLineRaw

-- | A possibly partial description of font(s).
--
newtype FontDescription = FontDescription (ForeignPtr (FontDescription))
{-# LINE 337 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

makeNewFontDescription :: Ptr FontDescription -> IO FontDescription
makeNewFontDescription :: Ptr FontDescription -> IO FontDescription
makeNewFontDescription Ptr FontDescription
llPtr = do
  (ForeignPtr FontDescription -> FontDescription)
-> IO (ForeignPtr FontDescription) -> IO FontDescription
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr FontDescription -> FontDescription
FontDescription (IO (ForeignPtr FontDescription) -> IO FontDescription)
-> IO (ForeignPtr FontDescription) -> IO FontDescription
forall a b. (a -> b) -> a -> b
$ Ptr FontDescription
-> FinalizerPtr FontDescription -> IO (ForeignPtr FontDescription)
forall a. Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
newForeignPtr Ptr FontDescription
llPtr FinalizerPtr FontDescription
pango_font_description_free

foreign import ccall unsafe "&pango_font_description_free"
  pango_font_description_free :: FinalizerPtr FontDescription

-- Attributes
type PangoAttrList = Ptr (())
{-# LINE 347 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

type CPangoAttribute = Ptr (())
{-# LINE 349 "./Graphics/Rendering/Pango/BasicTypes.chs" #-}

-- dirty hack to make PangoAttribute showable
instance Show FontDescription where
  show :: FontDescription -> String
show FontDescription
fd = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
    CString
strPtr <- (\(FontDescription ForeignPtr FontDescription
arg1) -> ForeignPtr FontDescription
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FontDescription
arg1 ((Ptr FontDescription -> IO CString) -> IO CString)
-> (Ptr FontDescription -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr FontDescription
argPtr1 ->Ptr FontDescription -> IO CString
pango_font_description_to_string Ptr FontDescription
argPtr1) FontDescription
fd
    Text
str <- CString -> IO Text
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
    Ptr () -> IO ()
g_free (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
strPtr)
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str

foreign import ccall safe "pango_language_from_string"
  pango_language_from_string :: ((Ptr CChar) -> (IO (Ptr Language)))

foreign import ccall unsafe "pango_font_description_to_string"
  pango_font_description_to_string :: ((Ptr FontDescription) -> (IO (Ptr CChar)))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))