1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
-- 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