{-# LINE 2 "./Graphics/Rendering/Pango/Rendering.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) - text layout functions Rendering
--
-- Author : Axel Simon
--
-- Created: 8 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.
--
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Functions to run the rendering pipeline.
--
-- * This module provides elementary rendering functions. For a simpler
-- interface, consider using 'PangoLayout's.
--
-- * The Pango rendering pipeline takes a string of Unicode characters,
-- divides them into sequences of letters that have the same characteristics
-- such as font, size, color, etc. Such a sequence is called 'PangoItem'.
-- Each 'PangoItem' is then converted into one 'GlyphItem', that is
-- an actual sequence of glyphs,
-- where several characters might be turned into legatures or clusters,
-- e.g. an \"e\" and an accent modifier are turned into a single glyph. These
-- 'GlyphItem's can then be rendered onto the output device with functions
-- such as 'Graphics.Rendering.Cairo.cairoShowGlyphString'.
--
module Graphics.Rendering.Pango.Rendering (
  -- * 'PangoItem': Partition text into units with similar attributes.
  PangoItem,
  pangoItemize,
  pangoItemGetFontMetrics,
  pangoItemGetFont,
  pangoItemGetLanguage,

  -- * 'GlyphItem': Turn text segments into glyph sequences.
  GlyphItem,
  pangoShape,
  glyphItemExtents,
  glyphItemExtentsRange,
  glyphItemIndexToX,
  glyphItemXToIndex,
  glyphItemGetLogicalWidths,

  glyphItemSplit

  ) where

import System.Glib.FFI
import System.Glib.UTFString
import Graphics.Rendering.Pango.Structs ( pangoItemRawAnalysis, intToPu,
  pangoItemRawGetOffset, pangoItemRawGetLength,
  pangoItemGetFont, pangoItemGetLanguage)
import Graphics.Rendering.Pango.Types (PangoContext(..), Font(..))
import Graphics.Rendering.Pango.BasicTypes
{-# LINE 70 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.Enums
{-# LINE 71 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.Attributes
{-# LINE 72 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.GlyphStorage
import System.Glib.GList
{-# LINE 74 "./Graphics/Rendering/Pango/Rendering.chs" #-}


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

-- | Turn a string into a sequence of glyphs.
--
-- * Partitions the input string into segments with the same text direction
-- and shaping engine. The generated list of items will be in logical order
-- (the start offsets of the items are ascending).
--
pangoItemize :: GlibString string => PangoContext -> string -> [PangoAttribute] -> IO [PangoItem]
pangoItemize :: forall string.
GlibString string =>
PangoContext -> string -> [PangoAttribute] -> IO [PangoItem]
pangoItemize PangoContext
pc string
str [PangoAttribute]
attrs = do
  PangoString
ps <- string -> IO PangoString
forall string. GlibString string => string -> IO PangoString
makeNewPangoString string
str
  PangoString
-> [PangoAttribute] -> (Ptr () -> IO [PangoItem]) -> IO [PangoItem]
forall a.
PangoString -> [PangoAttribute] -> (Ptr () -> IO a) -> IO a
withAttrList PangoString
ps [PangoAttribute]
attrs ((Ptr () -> IO [PangoItem]) -> IO [PangoItem])
-> (Ptr () -> IO [PangoItem]) -> IO [PangoItem]
forall a b. (a -> b) -> a -> b
$ \Ptr ()
alPtr -> do
    Ptr ()
glist <- PangoString
-> (UTFCorrection -> CInt -> Ptr CChar -> IO (Ptr ()))
-> IO (Ptr ())
forall a.
PangoString -> (UTFCorrection -> CInt -> Ptr CChar -> IO a) -> IO a
withPangoString PangoString
ps ((UTFCorrection -> CInt -> Ptr CChar -> IO (Ptr ()))
 -> IO (Ptr ()))
-> (UTFCorrection -> CInt -> Ptr CChar -> IO (Ptr ()))
-> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \UTFCorrection
_ CInt
l Ptr CChar
strPtr ->
             (\(PangoContext ForeignPtr PangoContext
arg1) Ptr CChar
arg2 CInt
arg3 CInt
arg4 Ptr ()
arg5 Ptr ()
arg6 -> ForeignPtr PangoContext
-> (Ptr PangoContext -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PangoContext
arg1 ((Ptr PangoContext -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr PangoContext -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr PangoContext
argPtr1 ->Ptr PangoContext
-> Ptr CChar -> CInt -> CInt -> Ptr () -> Ptr () -> IO (Ptr ())
pango_itemize Ptr PangoContext
argPtr1 Ptr CChar
arg2 CInt
arg3 CInt
arg4 Ptr ()
arg5 Ptr ()
arg6) PangoContext
pc Ptr CChar
strPtr CInt
0 CInt
l Ptr ()
alPtr Ptr ()
forall a. Ptr a
nullPtr
    [Ptr PangoItemRaw]
piPtrs <- Ptr () -> IO [Ptr PangoItemRaw]
forall a. Ptr () -> IO [Ptr a]
fromGList Ptr ()
glist
    [PangoItemRaw]
piRaws <- (Ptr PangoItemRaw -> IO PangoItemRaw)
-> [Ptr PangoItemRaw] -> IO [PangoItemRaw]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr PangoItemRaw -> IO PangoItemRaw
makeNewPangoItemRaw [Ptr PangoItemRaw]
piPtrs
    [PangoItem] -> IO [PangoItem]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((PangoItemRaw -> PangoItem) -> [PangoItemRaw] -> [PangoItem]
forall a b. (a -> b) -> [a] -> [b]
map (PangoString -> PangoItemRaw -> PangoItem
PangoItem PangoString
ps) [PangoItemRaw]
piRaws)


-- | Retrieve the metrics of the font that was chosen to break the given
-- 'PangoItem'.
--
pangoItemGetFontMetrics :: PangoItem -> IO FontMetrics
pangoItemGetFontMetrics :: PangoItem -> IO FontMetrics
pangoItemGetFontMetrics PangoItem
pi = do
  Font
font <- PangoItem -> IO Font
pangoItemGetFont PangoItem
pi
  Language
lang <- PangoItem -> IO Language
pangoItemGetLanguage PangoItem
pi
  Ptr ()
mPtr <- (\(Font ForeignPtr Font
arg1) (Language Ptr Language
arg2) -> ForeignPtr Font -> (Ptr Font -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Font
arg1 ((Ptr Font -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Font -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Font
argPtr1 ->Ptr Font -> Ptr Language -> IO (Ptr ())
pango_font_get_metrics Ptr Font
argPtr1 Ptr Language
arg2) Font
font Language
lang
  CInt
ascent <- Ptr () -> IO CInt
pango_font_metrics_get_ascent Ptr ()
mPtr
  CInt
descent <- Ptr () -> IO CInt
pango_font_metrics_get_descent Ptr ()
mPtr
  CInt
approximate_char_width <-
      Ptr () -> IO CInt
pango_font_metrics_get_approximate_char_width Ptr ()
mPtr
  CInt
approximate_digit_width <-
      Ptr () -> IO CInt
pango_font_metrics_get_approximate_digit_width Ptr ()
mPtr

  CInt
underline_position <-
      Ptr () -> IO CInt
pango_font_metrics_get_underline_position Ptr ()
mPtr
  CInt
underline_thickness <-
      Ptr () -> IO CInt
pango_font_metrics_get_underline_thickness Ptr ()
mPtr
  CInt
strikethrough_position <-
      Ptr () -> IO CInt
pango_font_metrics_get_strikethrough_position Ptr ()
mPtr
  CInt
strikethrough_thickness <-
      Ptr () -> IO CInt
pango_font_metrics_get_strikethrough_thickness Ptr ()
mPtr

  FontMetrics -> IO FontMetrics
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> FontMetrics
FontMetrics
          (CInt -> Double
intToPu CInt
ascent)
          (CInt -> Double
intToPu CInt
descent)
          (CInt -> Double
intToPu CInt
approximate_char_width)
          (CInt -> Double
intToPu CInt
approximate_digit_width)

          (CInt -> Double
intToPu CInt
underline_position)
          (CInt -> Double
intToPu CInt
underline_thickness)
          (CInt -> Double
intToPu CInt
strikethrough_position)
          (CInt -> Double
intToPu CInt
strikethrough_thickness)

         )

-- | Turn a 'PangoItem' into a 'GlyphItem'.
--
-- * Turns a 'PangoItem', that is, sequence of characters with the same
-- attributes such as font, size and color, into a 'GlyphItem' which
-- contains the graphical representation of these characters. 'GlyphItem's
-- can be rendered directly (and several times) onto screens.
--
pangoShape :: PangoItem -> IO GlyphItem
pangoShape :: PangoItem -> IO GlyphItem
pangoShape pi :: PangoItem
pi@(PangoItem PangoString
ps PangoItemRaw
pir) =
  PangoString
-> (UTFCorrection -> CInt -> Ptr CChar -> IO GlyphItem)
-> IO GlyphItem
forall a.
PangoString -> (UTFCorrection -> CInt -> Ptr CChar -> IO a) -> IO a
withPangoString PangoString
ps ((UTFCorrection -> CInt -> Ptr CChar -> IO GlyphItem)
 -> IO GlyphItem)
-> (UTFCorrection -> CInt -> Ptr CChar -> IO GlyphItem)
-> IO GlyphItem
forall a b. (a -> b) -> a -> b
$ \UTFCorrection
_ CInt
_ Ptr CChar
strPtr -> PangoItemRaw -> (Ptr PangoItemRaw -> IO GlyphItem) -> IO GlyphItem
forall a. PangoItemRaw -> (Ptr PangoItemRaw -> IO a) -> IO a
withPangoItemRaw PangoItemRaw
pir ((Ptr PangoItemRaw -> IO GlyphItem) -> IO GlyphItem)
-> (Ptr PangoItemRaw -> IO GlyphItem) -> IO GlyphItem
forall a b. (a -> b) -> a -> b
$ \Ptr PangoItemRaw
pirPtr -> do
  Ptr GlyphStringRaw
gsPtr <- IO (Ptr GlyphStringRaw)
pango_glyph_string_new
{-# LINE 142 "./Graphics/Rendering/Pango/Rendering.chs" #-}
  gs <- makeNewGlyphStringRaw gsPtr
  Int32
ofs <- Ptr PangoItemRaw -> IO Int32
forall pangoItem. Ptr pangoItem -> IO Int32
pangoItemRawGetOffset Ptr PangoItemRaw
pirPtr
  Int32
len <- Ptr PangoItemRaw -> IO Int32
forall pangoItem. Ptr pangoItem -> IO Int32
pangoItemRawGetLength Ptr PangoItemRaw
pirPtr
  (\Ptr CChar
arg1 CInt
arg2 Ptr ()
arg3 (GlyphStringRaw ForeignPtr GlyphStringRaw
arg4) -> ForeignPtr GlyphStringRaw -> (Ptr GlyphStringRaw -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GlyphStringRaw
arg4 ((Ptr GlyphStringRaw -> IO ()) -> IO ())
-> (Ptr GlyphStringRaw -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GlyphStringRaw
argPtr4 ->Ptr CChar -> CInt -> Ptr () -> Ptr GlyphStringRaw -> IO ()
pango_shape Ptr CChar
arg1 CInt
arg2 Ptr ()
arg3 Ptr GlyphStringRaw
argPtr4) (Ptr CChar
strPtr Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ofs)) (Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
    (Ptr PangoItemRaw -> Ptr ()
forall pangoItem pangoAnalysis. Ptr pangoItem -> Ptr pangoAnalysis
pangoItemRawAnalysis Ptr PangoItemRaw
pirPtr) GlyphStringRaw
gs
  GlyphItem -> IO GlyphItem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PangoItem -> GlyphStringRaw -> GlyphItem
GlyphItem PangoItem
pi GlyphStringRaw
gs)

foreign import ccall unsafe "pango_itemize"
  pango_itemize :: ((Ptr PangoContext) -> ((Ptr CChar) -> (CInt -> (CInt -> ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))))))

foreign import ccall unsafe "pango_font_get_metrics"
  pango_font_get_metrics :: ((Ptr Font) -> ((Ptr Language) -> (IO (Ptr ()))))

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

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

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

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

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

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

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

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

foreign import ccall unsafe "pango_glyph_string_new"
  pango_glyph_string_new :: (IO (Ptr GlyphStringRaw))

foreign import ccall unsafe "pango_shape"
  pango_shape :: ((Ptr CChar) -> (CInt -> ((Ptr ()) -> ((Ptr GlyphStringRaw) -> (IO ())))))