{-# LINE 2 "./Graphics/Rendering/Cairo/SVG.chs" #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Cairo.SVG
-- Copyright : (c) 2005 Duncan Coutts, Paolo Martini
-- License : BSD-style (see cairo/COPYRIGHT)
--
-- Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : experimental
-- Portability : portable
--
-- The SVG extension to the Cairo 2D graphics library.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Cairo.SVG (
  -- * Convenience API

  -- | These operations render an SVG image directly in the current 'Render'
  -- contect. Because they operate in the cairo 'Render' monad they are
  -- affected by the current transformation matrix. So it is possible, for
  -- example, to scale or rotate an SVG image.
  --
  -- In the following example we scale an SVG image to a unit square:
  --
  -- > let (width, height) = svgGetSize in
  -- > do scale (1/width) (1/height)
  -- > svgRender svg

  svgRenderFromFile,
  svgRenderFromHandle,
  svgRenderFromString,

  -- * Standard API

  -- | With this API there are seperate functions for loading the SVG and
  -- rendering it. This allows us to be more effecient in the case that an SVG
  -- image is used many times - since it can be loaded just once and rendered
  -- many times. With the convenience API above the SVG would be parsed and
  -- processed each time it is drawn.

  SVG,
  svgRender,
  svgGetSize,

  -- ** Block scoped versions

  -- | These versions of the SVG loading operations give temporary access
  -- to the 'SVG' object within the scope of the handler function. These
  -- operations guarantee that the resources for the SVG object are deallocated
  -- at the end of the handler block. If this form of resource allocation is
  -- too restrictive you can use the GC-managed versions below.
  --
  -- These versions are ofen used in the following style:
  --
  -- > withSvgFromFile "foo.svg" $ \svg -> do
  -- > ...
  -- > svgRender svg
  -- > ...

  withSvgFromFile,
  withSvgFromHandle,
  withSvgFromString,

  -- ** GC-managed versions

  -- | These versions of the SVG loading operations use the standard Haskell
  -- garbage collector to manage the resources associated with the 'SVG' object.
  -- As such they are more convenient to use but the GC cannot give
  -- strong guarantees about when the resources associated with the 'SVG' object
  -- will be released. In most circumstances this is not a problem, especially
  -- if the SVG files being used are not very big.

  svgNewFromFile,
  svgNewFromHandle,
  svgNewFromString,
  ) where

import Control.Monad (when)
import Foreign
import Foreign.C
import Control.Monad.Reader (ask, liftIO)
import System.IO (Handle, openFile, IOMode(ReadMode), hGetBuf)

import System.Glib.GError (GError(GError), checkGError)
import System.Glib.GObject (GObject(..), GObjectClass(..), wrapNewGObject,
                            unGObject, objectUnref)

import Graphics.Rendering.Cairo.Internal (Render, bracketR)
import Graphics.Rendering.Cairo.Types (Cairo(Cairo))


{-# LINE 93 "./Graphics/Rendering/Cairo/SVG.chs" #-}

---------------------
-- Types
--

newtype SVG = SVG (ForeignPtr (SVG))
{-# LINE 99 "./Graphics/Rendering/Cairo/SVG.chs" #-}

mkSVG = (SVG, objectUnref)
unSVG (SVG obj) = obj

instance GObjectClass SVG where
  toGObject = GObject . castForeignPtr . unSVG
  unsafeCastGObject = SVG . castForeignPtr . unGObject

---------------------
-- Basic API
--

-- block scoped versions

withSvgFromFile :: FilePath -> (SVG -> Render a) -> Render a
withSvgFromFile file action =
  withSVG $ \svg -> do
    liftIO $ svgParseFromFile file svg
    action svg

withSvgFromHandle :: Handle -> (SVG -> Render a) -> Render a
withSvgFromHandle hnd action =
  withSVG $ \svg -> do
    liftIO $ svgParseFromHandle hnd svg
    action svg

withSvgFromString :: String -> (SVG -> Render a) -> Render a
withSvgFromString str action =
  withSVG $ \svg -> do
    liftIO $ svgParseFromString str svg
    action svg

withSVG :: (SVG -> Render a) -> Render a
withSVG =
  bracketR (do
             g_type_init
{-# LINE 135 "./Graphics/Rendering/Cairo/SVG.chs" #-}
             svgPtr <- rsvg_handle_new
{-# LINE 136 "./Graphics/Rendering/Cairo/SVG.chs" #-}
             svgPtr' <- newForeignPtr_ svgPtr
             return (SVG svgPtr'))             
          (\(SVG fptr) -> withForeignPtr fptr $ \ptr ->
                            g_object_unref (castPtr ptr))

-- GC managed versions

svgNewFromFile :: FilePath -> IO SVG
svgNewFromFile file = do
  svg <- svgNew
  svgParseFromFile file svg
  return svg

svgNewFromHandle :: Handle -> IO SVG
svgNewFromHandle hnd = do
  svg <- svgNew
  svgParseFromHandle hnd svg
  return svg

svgNewFromString :: String -> IO SVG
svgNewFromString str = do
  svg <- svgNew
  svgParseFromString str svg
  return svg

svgNew :: IO SVG
svgNew = do
  g_type_init
{-# LINE 164 "./Graphics/Rendering/Cairo/SVG.chs" #-}
  wrapNewGObject mkSVG rsvg_handle_new
{-# LINE 165 "./Graphics/Rendering/Cairo/SVG.chs" #-}


-- internal implementation

svgParseFromFile :: FilePath -> SVG -> IO ()
svgParseFromFile file svg = do
  hnd <- openFile file ReadMode
  svgParseFromHandle hnd svg

svgParseFromHandle :: Handle -> SVG -> IO ()
svgParseFromHandle hnd svg =
  allocaBytes 4096 $ \bufferPtr -> do
  let loop = do
        count <- hGetBuf hnd bufferPtr 4096
        when (count > 0)
             (checkStatus $ (\(SVG arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_write argPtr1 arg2 arg3 arg4)
{-# LINE 181 "./Graphics/Rendering/Cairo/SVG.chs" #-}
                svg (castPtr bufferPtr) (fromIntegral count))
        when (count == 4096) loop
  loop
  checkStatus $ (\(SVG arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_close argPtr1 arg2) svg

svgParseFromString :: String -> SVG -> IO ()
svgParseFromString str svg = do
  let loop "" = return ()
      loop str =
        case splitAt 4096 str of
          (chunk, str') -> do
            withCStringLen chunk $ \(chunkPtr, len) ->
              checkStatus $ (\(SVG arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_write argPtr1 arg2 arg3 arg4)
{-# LINE 194 "./Graphics/Rendering/Cairo/SVG.chs" #-}
                svg (castPtr chunkPtr) (fromIntegral len)
            loop str'
  loop str
  checkStatus $ (\(SVG arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_close argPtr1 arg2) svg

-- actually render it

-- | render an SVG file
--
-- Returns @False@ if an error was detected.
-- On librsvg before 2.22.3, @svgRender@ always returns @True@.
svgRender :: SVG -> Render Bool
svgRender svg = do
  cr <- ask
  ret <- liftIO $ (\(SVG arg1) (Cairo arg2) -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_render_cairo argPtr1 arg2) svg cr



  return (ret /= 0)


-- | Get the width and height of the SVG image.
--
svgGetSize ::
    SVG
 -> (Int, Int) -- ^ @(width, height)@
svgGetSize svg = unsafePerformIO $
  allocaBytes 24 $ \dimentionsPtr -> do
  (\(SVG arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->rsvg_handle_get_dimensions argPtr1 arg2) svg dimentionsPtr
  width <- (\ptr -> do {peekByteOff ptr 0 ::IO CInt}) dimentionsPtr
  height <- (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) dimentionsPtr
  return (fromIntegral width, fromIntegral height)

---------------------
-- Convenience API
--

svgRenderFromFile :: FilePath -> Render Bool
svgRenderFromFile file = withSvgFromFile file svgRender

svgRenderFromHandle :: Handle -> Render Bool
svgRenderFromHandle hnd = withSvgFromHandle hnd svgRender

svgRenderFromString :: String -> Render Bool
svgRenderFromString str = withSvgFromString str svgRender

---------------------
-- Utils
--

checkStatus :: (Ptr (Ptr ()) -> IO CInt) -> IO ()
checkStatus action =
  checkGError (\ptr -> action ptr >> return ())
    (\(GError domain code msg) -> fail ("svg cairo error: " ++ msg))

foreign import ccall safe "g_type_init"
  g_type_init :: (IO ())

foreign import ccall unsafe "rsvg_handle_new"
  rsvg_handle_new :: (IO (Ptr SVG))

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

foreign import ccall unsafe "rsvg_handle_write"
  rsvg_handle_write :: ((Ptr SVG) -> ((Ptr CUChar) -> (CUInt -> ((Ptr (Ptr ())) -> (IO CInt)))))

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

foreign import ccall unsafe "rsvg_handle_render_cairo"
  rsvg_handle_render_cairo :: ((Ptr SVG) -> ((Ptr Cairo) -> (IO CInt)))

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