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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
-- -*-haskell-*-
-- GIMP Toolkit (GTK) StoreValue GenericValue
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (c) 1999..2002 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- TODO: this module is deprecated and should be removed. The GenericValue
-- type is currently exposed to users and it should not be.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module System.Glib.StoreValue (
TMType(..),
GenericValue(..),
valueSetGenericValue,
valueGetGenericValue,
) where
import Control.Monad (liftM)
import Data.Text (Text)
import Control.Exception (throw, AssertionFailed(..))
#include<glib-object.h>
import System.Glib.FFI
import System.Glib.GValue (GValue, valueInit, valueGetType)
import System.Glib.GValueTypes
import qualified System.Glib.GTypeConstants as GType
import System.Glib.Types (GObject)
-- | A union with information about the currently stored type.
--
-- * Internally used by "Graphics.UI.Gtk.TreeList.TreeModel".
--
data GenericValue = GVuint Word
| GVint Int
-- | GVuchar #{type guchar}
-- | GVchar #{type gchar}
| GVboolean Bool
| GVenum Int
| GVflags Int
-- | GVpointer (Ptr ())
| GVfloat Float
| GVdouble Double
| GVstring (Maybe Text)
| GVobject GObject
-- | GVboxed (Ptr ())
-- This is an enumeration of all GTypes that can be used in a TreeModel.
--
data TMType = TMinvalid
| TMuint
| TMint
-- | TMuchar
-- | TMchar
| TMboolean
| TMenum
| TMflags
-- | TMpointer
| TMfloat
| TMdouble
| TMstring
| TMobject
-- | TMboxed
instance Enum TMType where
fromEnum TMinvalid = #const G_TYPE_INVALID
fromEnum TMuint = #const G_TYPE_UINT
fromEnum TMint = #const G_TYPE_INT
-- fromEnum TMuchar = #const G_TYPE_UCHAR
-- fromEnum TMchar = #const G_TYPE_CHAR
fromEnum TMboolean = #const G_TYPE_BOOLEAN
fromEnum TMenum = #const G_TYPE_ENUM
fromEnum TMflags = #const G_TYPE_FLAGS
-- fromEnum TMpointer = #const G_TYPE_POINTER
fromEnum TMfloat = #const G_TYPE_FLOAT
fromEnum TMdouble = #const G_TYPE_DOUBLE
fromEnum TMstring = #const G_TYPE_STRING
fromEnum TMobject = #const G_TYPE_OBJECT
-- fromEnum TMboxed = #const G_TYPE_BOXED
toEnum #{const G_TYPE_INVALID} = TMinvalid
toEnum #{const G_TYPE_UINT} = TMuint
toEnum #{const G_TYPE_INT} = TMint
-- toEnum #{const G_TYPE_UCHAR} = TMuchar
-- toEnum #{const G_TYPE_CHAR} = TMchar
toEnum #{const G_TYPE_BOOLEAN} = TMboolean
toEnum #{const G_TYPE_ENUM} = TMenum
toEnum #{const G_TYPE_FLAGS} = TMflags
-- toEnum #{const G_TYPE_POINTER} = TMpointer
toEnum #{const G_TYPE_FLOAT} = TMfloat
toEnum #{const G_TYPE_DOUBLE} = TMdouble
toEnum #{const G_TYPE_STRING} = TMstring
toEnum #{const G_TYPE_OBJECT} = TMobject
-- toEnum #{const G_TYPE_BOXED} = TMboxed
toEnum _ =
error "StoreValue.toEnum(TMType): no dynamic types allowed."
valueSetGenericValue :: GValue -> GenericValue -> IO ()
valueSetGenericValue gvalue (GVuint x) = do valueInit gvalue GType.uint
valueSetUInt gvalue x
valueSetGenericValue gvalue (GVint x) = do valueInit gvalue GType.int
valueSetInt gvalue x
--valueSetGenericValue gvalue (GVuchar x) = valueSetUChar gvalue x
--valueSetGenericValue gvalue (GVchar x) = valueSetChar gvalue x
valueSetGenericValue gvalue (GVboolean x) = do valueInit gvalue GType.bool
valueSetBool gvalue x
valueSetGenericValue gvalue (GVenum x) = do valueInit gvalue GType.enum
valueSetUInt gvalue (fromIntegral x)
valueSetGenericValue gvalue (GVflags x) = do valueInit gvalue GType.flags
valueSetUInt gvalue (fromIntegral x)
--valueSetGenericValue gvalue (GVpointer x) = valueSetPointer gvalue x
valueSetGenericValue gvalue (GVfloat x) = do valueInit gvalue GType.float
valueSetFloat gvalue x
valueSetGenericValue gvalue (GVdouble x) = do valueInit gvalue GType.double
valueSetDouble gvalue x
valueSetGenericValue gvalue (GVstring x) = do valueInit gvalue GType.string
valueSetMaybeString gvalue x
valueSetGenericValue gvalue (GVobject x) = do valueInit gvalue GType.object
valueSetGObject gvalue x
--valueSetGenericValue gvalue (GVboxed x) = valueSetPointer gvalue x
valueGetGenericValue :: GValue -> IO GenericValue
valueGetGenericValue gvalue = do
gtype <- valueGetType gvalue
case (toEnum . fromIntegral) gtype of
TMinvalid -> throw $ AssertionFailed
"StoreValue.valueGetGenericValue: invalid or unavailable value."
TMuint -> liftM GVuint $ valueGetUInt gvalue
TMint -> liftM GVint $ valueGetInt gvalue
-- TMuchar -> liftM GVuchar $ valueGetUChar gvalue
-- TMchar -> liftM GVchar $ valueGetChar gvalue
TMboolean -> liftM GVboolean $ valueGetBool gvalue
TMenum -> liftM (GVenum . fromIntegral) $ valueGetUInt gvalue
TMflags -> liftM (GVflags . fromIntegral) $ valueGetUInt gvalue
-- TMpointer -> liftM GVpointer $ valueGetPointer gvalue
TMfloat -> liftM GVfloat $ valueGetFloat gvalue
TMdouble -> liftM GVdouble $ valueGetDouble gvalue
TMstring -> liftM GVstring $ valueGetMaybeString gvalue
TMobject -> liftM GVobject $ valueGetGObject gvalue
-- TMboxed -> liftM GVpointer $ valueGetPointer gvalue
|
