{-# LINE 2 "./Graphics/Rendering/Pango/Rendering.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) - text layout functions Rendering
--
-- Author : Axel Simon
--
-- Created: 8 Feburary 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 Graphics.Rendering.Pango.Structs ( pangoItemRawAnalysis, intToPu,
  pangoItemGetFont, pangoItemGetLanguage)
import Graphics.Rendering.Pango.Types (PangoContext(..), Font(..))
import Graphics.Rendering.Pango.BasicTypes
{-# LINE 68 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.Enums
{-# LINE 69 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.Attributes
{-# LINE 70 "./Graphics/Rendering/Pango/Rendering.chs" #-}
import Graphics.Rendering.Pango.GlyphStorage
import System.Glib.GList
{-# LINE 72 "./Graphics/Rendering/Pango/Rendering.chs" #-}


{-# LINE 74 "./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 :: PangoContext -> String -> [PangoAttribute] -> IO [PangoItem]
pangoItemize pc str attrs = do
  ps <- makeNewPangoString str
  withAttrList ps attrs $ \alPtr -> do
    glist <- withPangoString ps $ \_ l strPtr ->
             (\(PangoContext arg1) arg2 arg3 arg4 arg5 arg6 -> withForeignPtr arg1 $ \argPtr1 ->pango_itemize argPtr1 arg2 arg3 arg4 arg5 arg6) pc strPtr 0 l alPtr nullPtr
    piPtrs <- fromGList glist
    piRaws <- mapM makeNewPangoItemRaw piPtrs
    return (map (PangoItem ps) piRaws)


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

  underline_position <-
      pango_font_metrics_get_underline_position mPtr
  underline_thickness <-
      pango_font_metrics_get_underline_thickness mPtr
  strikethrough_position <-
      pango_font_metrics_get_strikethrough_position mPtr
  strikethrough_thickness <-
      pango_font_metrics_get_strikethrough_thickness mPtr

  return (FontMetrics
          (intToPu ascent)
          (intToPu descent)
          (intToPu approximate_char_width)
          (intToPu approximate_digit_width)

          (intToPu underline_position)
          (intToPu underline_thickness)
          (intToPu strikethrough_position)
          (intToPu 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 pi@(PangoItem ps pir) =
  withPangoString ps $ \_ l strPtr -> withPangoItemRaw pir $ \pirPtr -> do
  gsPtr <- pango_glyph_string_new
{-# LINE 140 "./Graphics/Rendering/Pango/Rendering.chs" #-}
  gs <- makeNewGlyphStringRaw gsPtr
  (\arg1 arg2 arg3 (GlyphStringRaw arg4) -> withForeignPtr arg4 $ \argPtr4 ->pango_shape arg1 arg2 arg3 argPtr4) strPtr l (pangoItemRawAnalysis pirPtr) gs
  return (GlyphItem pi 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 ())))))