{-# LANGUAGE DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-}
module Graphics.Text.Font.Choose.Value (Value(..), Value_, withValue, thawValue,
value'Size, ToValue(..)) where
import Linear.Matrix (M22)
import Linear.V2 (V2(..))
import Graphics.Text.Font.Choose.CharSet (CharSet, withCharSet, thawCharSet)
import FreeType.Core.Base (FT_Face(..))
import Graphics.Text.Font.Choose.LangSet (LangSet, withLangSet, thawLangSet)
import Graphics.Text.Font.Choose.Range (Range, withRange, thawRange)
import Control.Exception (throw)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Array (advancePtr)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.C.String (withCString, peekCString)
import GHC.Generics (Generic)
import Data.Hashable (Hashable)
import Graphics.Text.Font.Choose.Result (Word8, throwNull, Error(ErrTypeMismatch))
data Value = ValueVoid
| ValueInt Int
| ValueDouble Double
| ValueString String
| ValueBool Bool
| ValueMatrix (M22 Double)
| ValueCharSet CharSet
| ValueFTFace FT_Face
| ValueLangSet LangSet
| ValueRange Range deriving (Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, Eq Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
Ord, forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)
instance Hashable Value
class ToValue x where
toValue :: x -> Value
fromValue :: Value -> Maybe x
fromValue' :: Value -> x
fromValue' Value
self | Just x
ret <- forall x. ToValue x => Value -> Maybe x
fromValue Value
self = x
ret
fromValue' Value
_ = forall a e. Exception e => e -> a
throw Error
ErrTypeMismatch
instance ToValue () where
toValue :: () -> Value
toValue () = Value
ValueVoid
fromValue :: Value -> Maybe ()
fromValue Value
ValueVoid = forall a. a -> Maybe a
Just ()
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Int where
toValue :: Int -> Value
toValue = Int -> Value
ValueInt
fromValue :: Value -> Maybe Int
fromValue (ValueInt Int
x) = forall a. a -> Maybe a
Just Int
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Double where
toValue :: Double -> Value
toValue = Double -> Value
ValueDouble
fromValue :: Value -> Maybe Double
fromValue (ValueDouble Double
x) = forall a. a -> Maybe a
Just Double
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue String where
toValue :: String -> Value
toValue = String -> Value
ValueString
fromValue :: Value -> Maybe String
fromValue (ValueString String
x) = forall a. a -> Maybe a
Just String
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Bool where
toValue :: Bool -> Value
toValue = Bool -> Value
ValueBool
fromValue :: Value -> Maybe Bool
fromValue (ValueBool Bool
x) = forall a. a -> Maybe a
Just Bool
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue (M22 Double) where
toValue :: M22 Double -> Value
toValue = M22 Double -> Value
ValueMatrix
fromValue :: Value -> Maybe (M22 Double)
fromValue (ValueMatrix M22 Double
x) = forall a. a -> Maybe a
Just M22 Double
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue CharSet where
toValue :: CharSet -> Value
toValue = CharSet -> Value
ValueCharSet
fromValue :: Value -> Maybe CharSet
fromValue (ValueCharSet CharSet
x) = forall a. a -> Maybe a
Just CharSet
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue FT_Face where
toValue :: FT_Face -> Value
toValue = FT_Face -> Value
ValueFTFace
fromValue :: Value -> Maybe FT_Face
fromValue (ValueFTFace FT_Face
x) = forall a. a -> Maybe a
Just FT_Face
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue LangSet where
toValue :: LangSet -> Value
toValue = LangSet -> Value
ValueLangSet
fromValue :: Value -> Maybe LangSet
fromValue (ValueLangSet LangSet
x) = forall a. a -> Maybe a
Just LangSet
x
fromValue Value
_ = forall a. Maybe a
Nothing
instance ToValue Range where
toValue :: Range -> Value
toValue = Range -> Value
ValueRange
fromValue :: Value -> Maybe Range
fromValue (ValueRange Range
x) = forall a. a -> Maybe a
Just Range
x
fromValue Value
_ = forall a. Maybe a
Nothing
type Value_ = Ptr Int
foreign import ccall "size_value" value'Size :: Int
pokeUnion :: Ptr a -> a -> IO ()
pokeUnion Ptr a
ptr a
x = forall a b. Ptr a -> Ptr b
castPtr (Ptr a
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1) forall a. Storable a => Ptr a -> a -> IO ()
`poke` a
x
withValue :: Value -> (Value_ -> IO a) -> IO a
withValue :: forall a. Value -> (Value_ -> IO a) -> IO a
withValue Value
ValueVoid Value_ -> IO a
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
0
Value_ -> IO a
cb Value_
val'
withValue (ValueInt Int
x) Value_ -> IO a
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
1
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Value_
val' Int
1 Int
x
Value_ -> IO a
cb Value_
val'
withValue (ValueDouble Double
x) Value_ -> IO a
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
2
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Double
x
Value_ -> IO a
cb Value_
val'
withValue (ValueString String
str) Value_ -> IO a
cb =
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
str forall a b. (a -> b) -> a -> b
$ \Ptr CChar
str' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
3
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Ptr CChar
str'
Value_ -> IO a
cb Value_
val'
withValue (ValueBool Bool
b) Value_ -> IO a
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
4
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Bool
b
Value_ -> IO a
cb Value_
val'
withValue (ValueMatrix M22 Double
mat) Value_ -> IO a
cb =
forall {a} {b}. Storable a => V2 (V2 a) -> (Ptr a -> IO b) -> IO b
withMatrix M22 Double
mat forall a b. (a -> b) -> a -> b
$ \Ptr Double
mat' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
5
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Ptr Double
mat'
Value_ -> IO a
cb Value_
val'
withValue (ValueCharSet CharSet
charsets) Value_ -> IO a
cb =
forall a. CharSet -> (Ptr CharSet' -> IO a) -> IO a
withCharSet CharSet
charsets forall a b. (a -> b) -> a -> b
$ \Ptr CharSet'
charsets' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
6
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Ptr CharSet'
charsets'
Value_ -> IO a
cb Value_
val'
withValue (ValueFTFace FT_Face
x) Value_ -> IO a
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
7
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' FT_Face
x
Value_ -> IO a
cb Value_
val'
withValue (ValueLangSet LangSet
langset) Value_ -> IO a
cb =
forall a. LangSet -> (Ptr LangSet' -> IO a) -> IO a
withLangSet LangSet
langset forall a b. (a -> b) -> a -> b
$ \Ptr LangSet'
langset' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
8
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Ptr LangSet'
langset'
Value_ -> IO a
cb Value_
val'
withValue (ValueRange Range
range) Value_ -> IO a
cb =
forall a. Range -> (Ptr Range' -> IO a) -> IO a
withRange Range
range forall a b. (a -> b) -> a -> b
$ \Ptr Range'
range' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size forall a b. (a -> b) -> a -> b
$ \Value_
val' -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Value_
val' Int
9
forall {a} {a}. (Storable a, Storable a) => Ptr a -> a -> IO ()
pokeUnion Value_
val' Ptr Range'
range'
Value_ -> IO a
cb Value_
val'
foreign import ccall "size_matrix" mat22Size :: Int
withMatrix :: V2 (V2 a) -> (Ptr a -> IO b) -> IO b
withMatrix (V2 (V2 a
xx a
yx) (V2 a
xy a
yy)) Ptr a -> IO b
cb = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
mat22Size forall a b. (a -> b) -> a -> b
$ \Ptr a
mat' -> do
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
mat' Int
0 a
xx
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
mat' Int
1 a
xy
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
mat' Int
2 a
yx
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
mat' Int
3 a
yy
Ptr a -> IO b
cb Ptr a
mat'
thawValue :: Value_ -> IO (Maybe Value)
thawValue :: Value_ -> IO (Maybe Value)
thawValue Value_
ptr = do
Word8
kind <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Value_
ptr :: IO Word8
let val' :: Ptr b
val' = forall a b. Ptr a -> Ptr b
castPtr (Value_
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1)
case Word8
kind of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Value
ValueVoid
Word8
1 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Value
ValueInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
Word8
2 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Value
ValueDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
Word8
3 -> do
Ptr CChar
val <- forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Value
ValueString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO String
peekCString Ptr CChar
val
Word8
4 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Value
ValueBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
Word8
5 -> do
Ptr Double
mat' <- forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
Double
xx <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Double
mat' Int
0
Double
xy <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Double
mat' Int
1
Double
yx <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Double
mat' Int
2
Double
yy <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Double
mat' Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ M22 Double -> Value
ValueMatrix forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 Double
xx Double
xy) (forall a. a -> a -> V2 a
V2 Double
yx Double
yy)
Word8
6 -> do
Ptr CharSet'
val <- forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CharSet -> Value
ValueCharSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CharSet' -> IO CharSet
thawCharSet Ptr CharSet'
val
Word8
7 -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FT_Face -> Value
ValueFTFace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
Word8
8 -> do
Ptr LangSet'
val <- forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LangSet -> Value
ValueLangSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr LangSet' -> IO LangSet
thawLangSet Ptr LangSet'
val
Word8
9 -> do
Ptr Range'
val <- forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek forall {b}. Ptr b
val'
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range -> Value
ValueRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Range' -> IO Range
thawRange Ptr Range'
val
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing