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 Control.Concurrent.QSem
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
    waitQSem shapingSem
    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_
    signalQSem shapingSem
    return $ zip infos pos

-- | Used to avoid segfaults...
{-# NOINLINE shapingSem #-}
shapingSem = unsafePerformIO $ newQSem 25

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