-- NOTE: Untested!
module Data.Text.Font.Choose where

import Linear.Matrix (M22)
import Graphics.Text.Font.Choose.CharSet (CharSet)
import FreeType.Core.Base (FT_Face(..))
import Graphics.Text.Font.Choose.LangSet (LangSet)
import Graphics.Text.Font.Choose.Range (Range)

import Foreign.Ptr (Ptr)

data Value = ValueVoid
    | ValueInt Int
    | ValueDouble Double
    | ValueString String
    | ValueMatrix (M22 Double)
    | ValueCharSet CharSet
    | ValueFTFace FT_Face
    | ValueLangSet LangSet
    | ValueRange Range deriving (Eq, Show, Ord, Generic)

instance GHashable Value

------
--- Low-level
------

type Value_ = Ptr Int

value'Size = sizeof (undefined :: Int) * 2
pokeUnion ptr x = castPtr (ptr `plusPtr` sizeof (undefined :: Int)) `poke` x

withValue :: Value -> (Value_ -> IO a) -> IO a
withValue ValueVoid cb = allocaBytes value'Size $ \val' -> do
    poke val' 0
    cb val'
withValue (ValueInt x) cb = allocaBytes value'Size $ \val' -> do
    poke val' 1
    pokeElemOff val' 1 x
    cb val'
withValue (ValueDouble x) cb = allocaBytes value'Size $ \val' -> do
    poke val' 2
    pokeUnion val' x
    cb val'
withValue (ValueString str) cb =
    withCString str $ \str' allocaBytes value'Size $ \val' -> do
        poke val' 3
        pokeUnion val' str'
        cb val'
withValue (ValueMatrix mat) cb =
    withMatrix mat $ \mat' -> allocaBytes value'Size $ \val' -> do
        poke val' 4
        pokeUnion val' mat'
        cb val'
withValue (ValueCharSet charsets) cb =
    withCharSets charsets $ \charsets' -> allocaBytes value'Size $ \val' -> do
        poke val' 5
        pokeUnion val' charsets'
        cb val'
withValue (ValueFTFace x) cb = allocaBytes value'Size $ \val' -> do
    poke val' 6
    pokeUnion val' x
    cb val'
withValue (ValueLangSet langset) cb =
    withLangSet langset $ \langset' -> allocaBytes value'Size $ \val' -> do
        poke val' 7
        pokeUnion val' langset'
        cb val'
withValue (ValueRange range) cb =
    withRange range $ \range' -> allocaBytes value'Size $ \val' -> do
        poke val' 8
        pokeUnion val' range'
        cb val'

mat22Size = sizeof (undefined :: Double) * 4
withMatrix (V2 (V2 xx yx) (V2 xy yy)) cb = allocaBytes mat22Size $ \mat' -> do
    pokeElemOff mat' 0 xx
    pokeElemOff mat' 1 xy
    pokeElemOff mat' 2 yx
    pokeElemOff mat' 3 yy
    cb mat'

thawValue :: Value_ -> IO (Maybe Value)
thawValue ptr = do
    kind <- peek ptr
    let val' = castPtr (ptr `plusPtr` sizeof (undefined :: Int))
    case kind of
        0 -> return ValueVoid
        1 -> Just <$> ValueInt <$> peek val'
        2 -> Just <$> ValueDouble <$> peek val'
        3 -> Just <$> ValueString <$> peekCString val'
        4 -> do
            mat' <- peek val'
            xx <- peekElemOff mat' 0
            xy <- peekElemOff mat' 1
            yx <- peekElemOff mat' 2
            yy <- peekElemOff mat' 3
            return $ Just $ ValueMatrix $ V2 (V2 xx yx) (V2 xy yy)
        5 -> Just <$> ValueCharSet <$> thawCharSet val'
        6 -> return $ Just $ ValueFTFace $ val'
        7 -> Just <$> ValueLangSet <$> thawLangSet val'
        8 -> Just <$> ValueRange <$> thawRange val'
        _ -> return Nothing