{-# LINE 1 "Graphics/PDF/Haru.hsc" #-}

{-# LINE 2 "Graphics/PDF/Haru.hsc" #-}

module Graphics.PDF.Haru where

import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import System.IO.Unsafe

data HPDF_Doc
type Doc = Ptr HPDF_Doc
data HPDF_Page
type Page = Ptr HPDF_Page
data HPDF_FontDef
type FontDef = Ptr HPDF_FontDef

type BOOL = CInt
_HPDF_TRUE, _HPDF_FALSE :: BOOL
_HPDF_TRUE  = 1
_HPDF_FALSE = 0

withDoc :: String -> (Doc -> IO a) -> IO a
withDoc fn action = do
    fp  <- mkErrorHandlerCallback errorHandler
    doc <- newDoc fp nullPtr
    rv  <- action doc
    withCString fn $ saveToFile doc
    freeDoc doc
    return rv

withPage :: Doc -> (Page -> IO a) -> IO a
withPage doc action = do
    pg  <- addPage doc
    rv  <- action pg
    setWidth pg 595
    setHeight pg 842
    return rv

text :: Page -> X -> Y -> FontDef -> Size -> String -> IO ()
text pg x y font sz str = do
    setFontAndSize pg font sz
    beginText pg
    moveTextPos pg x y
    withCString str $ showText pg
    endText pg

type FontName = String
type X        = CFloat
type Y        = CFloat
type Size     = CFloat

loadFontEmbedded :: Doc -> String -> IO FontDef
loadFontEmbedded doc fn = withCString fn $ \cstr -> do
    name    <- loadTTFontFromFile doc cstr 1
    getFont doc name nullPtr

foreign import ccall "HPDF_New"
    newDoc :: FunPtr HPDF_Error_Handler -> Ptr () -> IO Doc

foreign import ccall "HPDF_AddPage"
    addPage :: Doc -> IO Page

foreign import ccall "HPDF_LoadTTFontFromFile"
    loadTTFontFromFile :: Doc -> CString -> BOOL -> IO CString

foreign import ccall "HPDF_GetFont"
    getFont :: Doc -> CString -> CString -> IO FontDef

foreign import ccall "HPDF_Page_BeginText"
    beginText :: Page -> IO ()

foreign import ccall "HPDF_Page_EndText"
    endText :: Page -> IO ()

foreign import ccall "HPDF_Free"
    freeDoc :: Doc -> IO ()

foreign import ccall "HPDF_SaveToFile"
    saveToFile :: Doc -> CString -> IO ()

foreign import ccall "HPDF_Page_ShowText"
    showText :: Page -> CString -> IO ()

foreign import ccall "HPDF_Page_SetFontAndSize"
    setFontAndSize :: Page -> FontDef -> CFloat -> IO ()

foreign import ccall "HPDF_Page_SetWidth"
    setWidth :: Page -> X -> IO ()

foreign import ccall "HPDF_Page_SetHeight"
    setHeight :: Page -> Y -> IO ()

foreign import ccall "HPDF_Page_MoveTextPos"
    moveTextPos :: Page -> X -> Y -> IO ()

type HPDF_Error_Handler = CULong -> CULong -> Ptr () -> IO ()
errorHandler :: HPDF_Error_Handler
errorHandler x y _ = print (x, y)

foreign import ccall "wrapper"  
    mkErrorHandlerCallback :: HPDF_Error_Handler -> IO (FunPtr HPDF_Error_Handler)