File: BaseSink.chs

package info (click to toggle)
haskell-gstreamer 0.12.1-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 720 kB
  • sloc: haskell: 635; ansic: 116; makefile: 11; sh: 7
file content (158 lines) | stat: -rw-r--r-- 5,654 bytes parent folder | download | duplicates (2)
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
{-# 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.Base.BaseSink (
  
  BaseSink,
  BaseSinkClass,
  castToBaseSink,
  gTypeBaseSink,
  
#if GST_CHECK_VERSION(0,10,12)
  baseSinkQueryLatency,
  baseSinkGetLatency,
#endif
#if GST_CHECK_VERSION(0,10,11)
  baseSinkWaitPreroll,
#endif
  baseSinkSetSync,
  baseSinkGetSync,
  baseSinkSetMaxLateness,
  baseSinkGetMaxLateness,
  baseSinkIsQOSEnabled,
  baseSinkSetQOSEnabled,
  baseSinkPrerollQueueLength,
  baseSinkGetPad
  
  ) where

import Control.Monad (liftM, liftM4)
{#import Media.Streaming.GStreamer.Base.Types#}
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.Attributes
{#import System.Glib.Properties#}

{# context lib = "gstreamer" prefix = "gst" #}

#if GST_CHECK_VERSION(0,10,12)
baseSinkQueryLatency :: BaseSinkClass baseSinkT
                     => baseSinkT
                     -> IO (Maybe (Bool, Bool, ClockTime, ClockTime))
baseSinkQueryLatency baseSink =
    alloca $ \livePtr -> alloca $ \upstreamLivePtr ->
        alloca $ \minLatencyPtr -> alloca $ \maxLatencyPtr ->
            do result <- {# call base_sink_query_latency #} (toBaseSink baseSink)
                                                            livePtr
                                                            upstreamLivePtr
                                                            minLatencyPtr
                                                            maxLatencyPtr
               if toBool result
                   then do live <- peek livePtr
                           upstreamLive <- peek upstreamLivePtr
                           minLatency <- peek minLatencyPtr
                           maxLatency <- peek maxLatencyPtr
                           return $ Just (toBool live,
                                          toBool upstreamLive,
                                          cToEnum minLatency,
                                          cToEnum maxLatency)
                   else return Nothing

baseSinkGetLatency :: BaseSinkClass baseSinkT
                   => baseSinkT
                   -> IO ClockTime
baseSinkGetLatency baseSink =
    liftM cToEnum $
        {# call base_sink_get_latency #} (toBaseSink baseSink)
#endif

#if GST_CHECK_VERSION(0,10,11)
baseSinkWaitPreroll :: BaseSinkClass baseSinkT
                    => baseSinkT
                    -> IO FlowReturn
baseSinkWaitPreroll baseSink =
    liftM cToEnum $
        {# call base_sink_wait_preroll #} (toBaseSink baseSink)
#endif

baseSinkSetSync :: BaseSinkClass baseSinkT
                => baseSinkT
                -> Bool
                -> IO ()
baseSinkSetSync baseSink sync =
    {# call base_sink_set_sync #} (toBaseSink baseSink) $ fromBool sync

baseSinkGetSync :: BaseSinkClass baseSinkT
                => baseSinkT
                -> IO Bool
baseSinkGetSync baseSink =
    liftM toBool $
        {# call base_sink_get_sync #} (toBaseSink baseSink)

baseSinkSetMaxLateness :: BaseSinkClass baseSinkT
                       => baseSinkT
                       -> Word64
                       -> IO ()
baseSinkSetMaxLateness baseSink maxLateness =
    {# call base_sink_set_max_lateness #} (toBaseSink baseSink) $ fromIntegral maxLateness

baseSinkGetMaxLateness :: BaseSinkClass baseSinkT
                       => baseSinkT
                       -> IO Word64
baseSinkGetMaxLateness baseSink =
    liftM fromIntegral $
        {# call base_sink_get_max_lateness #} (toBaseSink baseSink)

baseSinkIsQOSEnabled :: BaseSinkClass baseSinkT
                     => baseSinkT
                     -> IO Bool
baseSinkIsQOSEnabled baseSink =
    liftM toBool $
        {# call base_sink_is_qos_enabled #} (toBaseSink baseSink)

baseSinkSetQOSEnabled :: BaseSinkClass baseSinkT
                      => baseSinkT
                      -> Bool
                      -> IO ()
baseSinkSetQOSEnabled baseSink enabled =
    {# call base_sink_set_qos_enabled #} (toBaseSink baseSink) $ fromBool enabled

baseSinkPrerollQueueLength :: BaseSinkClass baseSinkT
                           => Attr baseSinkT Int
baseSinkPrerollQueueLength =
    newAttrFromUIntProperty "preroll-queue-len"

baseSinkGetPad :: BaseSinkClass baseSinkT
               => baseSinkT
               -> IO Pad
baseSinkGetPad baseSink =
    withObject (toBaseSink baseSink) cBaseSinkGetPad >>= peekObject
foreign import ccall unsafe "_hs_gst_base_sink_get_pad"
    cBaseSinkGetPad :: Ptr BaseSink
                    -> IO (Ptr Pad)