{-# LINE 2 "./Graphics/Rendering/Cairo/SVG.chs" #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LINE 3 "./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 Data.Monoid ((<>))
import qualified Data.Text as T (unpack)
import Foreign
import Foreign.C
import Control.Monad.Reader (ask, liftIO)
import System.IO (Handle, openFile, IOMode(ReadMode), hGetBuf)
-- Importing qualified to avoid double import with GHC < 7.8
import qualified System.IO.Unsafe as Unsafe

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 98 "./Graphics/Rendering/Cairo/SVG.chs" #-}

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

newtype SVG = SVG (ForeignPtr (SVG))
{-# LINE 104 "./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 140 "./Graphics/Rendering/Cairo/SVG.chs" #-}
             svgPtr <- rsvg_handle_new
{-# LINE 141 "./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 169 "./Graphics/Rendering/Cairo/SVG.chs" #-}
  wrapNewGObject mkSVG rsvg_handle_new
{-# LINE 170 "./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 186 "./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 199 "./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 = Unsafe.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 (T.unpack $ "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) -> (CULong -> ((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 ())))