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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
|
{-# LANGUAGE CPP #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
-- Author : Peter Gavin
-- Created: 1-Apr-2007
--
-- Copyright (c) 2007 Peter Gavin
--
-- 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 3 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.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.
--
-- GStreamer, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GStreamer documentation.
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
module Media.Streaming.GStreamer.Core.Message (
Message,
MessageClass,
castToMessage,
gTypeMessage,
MessageType(..),
messageTypeGetName,
messageTypeToQuark,
messageSrc,
messageTimestamp,
messageType,
messageTypeName,
messageStructure,
messageNewApplication,
messageNewClockProvide,
messageNewClockLost,
messageNewCustom,
messageNewElement,
messageNewEOS,
messageNewError,
#if GST_CHECK_VERSION(0,10,12)
messageNewInfo,
#endif
messageNewNewClock,
messageNewSegmentDone,
messageNewSegmentStart,
messageNewStateChanged,
messageNewTag,
#if GST_CHECK_VERSION(0,10,11)
messageNewBuffering,
#endif
messageNewWarning,
messageNewDuration,
messageNewStateDirty,
#if GST_CHECK_VERSION(0,10,12)
messageNewLatency,
#endif
messageParseClockLost,
messageParseClockProvide,
messageParseError,
#if GST_CHECK_VERSION(0,10,12)
messageParseInfo,
#endif
messageParseNewClock,
messageParseSegmentDone,
messageParseSegmentStart,
messageParseStateChanged,
messageParseTag,
#if GST_CHECK_VERSION(0,10,11)
messageParseBuffering,
#endif
messageParseWarning,
messageParseDuration,
) where
import Control.Monad (liftM)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.GObject
import System.Glib.UTFString
import System.Glib.GError
{# context lib = "gstreamer" prefix = "gst" #}
messageTypeGetName :: MessageType
-> String
messageTypeGetName messageType =
unsafePerformIO $
{# call message_type_get_name #} (fromIntegral $ fromEnum messageType) >>=
peekUTFString
messageTypeToQuark :: MessageType
-> Quark
messageTypeToQuark messageType =
{# call fun message_type_to_quark #} (fromIntegral $ fromEnum messageType)
messageSrc :: Message
-> Object
messageSrc message =
unsafePerformIO $ withMiniObject message {# get GstMessage->src #} >>=
peekObject
messageTimestamp :: Message
-> ClockTime
messageTimestamp message =
fromIntegral $ unsafePerformIO $ withMiniObject message {# get GstMessage->timestamp #}
messageType :: Message
-> MessageType
messageType message =
toEnum $ fromIntegral $ unsafePerformIO $
withMiniObject message cMessageGetMessageType
foreign import ccall unsafe "_hs_gst_message_get_message_type"
cMessageGetMessageType :: Ptr Message
-> IO {# type GstMessageType #}
messageTypeName :: Message
-> String
messageTypeName =
messageTypeGetName . messageType
messageStructure :: Message
-> Structure
messageStructure message =
unsafePerformIO $
{# call message_get_structure #} message >>=
peekStructure
messageNewApplication :: ObjectClass objectT
=> objectT
-> Structure
-> Message
messageNewApplication src structure =
unsafePerformIO $
giveStructure structure
({# call message_new_application #} (toObject src)) >>=
takeMiniObject
messageNewClockProvide :: (ObjectClass objectT, ClockClass clockT)
=> objectT
-> clockT
-> Bool
-> Message
messageNewClockProvide src clock ready =
unsafePerformIO $
{# call message_new_clock_provide #} (toObject src)
(toClock clock)
(fromBool ready) >>=
takeMiniObject
messageNewClockLost :: (ObjectClass objectT, ClockClass clockT)
=> objectT
-> clockT
-> Message
messageNewClockLost src clock =
unsafePerformIO $
{# call message_new_clock_lost #} (toObject src)
(toClock clock) >>=
takeMiniObject
messageNewCustom :: ObjectClass objectT
=> MessageType
-> objectT
-> Maybe Structure
-> Message
messageNewCustom messageType src structure =
unsafePerformIO $
(case structure of
Just structure' ->
giveStructure structure' messageNewCustom'
Nothing ->
messageNewCustom' $ Structure nullForeignPtr) >>=
takeMiniObject
where
messageNewCustom' =
{# call message_new_custom #} (cFromEnum messageType)
(toObject src)
messageNewElement :: ObjectClass objectT
=> objectT
-> Maybe Structure
-> Message
messageNewElement src structure =
unsafePerformIO $
(case structure of
Just structure' ->
giveStructure structure' messageNewElement'
Nothing ->
messageNewElement' $ Structure nullForeignPtr) >>=
takeMiniObject
where
messageNewElement' =
{# call message_new_element #} (toObject src)
messageNewEOS :: ObjectClass objectT
=> objectT
-> Message
messageNewEOS src =
unsafePerformIO $
{# call message_new_eos #} (toObject src) >>=
takeMiniObject
messageNewError :: ObjectClass objectT
=> objectT
-> GError
-> String
-> Message
messageNewError src error debug =
unsafePerformIO $
with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
{# call message_new_error #} (toObject src)
(castPtr gErrorPtr)
debugPtr >>=
takeMiniObject
#if GST_CHECK_VERSION(0,10,12)
messageNewInfo :: ObjectClass objectT
=> objectT
-> GError
-> String
-> Message
messageNewInfo src error debug =
unsafePerformIO $
with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
{# call message_new_info #} (toObject src)
(castPtr gErrorPtr)
debugPtr >>=
takeMiniObject
#endif
messageNewNewClock :: (ObjectClass objectT, ClockClass clockT)
=> objectT
-> clockT
-> Message
messageNewNewClock src clock =
unsafePerformIO $
{# call message_new_new_clock #} (toObject src)
(toClock clock) >>=
takeMiniObject
messageNewSegmentDone :: ObjectClass objectT
=> objectT
-> Format
-> Int64
-> Message
messageNewSegmentDone src format position =
unsafePerformIO $
{# call message_new_segment_done #} (toObject src)
(fromIntegral $ fromFormat format)
(fromIntegral position) >>=
takeMiniObject
messageNewSegmentStart :: ObjectClass objectT
=> objectT
-> Format
-> Int64
-> Message
messageNewSegmentStart src format position =
unsafePerformIO $
{# call message_new_segment_start #} (toObject src)
(fromIntegral $ fromFormat format)
(fromIntegral position) >>=
takeMiniObject
messageNewStateChanged :: ObjectClass objectT
=> objectT
-> State
-> State
-> State
-> Message
messageNewStateChanged src oldState newState pending =
unsafePerformIO $
{# call message_new_state_changed #} (toObject src)
(cFromEnum oldState)
(cFromEnum newState)
(cFromEnum pending) >>=
takeMiniObject
messageNewTag :: ObjectClass objectT
=> objectT
-> TagList
-> Message
messageNewTag src tagList =
unsafePerformIO $ withTagList tagList $ \tagListPtr ->
{# call message_new_tag #} (toObject src)
(castPtr tagListPtr) >>=
takeMiniObject
#if GST_CHECK_VERSION(0,10,11)
messageNewBuffering :: ObjectClass objectT
=> objectT
-> Int
-> Message
messageNewBuffering src percent =
unsafePerformIO $
{# call message_new_buffering #} (toObject src)
(fromIntegral percent) >>=
takeMiniObject
#endif
messageNewWarning :: ObjectClass objectT
=> objectT
-> GError
-> String
-> Message
messageNewWarning src error debug =
unsafePerformIO $
with error $ \gErrorPtr -> withUTFString debug $ \debugPtr ->
{# call message_new_warning #} (toObject src)
(castPtr gErrorPtr)
debugPtr >>=
takeMiniObject
messageNewDuration :: ObjectClass objectT
=> objectT
-> Format
-> Int64
-> Message
messageNewDuration src format duration =
unsafePerformIO $
{# call message_new_duration #} (toObject src)
(fromIntegral $ fromFormat format)
(fromIntegral duration) >>=
takeMiniObject
messageNewStateDirty :: ObjectClass objectT
=> objectT
-> Message
messageNewStateDirty src =
unsafePerformIO $
{# call message_new_state_dirty #} (toObject src) >>=
takeMiniObject
#if GST_CHECK_VERSION(0,10,12)
messageNewLatency :: ObjectClass objectT
=> objectT
-> Message
messageNewLatency src =
unsafePerformIO $
{# call message_new_latency #} (toObject src) >>=
takeMiniObject
#endif
messageParseClockLost :: Message
-> Maybe Clock
messageParseClockLost message | messageType message == MessageClockLost =
Just $ unsafePerformIO $ alloca $ \clockPtr ->
do {# call message_parse_clock_lost #} message $ castPtr clockPtr
peek clockPtr >>= peekObject
| otherwise = Nothing
messageParseClockProvide :: Message
-> Maybe (Clock, Bool)
messageParseClockProvide message | messageType message == MessageClockProvide =
Just $ unsafePerformIO $ alloca $ \clockPtr ->
alloca $ \readyPtr ->
do {# call message_parse_clock_provide #} message (castPtr clockPtr) readyPtr
clock <- peek clockPtr >>= peekObject
ready <- liftM toBool $ peek readyPtr
return (clock, ready)
| otherwise = Nothing
messageParseError :: Message
-> Maybe (GError, String)
messageParseError message | messageType message == MessageError =
Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
alloca $ \debugPtr ->
do {# call message_parse_error #} message (castPtr gErrorPtr) debugPtr
gError <- do ptr <- peek gErrorPtr
gError <- peek ptr
{# call g_error_free #} $ castPtr ptr
return gError
debug <- peek debugPtr >>= readUTFString
return (gError, debug)
| otherwise = Nothing
#if GST_CHECK_VERSION(0,10,12)
messageParseInfo :: Message
-> Maybe (GError, String)
messageParseInfo message | messageType message == MessageInfo =
Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
alloca $ \debugPtr ->
do {# call message_parse_info #} message (castPtr gErrorPtr) debugPtr
gError <- do ptr <- peek gErrorPtr
gError <- peek ptr
{# call g_error_free #} $ castPtr ptr
return gError
debug <- peek debugPtr >>= readUTFString
return (gError, debug)
| otherwise = Nothing
#endif
messageParseNewClock :: Message
-> Maybe Clock
messageParseNewClock message | messageType message == MessageNewClock =
Just $ unsafePerformIO $ alloca $ \clockPtr ->
do {# call message_parse_clock_lost #} message $ castPtr clockPtr
peek clockPtr >>= peekObject
| otherwise = Nothing
messageParseSegmentDone :: Message
-> Maybe (Format, Int64)
messageParseSegmentDone message | messageType message == MessageSegmentDone =
Just $ unsafePerformIO $ alloca $ \formatPtr ->
alloca $ \positionPtr ->
do {# call message_parse_segment_done #} message formatPtr positionPtr
format <- liftM (toFormat . fromIntegral) $ peek formatPtr
position <- liftM fromIntegral $ peek positionPtr
return (format, position)
| otherwise = Nothing
messageParseSegmentStart :: Message
-> Maybe (Format, Int64)
messageParseSegmentStart message | messageType message == MessageSegmentStart =
Just $ unsafePerformIO $ alloca $ \formatPtr ->
alloca $ \positionPtr ->
do {# call message_parse_segment_start #} message formatPtr positionPtr
format <- liftM (toFormat . fromIntegral) $ peek formatPtr
position <- liftM fromIntegral $ peek positionPtr
return (format, position)
| otherwise = Nothing
messageParseStateChanged :: Message
-> Maybe (State, State, State)
messageParseStateChanged message | messageType message == MessageStateChanged =
Just $ unsafePerformIO $ alloca $ \oldStatePtr ->
alloca $ \newStatePtr -> alloca $ \pendingPtr ->
do {# call message_parse_state_changed #} message oldStatePtr newStatePtr pendingPtr
oldState <- liftM cToEnum $ peek oldStatePtr
newState <- liftM cToEnum $ peek newStatePtr
pending <- liftM cToEnum $ peek pendingPtr
return (oldState, newState, pending)
| otherwise = Nothing
messageParseTag :: Message
-> Maybe TagList
messageParseTag message | messageType message == MessageTag =
Just $ unsafePerformIO $ alloca $ \tagListPtr ->
do {# call message_parse_tag #} message $ castPtr tagListPtr
peek tagListPtr >>= takeTagList
| otherwise = Nothing
#if GST_CHECK_VERSION(0,10,11)
messageParseBuffering :: Message
-> Maybe Int
messageParseBuffering message | messageType message == MessageBuffering =
Just $ fromIntegral $ unsafePerformIO $ alloca $ \percentPtr ->
do {# call message_parse_buffering #} message percentPtr
peek percentPtr
| otherwise = Nothing
#endif
messageParseWarning :: Message
-> Maybe (Maybe GError, Maybe String)
messageParseWarning message | messageType message == MessageWarning =
Just $ unsafePerformIO $ alloca $ \gErrorPtr ->
alloca $ \debugPtr ->
do {# call message_parse_warning #} message (castPtr gErrorPtr) debugPtr
gError <- peek gErrorPtr >>=
(maybePeek $ \ptr ->
do gError <- peek ptr
{# call g_error_free #} $ castPtr ptr
return gError)
debug <- peek debugPtr >>= maybePeek readUTFString
return (gError, debug)
| otherwise = Nothing
messageParseDuration :: Message
-> Maybe (Format, Int64)
messageParseDuration message | messageType message == MessageDuration =
Just $ unsafePerformIO $ alloca $ \formatPtr ->
alloca $ \positionPtr ->
do {# call message_parse_duration #} message formatPtr positionPtr
format <- liftM (toFormat . fromIntegral) $ peek formatPtr
position <- liftM fromIntegral $ peek positionPtr
return (format, position)
| otherwise = Nothing
|
