module Data.Text.Glyphize where

import Data.Text.Glyphize.Buffer
import Data.Text.Glyphize.Font

import Data.Word

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.C.String
import Control.Monad (forM)
import System.IO.Unsafe (unsafePerformIO)

foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer_ -> Ptr Feature -> Int -> IO ()

-- | Compute which glyphs from the provided font should be rendered where to
-- depict the given buffer of text.
shape :: Font -> Buffer -> [(GlyphInfo, GlyphPos)]
shape font buf = shapeWithFeatures font buf []

-- FIXME Certain input text can trigger a segfault. I'm not sure how to debug this.

data Feature = Feature {
    tag :: String,
    value :: Word32,
    start :: Word,
    end :: Word
}
instance Storable Feature where
    sizeOf _ = sizeOf (undefined :: Word32) * 2 + sizeOf (undefined :: Word) * 2
    alignment _ = alignment (undefined :: Word32)
    peek p = do
        let q = castPtr p
        tag' <- peek q
        val' <- peekElemOff q 1
        let r = castPtr $ plusPtr p (sizeOf (undefined :: Word32) * 2)
        start' <- peek r
        end' <- peekElemOff r 1
        return $ Feature (hb_tag_to_string tag') val' start' end'

    poke p (Feature tag' val' start' end') = do
        let q = castPtr p
        poke q $ hb_tag_from_string tag'
        pokeElemOff q 1 val'
        let r = castPtr $ plusPtr p (sizeOf (undefined :: Word32) * 2)
        poke r start'
        pokeElemOff r 1 end'

-- | Variant of `shape` specifying OpenType features to apply.
-- If two features have the same tag but overlapping ranges, the one with a
-- higher index takes precedance.
shapeWithFeatures :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
shapeWithFeatures font buf feats = unsafePerformIO $ do
    buf_ <- freeze' buf
    allocaBytes (sizeOf (undefined :: Feature) * length feats) $ \arr' -> do
        forM (zip [0..] feats) $ \(i, feat) -> pokeElemOff arr' i feat
        withForeignPtr font $ \font' -> withForeignPtr buf_ $ \buf' ->
            hb_shape font' buf' arr' $ length feats
    infos <- glyphInfos' buf_
    pos <- glyphsPos' buf_
    return $ zip infos pos

foreign import ccall "hb_version" hb_version :: Ptr Int -> Ptr Int -> Ptr Int -> IO ()
version :: (Int, Int, Int)
version = unsafePerformIO $
    alloca $ \a' -> alloca $ \b' -> alloca $ \c' -> do
        hb_version a' b' c'
        a <- peek a'
        b <- peek b'
        c <- peek c'
        return (a, b, c)
foreign import ccall "hb_version_atleast" versionAtLeast :: Int -> Int -> Int -> Bool
foreign import ccall "hb_version_string" hb_version_string :: CString
versionString :: String
versionString = unsafePerformIO $ peekCString hb_version_string