diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,504 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs new file mode 100644 --- /dev/null +++ b/Gtk2HsSetup.hs @@ -0,0 +1,486 @@ +{-# LANGUAGE CPP #-} + +#define CABAL_VERSION_ENCODE(major, minor, micro) ( \ + ((major) * 10000) \ + + ((minor) * 100) \ + + ((micro) * 1)) + +#define CABAL_VERSION_CHECK(major,minor,micro) \ + (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro)) + +-- now, this is bad, but Cabal doesn't seem to actually pass any information about +-- its version to CPP, so guess the version depending on the version of GHC +#ifdef CABAL_VERSION_MINOR +#ifndef CABAL_VERSION_MAJOR +#define CABAL_VERSION_MAJOR 1 +#endif +#ifndef CABAL_VERSION_MICRO +#define CABAL_VERSION_MICRO 0 +#endif +#define CABAL_VERSION CABAL_VERSION_ENCODE( \ + CABAL_VERSION_MAJOR, \ + CABAL_VERSION_MINOR, \ + CABAL_VERSION_MICRO) +#else +#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command) +#if (__GLASGOW_HASKELL__ >= 612) +#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0) +#else +#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0) +#endif +#endif + +-- | Build a Gtk2hs package. +-- +module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages ) where + +import Distribution.Simple +import Distribution.Simple.PreProcess +import Distribution.InstalledPackageInfo ( importDirs, + showInstalledPackageInfo, + libraryDirs, + extraLibraries, + extraGHCiLibraries ) +import Distribution.Simple.PackageIndex ( +#if CABAL_VERSION_CHECK(1,8,0) + lookupInstalledPackageId +#else + lookupPackageId +#endif + ) +import Distribution.PackageDescription as PD ( PackageDescription(..), + updatePackageDescription, + BuildInfo(..), + emptyBuildInfo, allBuildInfo, + Library(..), + libModules, hasLibs) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), + InstallDirs(..), +#if CABAL_VERSION_CHECK(1,8,0) + componentPackageDeps, +#else + packageDeps, +#endif + absoluteInstallDirs) +import Distribution.Simple.Compiler ( Compiler(..) ) +import Distribution.Simple.Program ( + Program(..), ConfiguredProgram(..), + rawSystemProgramConf, rawSystemProgramStdoutConf, + c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram, + simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) +import Distribution.ModuleName ( ModuleName, components, toFilePath ) +import Distribution.Simple.Utils +import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..), + defaultCopyFlags, ConfigFlags(configVerbosity), + fromFlag, toFlag, RegisterFlags(..), flagToMaybe, + fromFlagOrDefault, defaultRegisterFlags) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Install ( install ) +#if CABAL_VERSION_CHECK(1,8,0) +import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) +#else +import qualified Distribution.Simple.Register as Register ( register ) +#endif +import Distribution.Text ( simpleParse, display ) +import System.FilePath +import System.Directory ( doesFileExist ) +import Distribution.Version (Version(..)) +import Distribution.Verbosity +import Control.Monad (when, unless, filterM) +import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) +import Data.List (isPrefixOf, isSuffixOf, nub) +import Data.Char (isAlpha) +import qualified Data.Map as M +import qualified Data.Set as S + +import Control.Applicative ((<$>)) +import System.Directory (getDirectoryContents, doesDirectoryExist) + +-- the name of the c2hs pre-compiled header file +precompFile = "precompchs.bin" + +gtk2hsUserHooks = simpleUserHooks { + hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], + hookedPreProcessors = [("chs", ourC2hs)], + confHook = \pd cf -> + confHook simpleUserHooks pd cf >>= return . adjustLocalBuildInfo, + postConf = \args cf pd lbi -> do + genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi + postConf simpleUserHooks args cf pd lbi, + buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> + (buildHook simpleUserHooks) pd lbi uh bf, + copyHook = \pd lbi uh flags -> (copyHook simpleUserHooks) pd lbi uh flags >> + installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), + instHook = \pd lbi uh flags -> +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + installHook pd lbi uh flags >> + installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest, + regHook = registerHook +#else + instHook simpleUserHooks pd lbi uh flags >> + installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest +#endif + } + +------------------------------------------------------------------------------ +-- Lots of stuff for windows ghci support +------------------------------------------------------------------------------ + +getDlls :: [FilePath] -> IO [FilePath] +getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$> + mapM getDirectoryContents dirs + +fixLibs :: [FilePath] -> [String] -> [String] +fixLibs dlls = concatMap $ \ lib -> + case filter (("lib" ++ lib) `isPrefixOf`) dlls of + dll:_ -> [dropExtension dll] + _ -> if lib == "z" then [] else [lib] + +-- The following code is a big copy-and-paste job from the sources of +-- Cabal 1.8 just to be able to fix a field in the package file. Yuck. + +#if CABAL_VERSION_CHECK(1,8,0) + +installHook :: PackageDescription -> LocalBuildInfo + -> UserHooks -> InstallFlags -> IO () +installHook pkg_descr localbuildinfo _ flags = do + let copyFlags = defaultCopyFlags { + copyDistPref = installDistPref flags, + copyDest = toFlag NoCopyDest, + copyVerbosity = installVerbosity flags + } + install pkg_descr localbuildinfo copyFlags + let registerFlags = defaultRegisterFlags { + regDistPref = installDistPref flags, + regInPlace = installInPlace flags, + regPackageDB = installPackageDB flags, + regVerbosity = installVerbosity flags + } + when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags + +registerHook :: PackageDescription -> LocalBuildInfo + -> UserHooks -> RegisterFlags -> IO () +registerHook pkg_descr localbuildinfo _ flags = + if hasLibs pkg_descr + then register pkg_descr localbuildinfo flags + else setupMessage verbosity + "Package contains no library to register:" (packageId pkg_descr) + where verbosity = fromFlag (regVerbosity flags) + +register :: PackageDescription -> LocalBuildInfo + -> RegisterFlags -- ^Install in the user's database?; verbose + -> IO () +register pkg@PackageDescription { library = Just lib } + lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags + = do + + installedPkgInfoRaw <- generateRegistrationInfo + verbosity pkg lib lbi clbi inplace distPref + + dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls + let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw) + installedPkgInfo = installedPkgInfoRaw { + extraGHCiLibraries = libs } + + -- Three different modes: + case () of + _ | modeGenerateRegFile -> die "Generate Reg File not supported" + | modeGenerateRegScript -> die "Generate Reg Script not supported" + | otherwise -> registerPackage verbosity + installedPkgInfo pkg lbi inplace packageDb + + where + modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) + modeGenerateRegScript = fromFlag (regGenScript regFlags) + inplace = fromFlag (regInPlace regFlags) + packageDb = case flagToMaybe (regPackageDB regFlags) of + Just db -> db + Nothing -> registrationPackageDB (withPackageDB lbi) + distPref = fromFlag (regDistPref regFlags) + verbosity = fromFlag (regVerbosity regFlags) + +register _ _ regFlags = notice verbosity "No package to register" + where + verbosity = fromFlag (regVerbosity regFlags) + +#else +installHook :: PackageDescription -> LocalBuildInfo + -> UserHooks -> InstallFlags -> IO () +installHook pkg_descr localbuildinfo _ flags = do + let copyFlags = defaultCopyFlags { + copyDistPref = installDistPref flags, + copyInPlace = installInPlace flags, + copyUseWrapper = installUseWrapper flags, + copyDest = toFlag NoCopyDest, + copyVerbosity = installVerbosity flags + } + install pkg_descr localbuildinfo copyFlags + let registerFlags = defaultRegisterFlags { + regDistPref = installDistPref flags, + regInPlace = installInPlace flags, + regPackageDB = installPackageDB flags, + regVerbosity = installVerbosity flags + } + when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags + +registerHook :: PackageDescription -> LocalBuildInfo + -> UserHooks -> RegisterFlags -> IO () +registerHook pkg_descr localbuildinfo _ flags = + if hasLibs pkg_descr + then register pkg_descr localbuildinfo flags + else setupMessage verbosity + "Package contains no library to register:" (packageId pkg_descr) + where verbosity = fromFlag (regVerbosity flags) + +register :: PackageDescription -> LocalBuildInfo + -> RegisterFlags -- ^Install in the user's database?; verbose + -> IO () +register pkg_descr lbi regFlags = do + let verbosity = fromFlag (regVerbosity regFlags) + warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)." + Register.register pkg_descr lbi regFlags + +#endif + +------------------------------------------------------------------------------ +-- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later +------------------------------------------------------------------------------ + +adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo +adjustLocalBuildInfo lbi = + let extra = (Just libBi, []) + libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi + , buildDir lbi ] } + in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) } + +------------------------------------------------------------------------------ +-- Processing .chs files with our local c2hs. +------------------------------------------------------------------------------ + +ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor +ourC2hs bi lbi = PreProcessor { + platformIndependent = False, + runPreProcessor = runC2HS bi lbi +} + +runC2HS :: BuildInfo -> LocalBuildInfo -> + (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () +runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do + -- have the header file name if we don't have the precompiled header yet + header <- case lookup "x-c2hs-header" (customFieldsBI bi) of + Just h -> return h + Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++ + "that sets the C header file to process .chs.pp files.") + + -- c2hs will output files in out dir, removing any leading path of the input file. + -- Thus, append the dir of the input file to the output dir. + let (outFileDir, newOutFile) = splitFileName outFile + let newOutDir = outDir outFileDir + -- additional .chi files might be needed that other packages have installed; + -- we assume that these are installed in the same place as .hi files + let chiDirs = [ dir | +#if CABAL_VERSION_CHECK(1,8,0) + ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi), + dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ] +#else + ipi <- packageDeps lbi, + dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ] +#endif + rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $ + map ("--include=" ++) (outDir:chiDirs) + ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi] + ++ ["--output-dir=" ++ newOutDir, + "--output=" ++ newOutFile, + "--precomp=" ++ buildDir lbi precompFile, + header, inDir inFile] + +getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] +getCppOptions bi lbi + = nub $ + ["-I" ++ dir | dir <- PD.includeDirs bi] + ++ [opt | opt@('-':c:_) <- (PD.cppOptions bi ++ PD.ccOptions bi), c `elem` "DIU"] + +installCHI :: PackageDescription -- ^information from the .cabal file + -> LocalBuildInfo -- ^information from the configure step + -> Verbosity -> CopyDest -- ^flags sent to copy or install + -> IO () +installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do + let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest + -- cannot use the recommended 'findModuleFiles' since it fails if there exists + -- a modules that does not have a .chi file + mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi]) + (map toFilePath +#if CABAL_VERSION_CHECK(1,8,0) + (PD.libModules lib) +#else + (PD.libModules pkg) +#endif + ) + let files = [ f | Just f <- mFiles ] +#if CABAL_VERSION_CHECK(1,8,0) + installOrdinaryFiles verbosity libPref files +#else + copyFiles verbosity libPref files +#endif + + +installCHI _ _ _ _ = return () + +------------------------------------------------------------------------------ +-- Generating the type hierarchy and signal callback .hs files. +------------------------------------------------------------------------------ + +typeGenProgram :: Program +typeGenProgram = (simpleProgram "gtk2hsTypeGen") + +signalGenProgram :: Program +signalGenProgram = (simpleProgram "gtk2hsHookGenerator") + +c2hsLocal :: Program +c2hsLocal = (simpleProgram "gtk2hsC2hs") + +genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +genSynthezisedFiles verb pd lbi = do + + cPkgs <- getPkgConfigPackages verb lbi pd + + let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) + ++customFieldsPD pd + typeOpts :: String -> [ProgArg] + typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content) + | (field,content) <- xList, + tag `isPrefixOf` field, + field /= (tag++"file")] + ++ [ "--tag=" ++ tag + | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs + , let name' = filter isAlpha (display name) + , tag <- name' + : [ name' ++ "-" ++ show major ++ "." ++ show digit + | digit <- [0,2..minor] ] + ] + + signalsOpts :: [ProgArg] + signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content) + | (field,content) <- xList, + "x-signals-" `isPrefixOf` field, + field /= "x-signals-file"] + + genFile :: Program -> [ProgArg] -> FilePath -> IO () + genFile prog args outFile = do + res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args + rewriteFile outFile res + + (flip mapM_) (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ + \(fileTag, f) -> do + let tag = reverse (drop 4 (reverse fileTag)) + info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") + genFile typeGenProgram (typeOpts tag) f + + case lookup "x-signals-file" xList of + Nothing -> return () + Just f -> do + info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") + genFile signalGenProgram signalsOpts f + +--FIXME: Cabal should tell us the selected pkg-config package versions in the +-- LocalBuildInfo or equivalent. +-- In the mean time, ask pkg-config again. + +getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId] +getPkgConfigPackages verbosity lbi pkg = + sequence + [ do version <- pkgconfig ["--modversion", display pkgname] + case simpleParse version of + Nothing -> die $ "parsing output of pkg-config --modversion failed" + Just v -> return (PackageIdentifier pkgname v) + | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ] + where + pkgconfig = rawSystemProgramStdoutConf verbosity + pkgConfigProgram (withPrograms lbi) + +------------------------------------------------------------------------------ +-- Dependency calculation amongst .chs files. +------------------------------------------------------------------------------ + +-- Given all files of the package, find those that end in .chs and extract the +-- .chs files they depend upon. Then return the PackageDescription with these +-- files rearranged so that they are built in a sequence that files that are +-- needed by other files are built first. +fixDeps :: PackageDescription -> IO PackageDescription +fixDeps pd@PD.PackageDescription { + PD.library = Just lib@PD.Library { + PD.exposedModules = expMods, + PD.libBuildInfo = bi@PD.BuildInfo { + PD.hsSourceDirs = srcDirs, + PD.otherModules = othMods + }}} = do + let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs + (joinPath (components m)) + mExpFiles <- mapM findModule expMods + mOthFiles <- mapM findModule othMods + + -- tag all exposed files with True so we throw an error if we need to build + -- an exposed module before an internal modules (we cannot express this) + let modDeps = zipWith (ModDep True []) expMods mExpFiles++ + zipWith (ModDep False []) othMods mOthFiles + modDeps <- mapM extractDeps modDeps + let (expMods, othMods) = span mdExposed $ sortTopological modDeps + badOther = map (fromMaybe "" . mdLocation) $ + filter (not . mdExposed) expMods + unless (null badOther) $ + die ("internal chs modules "++intercalate "," badOther++ + " depend on exposed chs modules; cabal needs to build internal modules first") + return pd { PD.library = Just lib { + PD.exposedModules = map mdOriginal expMods, + PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods } + }} + +data ModDep = ModDep { + mdExposed :: Bool, + mdRequires :: [ModuleName], + mdOriginal :: ModuleName, + mdLocation :: Maybe FilePath +} + +instance Show ModDep where + show x = show (mdLocation x) + +instance Eq ModDep where + ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2 +instance Ord ModDep where + compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2 + +-- Extract the dependencies of this file. This is intentionally rather naive as it +-- ignores CPP conditionals. We just require everything which means that the +-- existance of a .chs module may not depend on some CPP condition. +extractDeps :: ModDep -> IO ModDep +extractDeps md@ModDep { mdLocation = Nothing } = return md +extractDeps md@ModDep { mdLocation = Just f } = withFileContents f $ \con -> do + let findImports acc (('{':'#':xs):xxs) = case (dropWhile ((==) ' ') xs) of + ('i':'m':'p':'o':'r':'t':' ':ys) -> + case simpleParse (takeWhile ((/=) '#') ys) of + Just m -> findImports (m:acc) xxs + Nothing -> die ("cannot parse chs import in "++f++":\n"++ + "offending line is {#"++xs) + -- no more imports after the first non-import hook + _ -> return acc + findImports acc (_:xxs) = findImports acc xxs + findImports acc [] = return acc + mods <- findImports [] (lines con) + return md { mdRequires = mods } + +-- Find a total order of the set of modules that are partially sorted by their +-- dependencies on each other. The function returns the sorted list of modules +-- together with a list of modules that are required but not supplied by this +-- in the input set of modules. +sortTopological :: [ModDep] -> [ModDep] +sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms) + where + set = M.fromList (map (\m -> (mdOriginal m, m)) ms) + visit (out,visited) m + | m `S.member` visited = (out,visited) + | otherwise = case m `M.lookup` set of + Nothing -> (out, m `S.insert` visited) + Just md -> (md:out', visited') + where + (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) diff --git a/Media/Streaming/GStreamer.hs b/Media/Streaming/GStreamer.hs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer.hs @@ -0,0 +1,37 @@ +-- 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 +-- . +-- +-- 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 ( + + module Media.Streaming.GStreamer.Core, + module Media.Streaming.GStreamer.Base + + ) where + +import Media.Streaming.GStreamer.Core +import Media.Streaming.GStreamer.Base diff --git a/Media/Streaming/GStreamer/Audio/Audio.chs b/Media/Streaming/GStreamer/Audio/Audio.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Audio/Audio.chs @@ -0,0 +1,35 @@ +-- 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 +-- . +-- +-- 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.Audio.Audio ( + + AudioFieldFlag(..), + + ) where + +{#import Media.Streaming.GStreamer.Audio.Types#} diff --git a/Media/Streaming/GStreamer/Audio/AudioClock.chs b/Media/Streaming/GStreamer/Audio/AudioClock.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Audio/AudioClock.chs @@ -0,0 +1,68 @@ +-- 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 +-- . +-- +-- 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.Audio.AudioClock + ( AudioClock + , + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Audio.Types#} +import Media.Streaming.GStreamer.Core +import System.Glib.FFI +import System.Glib.UTFString + +{# context lib = "gstreamer" prefix = "gst" #} + +type AudioClockGetTimeFunc = Clock -> IO ClockTime + +type CAudioClockGetTimeFunc = Ptr Clock + -> {# type gpointer #} + -> IO {# type GstClockTime #} +marshalAudioClockGetTimeFunc :: AudioClockGetTimeFunc + -> IO {# type GstAudioClockGetTimeFunc #} +marshalAudioClockGetTimeFunc func = + makeAudioClockGetTimeFunc cFunc + where cFunc :: CAudioClockGetTimeFunc + cFunc cClock _ = do + clock <- peekObject cClock + liftM fromIntegral $ func clock +foreign import ccall unsafe "wrapper" + makeAudioClockGetTimeFunc :: CAudioClockGetTimeFunc + -> IO {# type GstAudioClockGetTimeFunc #} + +audioClockNew :: String + -> AudioClockGetTimeFunc + -> IO Clock +audioClockNew name func = do + cFunc <- marshalAudioClockGetTimeFunc func + withUTFString name $ \cName -> + {# call audio_clock_new #} cName + cFunc + nullPtr >>= + takeObject diff --git a/Media/Streaming/GStreamer/Audio/Constants.hsc b/Media/Streaming/GStreamer/Audio/Constants.hsc new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Audio/Constants.hsc @@ -0,0 +1,40 @@ +-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*- + +#include "hsgstreamer.h" +#include "template-hsc-gtk2hs.h" + +-- +-- 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 +-- . +-- +-- 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.Audio.Constants ( + + audioDefRate, + + ) where + +audioDefRate :: Double +audioDefRate = #{const GST_AUDIO_DEF_RATE} diff --git a/Media/Streaming/GStreamer/Audio/Types.chs b/Media/Streaming/GStreamer/Audio/Types.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Audio/Types.chs @@ -0,0 +1,43 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Audio.Types + ( module Media.Streaming.GStreamer.Core.Types + , module Media.Streaming.GStreamer.Audio.Constants + + , AudioFieldFlag(..) + + ) where + +import Media.Streaming.GStreamer.Audio.Constants +{#import Media.Streaming.GStreamer.Core.Types#} + +{# enum GstAudioFieldFlag as AudioFieldFlag {underscoreToCase} with prefix = "GST" #} diff --git a/Media/Streaming/GStreamer/Base.hs b/Media/Streaming/GStreamer/Base.hs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base.hs @@ -0,0 +1,44 @@ +-- 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 +-- . +-- +-- 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 ( + + module Media.Streaming.GStreamer.Base.BaseSrc, + module Media.Streaming.GStreamer.Base.BaseSink, + module Media.Streaming.GStreamer.Base.BaseTransform, + module Media.Streaming.GStreamer.Base.PushSrc, + module Media.Streaming.GStreamer.Base.Adapter + + ) where + +import Media.Streaming.GStreamer.Base.BaseSrc +import Media.Streaming.GStreamer.Base.BaseSink +import Media.Streaming.GStreamer.Base.BaseTransform +import Media.Streaming.GStreamer.Base.PushSrc +import Media.Streaming.GStreamer.Base.Adapter + diff --git a/Media/Streaming/GStreamer/Base/Adapter.chs b/Media/Streaming/GStreamer/Base/Adapter.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/Adapter.chs @@ -0,0 +1,191 @@ +{-# 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 +-- . +-- +-- 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.Adapter ( + + Adapter, + AdapterClass, + castToAdapter, + gTypeAdapter, + + adapterNew, + adapterClear, + adapterPush, +#if __GLASGOW_HASKELL__ >= 606 + adapterPeek, +#if GST_CHECK_VERSION(0,10,12) + adapterCopy, + adapterCopyInto, +#endif +#endif + adapterFlush, + adapterAvailable, + adapterAvailableFast, +#if __GLASGOW_HASKELL__ >= 606 + adapterTake, +#endif + adapterTakeBuffer + + ) where + +import Control.Monad (liftM) + +#if __GLASGOW_HASKELL__ >= 606 +#if __GLASGOW_HASKELL__ < 608 +#define OLD_BYTESTRING +#endif + +import qualified Data.ByteString as BS +#ifdef OLD_BYTESTRING +import qualified Data.ByteString.Base as BS +#else +import qualified Data.ByteString.Unsafe as BS +import qualified Data.ByteString.Internal as BS +#endif +#endif + +{#import Media.Streaming.GStreamer.Base.Types#} +import System.Glib.FFI +import System.Glib.GObject +import System.Glib.Flags +import System.Glib.Attributes +{#import System.Glib.Properties#} + +{# context lib = "gstreamer" prefix = "gst" #} + +adapterNew :: IO Adapter +adapterNew = + constructNewGObject mkAdapter {# call adapter_new #} + +adapterClear :: AdapterClass adapterT + => adapterT + -> IO () +adapterClear = + {# call adapter_clear #} . toAdapter + +adapterPush :: (AdapterClass adapterT, BufferClass bufferT) + => adapterT + -> bufferT + -> IO () +adapterPush adapter buffer = + {# call adapter_push #} (toAdapter adapter) (toBuffer buffer) + +#if __GLASGOW_HASKELL__ >= 606 +adapterPeek :: AdapterClass adapterT + => adapterT + -> Word + -> IO (Maybe BS.ByteString) +adapterPeek adapter size = + do ptr <- {# call adapter_peek #} (toAdapter adapter) (fromIntegral size) + if ptr == nullPtr + then return Nothing + else liftM Just $ +#ifdef OLD_BYTESTRING + BS.copyCStringLen +#else + BS.packCStringLen +#endif + (castPtr ptr, fromIntegral size) + +#if GST_CHECK_VERSION(0,10,12) +adapterCopy :: AdapterClass adapterT + => adapterT + -> Word + -> Word + -> IO BS.ByteString +adapterCopy adapter offset size = do + BS.create (fromIntegral size) $ \dest -> + {# call adapter_copy #} (toAdapter adapter) + (castPtr dest) + (fromIntegral offset) + (fromIntegral size) + +adapterCopyInto :: AdapterClass adapterT + => adapterT + -> BS.ByteString + -> Word + -> IO () +adapterCopyInto adapter dest offset = + BS.useAsCStringLen dest $ \(destPtr, size) -> + {# call adapter_copy #} (toAdapter adapter) + (castPtr destPtr) + (fromIntegral offset) + (fromIntegral size) +#endif +#endif + +adapterFlush :: AdapterClass adapterT + => adapterT + -> Word + -> IO () +adapterFlush adapter flush = + {# call adapter_flush #} (toAdapter adapter) $ fromIntegral flush + +adapterAvailable :: AdapterClass adapterT + => adapterT + -> IO Word +adapterAvailable adapter = + liftM fromIntegral $ + {# call adapter_available #} $ toAdapter adapter + +adapterAvailableFast :: AdapterClass adapterT + => adapterT + -> IO Word +adapterAvailableFast adapter = + liftM fromIntegral $ + {# call adapter_available_fast #} $ toAdapter adapter + +#if __GLASGOW_HASKELL__ >= 606 +adapterTake :: AdapterClass adapterT + => adapterT + -> Word + -> IO (Maybe BS.ByteString) +adapterTake adapter nBytes = + do ptr <- {# call adapter_take #} (toAdapter adapter) + (fromIntegral nBytes) + if ptr == nullPtr + then do fPtr <- newForeignPtr (castPtr ptr) gFreePtr + return $ Just $ + BS.fromForeignPtr (castForeignPtr fPtr) +#ifndef OLD_BYTESTRING + 0 +#endif + (fromIntegral nBytes) + else return Nothing +foreign import ccall unsafe "&g_free" + gFreePtr :: FunPtr (Ptr () -> IO ()) +#endif + +adapterTakeBuffer :: AdapterClass adapterT + => adapterT + -> Word + -> IO (Maybe Buffer) +adapterTakeBuffer adapter nBytes = + {# call adapter_take_buffer #} (toAdapter adapter) (fromIntegral nBytes) >>= + maybePeek takeMiniObject diff --git a/Media/Streaming/GStreamer/Base/BaseSink.chs b/Media/Streaming/GStreamer/Base/BaseSink.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/BaseSink.chs @@ -0,0 +1,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 +-- . +-- +-- 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) diff --git a/Media/Streaming/GStreamer/Base/BaseSrc.chs b/Media/Streaming/GStreamer/Base/BaseSrc.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/BaseSrc.chs @@ -0,0 +1,116 @@ +{-# 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 +-- . +-- +-- 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.BaseSrc ( + + BaseSrc, + BaseSrcClass, + castToBaseSrc, + gTypeBaseSrc, + + baseSrcGetFlags, + baseSrcSetFlags, + baseSrcUnsetFlags, +#if GST_CHECK_VERSION(0,10,12) + baseSrcWaitPlaying, +#endif + baseSrcIsLive, + baseSrcGetPad, + baseSrcBlockSize, + baseSrcNumBuffers, + baseSrcTypefind + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Base.Types#} +import Media.Streaming.GStreamer.Base.Constants +import System.Glib.FFI +import System.Glib.Attributes +{#import System.Glib.Properties#} + +{# context lib = "gstreamer" prefix = "gst" #} + +baseSrcGetFlags :: BaseSrcClass baseSrcT + => baseSrcT + -> IO [BaseSrcFlags] +baseSrcGetFlags = mkObjectGetFlags + +baseSrcSetFlags :: BaseSrcClass baseSrcT + => baseSrcT + -> [BaseSrcFlags] + -> IO () +baseSrcSetFlags = mkObjectSetFlags + +baseSrcUnsetFlags :: BaseSrcClass baseSrcT + => baseSrcT + -> [BaseSrcFlags] + -> IO () +baseSrcUnsetFlags = mkObjectUnsetFlags + +#if GST_CHECK_VERSION(0,10,12) +baseSrcWaitPlaying :: BaseSrcClass baseSrcT + => baseSrcT + -> IO FlowReturn +baseSrcWaitPlaying baseSrc = + liftM cToEnum $ + {# call base_src_wait_playing #} (toBaseSrc baseSrc) +#endif + +baseSrcIsLive :: BaseSrcClass baseSrcT + => baseSrcT + -> IO Bool +baseSrcIsLive baseSrc = + liftM toBool $ {# call base_src_is_live #} (toBaseSrc baseSrc) + +baseSrcGetPad :: BaseSrcClass baseSrcT + => baseSrcT + -> IO Pad +baseSrcGetPad baseSrc = + withObject (toBaseSrc baseSrc) cBaseSrcGetPad >>= peekObject +foreign import ccall unsafe "_hs_gst_base_src_get_pad" + cBaseSrcGetPad :: Ptr BaseSrc + -> IO (Ptr Pad) + +-- FIXME: blocksize is actually a gulong... +baseSrcBlockSize :: BaseSrcClass baseSrcT + => Attr baseSrcT Word64 +baseSrcBlockSize = newAttr + (objectGetPropertyUInt64 "blocksize") + (objectSetPropertyUInt64 "blocksize") + +baseSrcNumBuffers :: BaseSrcClass baseSrcT + => Attr baseSrcT Int +baseSrcNumBuffers = + newAttrFromIntProperty "num-buffers" + +baseSrcTypefind :: BaseSrcClass baseSrcT + => Attr baseSrcT Bool +baseSrcTypefind = + newAttrFromBoolProperty "typefind" diff --git a/Media/Streaming/GStreamer/Base/BaseTransform.chs b/Media/Streaming/GStreamer/Base/BaseTransform.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/BaseTransform.chs @@ -0,0 +1,128 @@ +{-# 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 +-- . +-- +-- 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.BaseTransform ( + + BaseTransform, + BaseTransformClass, + castToBaseTransform, + gTypeBaseTransform, + + baseTransformIsPassthrough, + baseTransformSetPassthrough, + baseTransformIsInPlace, + baseTransformSetInPlace, + baseTransformIsQOSEnabled, + baseTransformSetQOSEnabled, + baseTransformGetSinkPad, + baseTransformGetSrcPad, + baseTransformQOS + + ) where + +import Control.Monad (liftM) +{#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" #} + +baseTransformIsPassthrough :: BaseTransformClass baseTransformT + => baseTransformT + -> IO Bool +baseTransformIsPassthrough baseTransform = + liftM toBool $ + {# call base_transform_is_passthrough #} (toBaseTransform baseTransform) + +baseTransformSetPassthrough :: BaseTransformClass baseTransformT + => baseTransformT + -> Bool + -> IO () +baseTransformSetPassthrough baseTransform passthrough = + {# call base_transform_set_passthrough #} (toBaseTransform baseTransform) + (fromBool passthrough) + +baseTransformIsInPlace :: BaseTransformClass baseTransformT + => baseTransformT + -> IO Bool +baseTransformIsInPlace baseTransform = + liftM toBool $ + {# call base_transform_is_in_place #} (toBaseTransform baseTransform) + +baseTransformSetInPlace :: BaseTransformClass baseTransformT + => baseTransformT + -> Bool + -> IO () +baseTransformSetInPlace baseTransform inPlace = + {# call base_transform_set_in_place #} (toBaseTransform baseTransform) + (fromBool inPlace) + +baseTransformIsQOSEnabled :: BaseTransformClass baseTransformT + => baseTransformT + -> IO Bool +baseTransformIsQOSEnabled baseTransform = + liftM toBool $ + {# call base_transform_is_qos_enabled #} (toBaseTransform baseTransform) + +baseTransformSetQOSEnabled :: BaseTransformClass baseTransformT + => baseTransformT + -> Bool + -> IO () +baseTransformSetQOSEnabled baseTransform enabled = + {# call base_transform_set_qos_enabled #} (toBaseTransform baseTransform) + (fromBool enabled) + +baseTransformGetSinkPad :: BaseTransformClass baseTransformT + => baseTransformT + -> IO Pad +baseTransformGetSinkPad baseTransform = + withObject (toBaseTransform baseTransform) cBaseTransformGetSinkPad >>= + peekObject +foreign import ccall unsafe "_hs_gst_base_transform_get_sink_pad" + cBaseTransformGetSinkPad :: Ptr BaseTransform + -> IO (Ptr Pad) + +baseTransformGetSrcPad :: BaseTransformClass baseTransformT + => baseTransformT + -> IO Pad +baseTransformGetSrcPad baseTransform = + withObject (toBaseTransform baseTransform) cBaseTransformGetSrcPad >>= + peekObject +foreign import ccall unsafe "_hs_gst_base_transform_get_src_pad" + cBaseTransformGetSrcPad :: Ptr BaseTransform + -> IO (Ptr Pad) + +baseTransformQOS :: BaseTransformClass baseTransformT + => Attr baseTransformT Bool +baseTransformQOS = newAttr + baseTransformIsQOSEnabled + baseTransformSetQOSEnabled + diff --git a/Media/Streaming/GStreamer/Base/CollectPads.chs b/Media/Streaming/GStreamer/Base/CollectPads.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/CollectPads.chs @@ -0,0 +1,36 @@ +-- 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 +-- . +-- +-- 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.CollectPads ( + + CollectData, + CollectPads, + + ) where + +{#import Media.Streaming.GStreamer.Base.Types#} diff --git a/Media/Streaming/GStreamer/Base/Constants.hsc b/Media/Streaming/GStreamer/Base/Constants.hsc new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/Constants.hsc @@ -0,0 +1,46 @@ +-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*- + +#include "hsgstreamer.h" +#include "template-hsc-gtk2hs.h" + +-- +-- 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 +-- . +-- +-- 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.Constants ( + + BaseSrcFlags(..), + + ) where + +import System.Glib.Flags + +data BaseSrcFlags = BaseSrcStarted + deriving (Eq, Bounded) +instance Enum BaseSrcFlags where + toEnum n | n == #{const GST_BASE_SRC_STARTED} = BaseSrcStarted + fromEnum BaseSrcStarted = #{const GST_BASE_SRC_STARTED} +instance Flags BaseSrcFlags diff --git a/Media/Streaming/GStreamer/Base/PushSrc.chs b/Media/Streaming/GStreamer/Base/PushSrc.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/PushSrc.chs @@ -0,0 +1,40 @@ +-- 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 +-- . +-- +-- 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.PushSrc ( + + PushSrc, + PushSrcClass, + castToPushSrc, + gTypePushSrc, + + ) where + +{#import Media.Streaming.GStreamer.Base.Types#} + +{# context lib = "gstreamer" prefix = "gst" #} diff --git a/Media/Streaming/GStreamer/Base/Types.chs b/Media/Streaming/GStreamer/Base/Types.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Base/Types.chs @@ -0,0 +1,54 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel\@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Base.Types ( + + module Media.Streaming.GStreamer.Core.Types, + + CollectData, + + ) where + +import Data.Bits ( shiftL ) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import System.Glib.GObject#} +import System.Glib.Flags +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +type CollectPadsFunction = CollectPads + -> IO FlowReturn +{# pointer *GstCollectData as CollectData newtype #} + +------------------------------------------------------------------- + +{# enum GstInterpolateMode as InterpolateMode {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} diff --git a/Media/Streaming/GStreamer/Controller/Controller.chs b/Media/Streaming/GStreamer/Controller/Controller.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Controller/Controller.chs @@ -0,0 +1,69 @@ +-- 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 +-- . +-- +-- 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.Controller.Controller ( + + Controller, + ControllerClass, + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Controller.Types#} +{#import System.Glib.GList#} +{#import System.Glib.GObject#} +import System.Glib.FFI +import System.Glib.UTFString + +{# context lib = "gstreamer" prefix = "gst" #} + +controllerInit :: IO Bool +controllerInit = + liftM toBool $ {# call controller_init #} nullPtr nullPtr + +controllerNew :: GObjectClass gObjectT + => gObjectT + -> [String] + -> IO Controller +controllerNew object properties = + withMany withUTFString properties $ \cProperties -> + do cPropertiesGList <- toGList cProperties + cController <- {# call controller_new_list #} (toGObject object) cPropertiesGList + {# call g_list_free #} cPropertiesGList + constructNewGObject mkController $ return cController + +controllerRemoveProperties :: ControllerClass controllerT + => controllerT + -> [String] + -> IO Bool +controllerRemoveProperties controller properties = + withMany withUTFString properties $ \cProperties -> + do cPropertiesGList <- toGList cProperties + success <- {# call controller_remove_properties_list #} (toController controller) cPropertiesGList + {# call g_list_free #} cPropertiesGList + return $ toBool success diff --git a/Media/Streaming/GStreamer/Controller/Types.chs b/Media/Streaming/GStreamer/Controller/Types.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Controller/Types.chs @@ -0,0 +1,38 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel\@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Controller.Types ( + + module Media.Streaming.GStreamer.Core.Types, + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} diff --git a/Media/Streaming/GStreamer/Core.hs b/Media/Streaming/GStreamer/Core.hs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core.hs @@ -0,0 +1,85 @@ +-- 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 +-- . +-- +-- 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 ( + + module Media.Streaming.GStreamer.Core.Bin, + module Media.Streaming.GStreamer.Core.Bus, + module Media.Streaming.GStreamer.Core.Caps, + module Media.Streaming.GStreamer.Core.Clock, + module Media.Streaming.GStreamer.Core.Element, + module Media.Streaming.GStreamer.Core.ElementFactory, + module Media.Streaming.GStreamer.Core.Format, + module Media.Streaming.GStreamer.Core.GhostPad, + module Media.Streaming.GStreamer.Core.ImplementsInterface, + module Media.Streaming.GStreamer.Core.Index, + module Media.Streaming.GStreamer.Core.IndexFactory, + module Media.Streaming.GStreamer.Core.Init, + module Media.Streaming.GStreamer.Core.Iterator, + module Media.Streaming.GStreamer.Core.Message, + module Media.Streaming.GStreamer.Core.Object, + module Media.Streaming.GStreamer.Core.Pad, + module Media.Streaming.GStreamer.Core.PadTemplate, + module Media.Streaming.GStreamer.Core.Parse, + module Media.Streaming.GStreamer.Core.Pipeline, + module Media.Streaming.GStreamer.Core.Plugin, + module Media.Streaming.GStreamer.Core.PluginFeature, + module Media.Streaming.GStreamer.Core.Registry, + module Media.Streaming.GStreamer.Core.Segment, + module Media.Streaming.GStreamer.Core.Structure, + module Media.Streaming.GStreamer.Core.SystemClock, + module Media.Streaming.GStreamer.Core.TagList, + + ) where + +import Media.Streaming.GStreamer.Core.Bin +import Media.Streaming.GStreamer.Core.Bus +import Media.Streaming.GStreamer.Core.Caps +import Media.Streaming.GStreamer.Core.Clock +import Media.Streaming.GStreamer.Core.Element +import Media.Streaming.GStreamer.Core.ElementFactory +import Media.Streaming.GStreamer.Core.Format +import Media.Streaming.GStreamer.Core.GhostPad +import Media.Streaming.GStreamer.Core.ImplementsInterface +import Media.Streaming.GStreamer.Core.Index +import Media.Streaming.GStreamer.Core.IndexFactory +import Media.Streaming.GStreamer.Core.Init +import Media.Streaming.GStreamer.Core.Iterator +import Media.Streaming.GStreamer.Core.Message +import Media.Streaming.GStreamer.Core.Object +import Media.Streaming.GStreamer.Core.Pad +import Media.Streaming.GStreamer.Core.PadTemplate +import Media.Streaming.GStreamer.Core.Parse +import Media.Streaming.GStreamer.Core.Pipeline +import Media.Streaming.GStreamer.Core.Plugin +import Media.Streaming.GStreamer.Core.PluginFeature +import Media.Streaming.GStreamer.Core.Registry +import Media.Streaming.GStreamer.Core.Segment +import Media.Streaming.GStreamer.Core.Structure +import Media.Streaming.GStreamer.Core.SystemClock +import Media.Streaming.GStreamer.Core.TagList diff --git a/Media/Streaming/GStreamer/Core/Bin.chs b/Media/Streaming/GStreamer/Core/Bin.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Bin.chs @@ -0,0 +1,251 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- Base class for elements that can contain other elements. +module Media.Streaming.GStreamer.Core.Bin ( + +-- * Detail + -- | 'Bin' is an element that can contain other 'Element's, allowing + -- them to be managed as a group. 'Pad's from the child elements + -- can be ghosted to the bin; see 'GhostPad'. This makes the bin + -- look like any other element, and enables creation of + -- higher-level abstractions. + -- + -- A new 'Bin' is created with 'binNew'. Use a 'Pipeline' instead + -- if you want to create a toplevel bin, because a normal bin + -- doesn't have a bus or handle clock distribution of its own. + -- + -- After the bin has been created you will typically add elements + -- to it with 'binAdd'. You can remove elements with 'binRemove'. + -- + -- An element can be retrieved from a bin with 'binGetByName', + -- using the element's name. 'binGetByNameRecurseUp' is mainly + -- used for internal purposes and will query the parent bins when + -- the element is not found in the current bin. + -- + -- An iterator of elements in a bin can be retrieved with + -- 'binIterateElements'. Various other iterators exist to retrieve + -- the elements in a bin. + -- + -- The 'binElementAdded' signal is fired whenever a new element is + -- added to the bin. Likewise the 'binElementRemoved' signal is + -- fired whenever an element is removed from the bin. + +-- * Types + Bin, + BinClass, + castToBin, + gTypeBin, + +-- * Bin Operations + binNew, + binAdd, + binRemove, + binGetByName, + binGetByNameRecurseUp, + binGetByInterface, + binIterateElements, + binIterateRecurse, + binIterateSinks, + binIterateSorted, + binIterateSources, + binIterateAllByInterface, + binFindUnconnectedPad, + +-- * Bin Signals + binElementAdded, + binElementRemoved + + ) where + +import Control.Exception ( bracket_ ) +import Control.Monad ( liftM ) +import System.Glib.FFI +{#import System.Glib.GType#} ( GType ) +import System.Glib.UTFString ( withUTFString ) +import System.Glib.GList ( GList + , readGList ) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Create a new 'Bin' with the given name. +binNew :: String -- ^ @name@ - the name to give the new 'Bin' + -> IO Bin -- ^ the new 'Bin' +binNew name = + withUTFString name {# call bin_new #} >>= takeObject . castPtr + +-- | Add @element@ to @bin@, and set @element@'s parent to +-- @bin@. An 'Element' can only be added to one 'Bin' at a time. +-- +-- If any of @element@'s pads are linked to other 'Pad's, they will be +-- unlinked before @element@ is added to @bin@. +binAdd :: (BinClass bin, ElementClass element) + => bin -- ^ @bin@ - a 'Bin' + -> element -- ^ @element@ - the element to add + -> IO Bool -- ^ 'True' if the element could be added, 'False' + -- if the bin does not want to accept the element +binAdd bin element = + liftM toBool $ {# call bin_add #} (toBin bin) (toElement element) + +-- | Remove @element@ from @bin@, unparenting it as well. +-- +-- If any @element@'s pads are linked to other pads, they will be +-- unlinked before @element@ is added to @bin@. +binRemove :: (BinClass bin, ElementClass element) + => bin -- ^ @bin@ - a 'Bin' + -> element -- ^ @element@ - the element to remove + -> IO Bool -- ^ 'True' if @element@ could be removed, otherwise 'False' +binRemove bin element = + liftM toBool $ {# call bin_remove #} (toBin bin) (toElement element) + +-- | Get the 'Element' with the given name @name@ from @bin@, +-- recursing down through @bin@'s children. 'Nothing' is returned if no +-- 'Element' with the given name is found. +binGetByName :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> String -- ^ @name@ - the name to search for + -> IO (Maybe Element) -- ^ the 'Element' with the name @name@, or 'Nothing' +binGetByName bin name = + withUTFString name ({# call bin_get_by_name #} (toBin bin)) >>= maybePeek takeObject + +-- | Get the 'Element' with the given name @name@ from @bin@, +-- recursing up through @bin@'s parents. Returns 'Nothing' if no +-- element with the given name is found. +binGetByNameRecurseUp :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> String -- ^ @element@ - the name to search for + -> IO (Maybe Element) -- ^ the 'Element' with the given name, or 'Nothing' +binGetByNameRecurseUp bin name = + withUTFString name ({# call bin_get_by_name_recurse_up #} $ toBin bin) >>= + maybePeek takeObject + +-- | Find an 'Element' inside @bin@ that implements the interface +-- given by @iface@. The returned 'Element' can be casted to +-- @iface@'s type. If you want all the 'Element's that implement an +-- interface, use 'binIterateAllByInterface'. +-- +-- This function recurses into child bins. +binGetByInterface :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> GType -- ^ @iface@ - the type of the requested interface + -> IO (Maybe Element) -- ^ the 'Element' inside @bin@ that implements @iface@, or 'Nothing' +binGetByInterface bin iface = + {# call bin_get_by_interface #} (toBin bin) (fromIntegral iface) >>= + maybePeek takeObject + +-- | Get an 'Iterator' over the 'Element's in @bin@. +binIterateElements :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' over the 'Element's in @bin@, + -- or 'Nothing' +binIterateElements bin = + {# call bin_iterate_elements #} (toBin bin) >>= + maybePeek takeIterator + +-- | Get an 'Iterator' over the 'Element's in @bin@. This +-- iterator recurses into @bin@'s children. +binIterateRecurse :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' over the 'Element's in @bin@ + -- and its descendents, or 'Nothing' +binIterateRecurse bin = + {# call bin_iterate_recurse #} (toBin bin) >>= + maybePeek takeIterator + +-- | Get an iterator over the 'Element's in @bin@ that have the +-- 'ElementIsSink' flag set. +binIterateSinks :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' over the sinks in @bin@, or 'Nothing' +binIterateSinks bin = + {# call bin_iterate_sinks #} (toBin bin) >>= + maybePeek takeIterator + +-- | Gets an iterator for the elements in this bin in topologically +-- sorted order. This means that the elements are returned from the +-- most downstream elements (sinks) to the sources. +-- +-- This function is used internally to perform state changes of the +-- bin elements. +binIterateSorted :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' over the 'Element's in @bin@, or 'Nothing' +binIterateSorted bin = + {# call bin_iterate_sorted #} (toBin bin) >>= + maybePeek takeIterator + +-- | Gets an iterator for all elements in the bin that have no sink +-- pads and have the 'ElementIsSink' flag unset. +binIterateSources :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' on elements, or 'Nothing' +binIterateSources bin = + {# call bin_iterate_sources #} (toBin bin) >>= + maybePeek takeIterator + +-- | Looks for all elements inside the bin that implement the given +-- interface. You can safely case all elements to the given +-- interface. The function recurses inside child bins. +binIterateAllByInterface :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> GType -- ^ @iface@ - the interface's 'GType' + -> IO (Maybe (Iterator Element)) -- ^ an 'Iterator' on elements, or 'Nothing' +binIterateAllByInterface bin iface = + {# call bin_iterate_all_by_interface #} (toBin bin) (fromIntegral iface) >>= + maybePeek takeIterator + +#if GST_CHECK_VERSION (0, 10, 3) +-- | Recursively looks for elements with an unconnected pad of the +-- given direction within the specified bin. Returns an unconnected +-- pad if one is found, otherwise 'Nothing'. +-- +-- Since 0.10.3. +binFindUnconnectedPad :: BinClass bin + => bin -- ^ @bin@ - a 'Bin' + -> PadDirection -- ^ @direction@ - the direction of the requested 'Pad' + -> IO (Maybe Pad) -- ^ an unconnected 'Pad', or 'Nothing' +binFindUnconnectedPad bin direction = + {# call bin_find_unconnected_pad #} (toBin bin) (fromIntegral $ fromEnum direction) >>= + maybePeek takeObject +#endif + +-- | An 'Element' has been added to the 'Bin'. +binElementAdded :: BinClass bin + => Signal bin (Element -> IO ()) +binElementAdded = + Signal $ connect_OBJECT__NONE "element-added" + +-- | An 'Element' has been removed from the 'Bin'. +binElementRemoved :: BinClass bin + => Signal bin (Element -> IO ()) +binElementRemoved = + Signal $ connect_OBJECT__NONE "element-added" diff --git a/Media/Streaming/GStreamer/Core/Buffer.chs b/Media/Streaming/GStreamer/Core/Buffer.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Buffer.chs @@ -0,0 +1,455 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- Data-passing buffer type, supporting sub-buffers. +module Media.Streaming.GStreamer.Core.Buffer ( + +-- * Types + + -- | 'Buffer's are the basic unit of data transfer in GStreamer. The + -- 'Buffer' type provides all the state necessary to define a + -- region of memory as part of a stream. Sub-buffers are also + -- supported, allowing a smaller region of a 'Buffer' to become its + -- own 'Buffer', with mechansims in place to ensure that neither + -- memory space goes away prematurely. + Buffer, + BufferClass, + castToBuffer, + gTypeBuffer, + + BufferFlags(..), + +-- * Buffer Operations + bufferOffsetNone, + bufferGetFlags, + bufferGetFlagsM, + bufferSetFlagsM, + bufferUnsetFlagsM, + bufferGetSize, + bufferGetSizeM, +#if __GLASGOW_HASKELL__ >= 606 + bufferGetData, + bufferGetDataM, + bufferSetDataM, +#endif + unsafeBufferGetPtrM, + bufferGetTimestamp, + bufferGetTimestampM, + bufferSetTimestampM, + bufferGetDuration, + bufferGetDurationM, + bufferSetDurationM, + bufferGetCaps, + bufferGetCapsM, + bufferSetCapsM, + bufferGetOffset, + bufferGetOffsetM, + bufferSetOffsetM, + bufferGetOffsetEnd, + bufferGetOffsetEndM, + bufferSetOffsetEndM, + bufferIsDiscont, + bufferIsDiscontM, + + bufferCreateEmpty, + bufferCreate, + bufferCreateSub, + + bufferIsSpanFast, + bufferSpan, + bufferMerge + + ) where + +import Control.Monad ( liftM + , when ) +import Control.Monad.Trans +#if __GLASGOW_HASKELL__ >= 606 +import qualified Data.ByteString as BS +#if __GLASGOW_HASKELL__ < 608 +#define OLD_BYTESTRING +#endif +#endif + +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Get the flags set on @buffer@. +bufferGetFlags :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a 'Buffer' + -> [BufferFlags] -- ^ the flags set on @buffer@ +bufferGetFlags = mkMiniObjectGetFlags + +-- | Get the flags set on the current 'Buffer'. +bufferGetFlagsM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m [BufferFlags] -- ^ the flags set on the current 'Buffer' +bufferGetFlagsM = mkMiniObjectGetFlagsM + +-- | Set flags on the current 'Buffer'. +bufferSetFlagsM :: (BufferClass bufferT, MonadIO m) + => [BufferFlags] -- ^ @flags@ - the flags to set on the current 'Buffer' + -> MiniObjectT bufferT m () +bufferSetFlagsM = mkMiniObjectSetFlagsM + +-- | Unset flags on the current 'Buffer'. +bufferUnsetFlagsM :: (BufferClass bufferT, MonadIO m) + => [BufferFlags] -- ^ @flags@ - the flags to unset on the current 'Buffer' + -> MiniObjectT bufferT m () +bufferUnsetFlagsM = mkMiniObjectUnsetFlagsM + +-- | Get @buffer@'s size in bytes. +bufferGetSize :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a 'Buffer' + -> Word -- ^ the size of @buffer@ in bytes +bufferGetSize buffer = + fromIntegral $ unsafePerformIO $ + withMiniObject buffer {# get GstBuffer->size #} + +marshalBufferM :: (BufferClass bufferT, MonadIO m) + => (Ptr Buffer -> IO a) + -> MiniObjectT bufferT m a +marshalBufferM action = do + ptr <- askMiniObjectPtr + liftIO $ action $ castPtr ptr + +-- | Get the size of the current 'Buffer' in bytes. +bufferGetSizeM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m Word -- ^ the size of the current 'Buffer' in bytes +bufferGetSizeM = + liftM fromIntegral $ + marshalBufferM {# get GstBuffer->size #} + +#if __GLASGOW_HASKELL__ >= 606 +-- | Make an O(n) copy of the data stored in @buffer@. +bufferGetData :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a 'Buffer' + -> BS.ByteString -- ^ the data stored in @buffer@ +bufferGetData buffer = + unsafePerformIO $ withMiniObject buffer $ \bufferPtr -> + do ptr <- {# get GstBuffer->data #} bufferPtr + size <- {# get GstBuffer->size #} bufferPtr +#ifdef OLD_BYTESTRING + BS.copyCStringLen (castPtr ptr, fromIntegral size) +#else + BS.packCStringLen (castPtr ptr, fromIntegral size) +#endif + +-- | Make an O(n) copy of the current 'Buffer'. +bufferGetDataM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m BS.ByteString -- ^ the data stored in the current 'Buffer' +bufferGetDataM = + marshalBufferM $ \bufferPtr -> + do ptr <- {# get GstBuffer->data #} bufferPtr + size <- {# get GstBuffer->size #} bufferPtr +#ifdef OLD_BYTESTRING + BS.copyCStringLen (castPtr ptr, fromIntegral size) +#else + BS.packCStringLen (castPtr ptr, fromIntegral size) +#endif + +-- | Store an O(n) copy of the provided data in the current 'Buffer'. +bufferSetDataM :: (BufferClass bufferT, MonadIO m) + => BS.ByteString -- ^ @bs@ - the data to store in the current 'Buffer' + -> MiniObjectT bufferT m () +bufferSetDataM bs = + marshalBufferM $ \bufferPtr -> + BS.useAsCStringLen bs $ \(origData, size) -> + do mallocData <- {# get GstBuffer->malloc_data #} bufferPtr + when (mallocData /= nullPtr) $ + {# call g_free #} $ castPtr mallocData + newData <- liftM castPtr $ {# call g_malloc #} $ fromIntegral size + copyBytes (castPtr newData) origData size + {# set GstBuffer->data #} bufferPtr newData + {# set GstBuffer->malloc_data #} bufferPtr newData + {# set GstBuffer->size #} bufferPtr $ fromIntegral size +#endif + +-- | Get a raw pointer to the internal data area for the current +-- buffer. The pointer may be used to write into the data area if +-- desired. This function is unsafe in that the pointer should not +-- be used once the 'Buffer' is returned. +unsafeBufferGetPtrM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Ptr Word8) -- ^ a pointer to the data stored in the current 'Buffer' +unsafeBufferGetPtrM = do + ptr <- askMiniObjectPtr + liftIO $ liftM castPtr $ + {# get GstBuffer->data #} ptr + +marshalGetNum :: (BufferClass bufferT, Integral intT, Num numT) + => (Ptr Buffer -> IO intT) + -> numT + -> bufferT + -> Maybe numT +marshalGetNum getAction invalid buffer = + let n = fromIntegral $ unsafePerformIO $ + withMiniObject (toBuffer buffer) getAction + in if n /= invalid + then Just n + else Nothing + +marshalGetNumM :: (BufferClass bufferT, Integral intT, Num numT, MonadIO m) + => (Ptr Buffer -> IO intT) + -> numT + -> MiniObjectT bufferT m (Maybe numT) +marshalGetNumM getAction invalid = + marshalBufferM $ \bufferPtr -> do + n <- liftM fromIntegral $ getAction bufferPtr + return $ if n /= invalid + then Just n + else Nothing + +marshalSetNumM :: (BufferClass bufferT, Integral intT, Num numT, MonadIO m) + => (Ptr Buffer -> numT -> IO ()) + -> intT + -> Maybe intT + -> MiniObjectT bufferT m () +marshalSetNumM setAction invalid nM = + let n = case nM of + Just n' -> n' + Nothing -> invalid + in marshalBufferM $ flip setAction $ fromIntegral n + +-- | Get the timestamp on @buffer@. +bufferGetTimestamp :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a 'Buffer' + -> Maybe ClockTime -- ^ the timestamp on @buffer@ +bufferGetTimestamp = + marshalGetNum {# get GstBuffer->timestamp #} clockTimeNone + +-- | Get the timestamp on the current 'Buffer'. +bufferGetTimestampM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the timestamp on the current 'Buffer' +bufferGetTimestampM = + marshalGetNumM {# get GstBuffer->timestamp #} clockTimeNone + +-- | Set the timestamp on the current 'Buffer'. +bufferSetTimestampM :: (BufferClass bufferT, MonadIO m) + => Maybe ClockTime -- ^ @timestamp@ - the timestamp to set on the current 'Buffer' + -> MiniObjectT bufferT m () +bufferSetTimestampM = + marshalSetNumM {# set GstBuffer->timestamp #} clockTimeNone + +-- | Get the duration of @buffer@. +bufferGetDuration :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a 'Buffer' + -> Maybe ClockTime -- ^ the duration of @buffer@ +bufferGetDuration = + marshalGetNum {# get GstBuffer->duration #} clockTimeNone + +-- | Get the duration of the current 'Buffer'. +bufferGetDurationM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Maybe ClockTime) -- ^ the duration of the current 'Buffer' +bufferGetDurationM = + marshalGetNumM {# get GstBuffer->duration #} clockTimeNone + +-- | Set the duration of the current 'Buffer'. +bufferSetDurationM :: (BufferClass bufferT, MonadIO m) + => Maybe ClockTime -- ^ @duration@ - the duration to set on the current 'Buffer' + -> MiniObjectT bufferT m () +bufferSetDurationM = + marshalSetNumM {# set GstBuffer->duration #} clockTimeNone + +-- | Get the 'Caps' of @buffer@. +bufferGetCaps :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a buffer + -> Maybe Caps -- ^ the 'Caps' of @buffer@ if set, otherwise 'Nothing' +bufferGetCaps buffer = + unsafePerformIO $ + {# call buffer_get_caps #} (toBuffer buffer) >>= + maybePeek takeCaps + +-- | Get the caps of the current 'Buffer'. +bufferGetCapsM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Maybe Caps) -- ^ the 'Caps' of the current 'Buffer' + -- if set, otherwise 'Nothing' +bufferGetCapsM = do + ptr <- askMiniObjectPtr + liftIO $ gst_buffer_get_caps (castPtr ptr) >>= + maybePeek takeCaps + where _ = {# call buffer_get_caps #} + +-- | Set the caps of the current 'Buffer'. +bufferSetCapsM :: (BufferClass bufferT, MonadIO m) + => Maybe Caps -- ^ @caps@ - the 'Caps' to set on the current + -- 'Buffer', or 'Nothing' to unset them + -> MiniObjectT bufferT m () +bufferSetCapsM capsM = do + ptr <- askMiniObjectPtr + liftIO $ withForeignPtr (case capsM of + Just caps -> unCaps caps + Nothing -> nullForeignPtr) + (gst_buffer_set_caps $ castPtr ptr) + where _ = {# call buffer_set_caps #} + +-- | Get the start offset of the 'Buffer'. +bufferGetOffset :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a buffer + -> Maybe Word64 -- ^ the start offset of @buffer@ if set, otherwise 'Nothing' +bufferGetOffset = + marshalGetNum {# get GstBuffer->offset #} bufferOffsetNone + +-- | Get the start offset of the current 'Buffer'. +bufferGetOffsetM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current + -- 'Buffer' if set, otherwise 'Nothing' +bufferGetOffsetM = + marshalGetNumM {# get GstBuffer->offset #} bufferOffsetNone + +-- | Set the start offset of the current 'Buffer'. +bufferSetOffsetM :: (BufferClass bufferT, MonadIO m) + => Maybe Word64 -- ^ @offset@ - the start offset to set on the current buffer + -> MiniObjectT bufferT m () +bufferSetOffsetM = + marshalSetNumM {# set GstBuffer->offset #} bufferOffsetNone + +-- | Get the end offset of the 'Buffer'. +bufferGetOffsetEnd :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a buffer + -> Maybe Word64 -- ^ the end offset of @buffer@ if set, otherwise 'Nothing' +bufferGetOffsetEnd = + marshalGetNum {# get GstBuffer->offset_end #} bufferOffsetNone + +-- | Get the end offset of the current 'Buffer'. +bufferGetOffsetEndM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m (Maybe Word64) -- ^ the start offset of the current + -- 'Buffer' if set, otherwise 'Nothing' +bufferGetOffsetEndM = + marshalGetNumM {# get GstBuffer->offset_end #} bufferOffsetNone + +-- | Set the end offset of the current 'Buffer'. +bufferSetOffsetEndM :: (BufferClass bufferT, MonadIO m) + => Maybe Word64 -- ^ @offset@ - the end offset to set on the current buffer + -> MiniObjectT bufferT m () +bufferSetOffsetEndM = + marshalSetNumM {# set GstBuffer->offset_end #} bufferOffsetNone + +-- | Return 'True' if the 'Buffer' marks a discontinuity in a stream, or +-- 'False' otherwise. This typically occurs after a seek or a +-- dropped buffer from a live or network source. +bufferIsDiscont :: BufferClass bufferT + => bufferT -- ^ @buffer@ - a buffer + -> Bool -- ^ 'True' if @buffer@ marks a discontinuity in a stream +bufferIsDiscont = + (elem BufferDiscont) . bufferGetFlags + +-- | Return 'True' if the current 'Buffer' marks a discontinuity in a +-- stream, or 'False' otherwise. +bufferIsDiscontM :: (BufferClass bufferT, MonadIO m) + => MiniObjectT bufferT m Bool -- ^ 'True' if the current buffer marks a + -- discontinuity in a stream +bufferIsDiscontM = + liftM (elem BufferDiscont) $ bufferGetFlagsM + +-- | Create an empty 'Buffer' and mutate it according to the given +-- action. Once this function returns, the 'Buffer' is immutable. +bufferCreateEmpty :: MonadIO m + => MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action + -> m (Buffer, a) -- ^ the new buffer and the action's result +bufferCreateEmpty = + marshalMiniObjectModify $ liftIO {# call buffer_new #} + +-- | Create and mutate a 'Buffer' of the given size. +bufferCreate :: MonadIO m + => Word -- ^ @size@ - the size of the 'Buffer' to be created + -> MiniObjectT Buffer m a -- ^ @mutate@ - the mutating action + -> m (Buffer, a) -- ^ the new 'Buffer' and the action's result +bufferCreate size = + marshalMiniObjectModify $ + liftIO $ {# call buffer_new_and_alloc #} $ fromIntegral size + +-- | Create a sub-buffer from an existing 'Buffer' with the given offset +-- and size. This sub-buffer uses the actual memory space of the +-- parent buffer. Thus function will copy the offset and timestamp +-- fields when the offset is 0. Otherwise, they will both be set to +-- 'Nothing'. If the offset is 0 and the size is the total size of +-- the parent, the duration and offset end fields are also +-- copied. Otherwise they will be set to 'Nothing'. +bufferCreateSub :: BufferClass bufferT + => bufferT -- ^ @parent@ - the parent buffer + -> Word -- ^ @offset@ - the offset + -> Word -- ^ @size@ - the size + -> Maybe Buffer -- ^ the new sub-buffer +bufferCreateSub parent offset size = + unsafePerformIO $ + {# call buffer_create_sub #} (toBuffer parent) + (fromIntegral offset) + (fromIntegral size) >>= + maybePeek takeMiniObject + +-- | Return 'True' if 'bufferSpan' can be done without copying the +-- data, or 'False' otherwise. +bufferIsSpanFast :: (BufferClass bufferT1, BufferClass bufferT2) + => bufferT1 -- ^ @buffer1@ - the first buffer + -> bufferT2 -- ^ @buffer2@ - the second buffer + -> Bool -- ^ 'True' if the buffers are contiguous, + -- or 'False' if copying would be + -- required +bufferIsSpanFast buffer1 buffer2 = + toBool $ unsafePerformIO $ + {# call buffer_is_span_fast #} (toBuffer buffer1) + (toBuffer buffer2) + +-- | Create a new 'Buffer' that consists of a span across the given +-- buffers. Logically, the buffers are concatenated to make a larger +-- buffer, and a new buffer is created at the given offset and with +-- the given size. +-- +-- If the two buffers are children of the same larger buffer, and +-- are contiguous, no copying is necessary. You can use +-- 'bufferIsSpanFast' to determine if copying is needed. +bufferSpan :: (BufferClass bufferT1, BufferClass bufferT2) + => bufferT1 -- ^ @buffer1@ - the first buffer + -> Word32 -- ^ @offset@ - the offset into the concatenated buffer + -> bufferT2 -- ^ @buffer2@ - the second buffer + -> Word32 -- ^ @len@ - the length of the final buffer + -> Maybe Buffer -- ^ the spanning buffer, or 'Nothing' if + -- the arguments are invalid +bufferSpan buffer1 offset buffer2 len = + unsafePerformIO $ + {# call buffer_span #} (toBuffer buffer1) + (fromIntegral offset) + (toBuffer buffer2) + (fromIntegral len) >>= + maybePeek takeMiniObject + +-- | Concatenate two buffers. If the buffers point to contiguous memory +-- areas, no copying will occur. +bufferMerge :: (BufferClass bufferT1, BufferClass bufferT2) + => bufferT1 -- ^ @buffer1@ - a buffer + -> bufferT2 -- ^ @buffer2@ - a buffer + -> Buffer -- ^ the concatenation of the buffers +bufferMerge buffer1 buffer2 = + unsafePerformIO $ + {# call buffer_merge #} (toBuffer buffer1) + (toBuffer buffer2) >>= + takeMiniObject diff --git a/Media/Streaming/GStreamer/Core/Bus.chs b/Media/Streaming/GStreamer/Core/Bus.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Bus.chs @@ -0,0 +1,429 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- An asynchronous message bus subsystem. +module Media.Streaming.GStreamer.Core.Bus ( +-- * Detail + -- | The 'Bus' is resposible for delivering 'Message's in a + -- first-in, first-out order, from the streaming threads to the + -- application. + -- + -- Since the application typically only wants to deal with + -- delivery of these messages from one thread, the 'Bus' will + -- marshal the messages between different threads. This is + -- important since the actual streaming of media is done in + -- a thread separate from the application. + -- + -- The 'Bus' provides support for 'System.Glib.MainLoop.Source' + -- based notifications. This makes it possible to handle the + -- delivery in the GLib 'System.Glib.MainLoop.Source'. + -- + -- A message is posted on the bus with the 'busPost' method. With + -- the 'busPeek' and 'busPop' methods one can look at or retrieve + -- a previously posted message. + -- + -- The bus can be polled with the 'busPoll' method. This methods + -- blocks up to the specified timeout value until one of the + -- specified messages types is posted on the bus. The application + -- can then pop the messages from the bus to handle + -- them. Alternatively the application can register an + -- asynchronous bus function using 'busAddWatch'. This function + -- will install a 'System.Glib.MainLoop.Source' in the default + -- GLib main loop and will deliver messages a short while after + -- they have been posted. Note that the main loop should be + -- running for the asynchronous callbacks. + -- + -- It is also possible to get messages from the bus without any + -- thread marshalling with the 'busSetSyncHandler' method. This + -- makes it possible to react to a message in the same thread that + -- posted the message on the bus. This should only be used if the + -- application is able to deal with messages from different + -- threads. + -- + -- Every 'Pipeline' has one bus. + -- + -- Note that a 'Pipeline' will set its bus into flushing state + -- when changing from 'StateReady' to 'StateNull'. + +-- * Types + Bus, + BusClass, + -- | The result of a 'BusSyncHandler'. + BusSyncReply, + -- | A handler that will be invoked synchronously when a new message + -- is injected into the bus. This function is mostly used internally. + -- Only one sync handler may be attached to a given bus. + BusSyncHandler, + castToBus, + gTypeBus, + +-- * Bus Operations + busGetFlags, + busSetFlags, + busUnsetFlags, + busNew, + busPost, + busHavePending, + busPeek, + busPop, +#if GST_CHECK_VERSION(0,10,12) + busTimedPop, +#endif + busSetFlushing, + busSetSyncHandler, + busUseSyncSignalHandler, + busCreateWatch, + busAddWatch, + busDisableSyncMessageEmission, + busEnableSyncMessageEmission, + busAddSignalWatch, + busRemoveSignalWatch, + busPoll, + +-- * Bus Signals + busMessage, + busSyncMessage, + + ) where + +import Control.Monad ( liftM + , when ) +{#import Media.Streaming.GStreamer.Core.Object#} +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} +{#import System.Glib.MainLoop#} +import System.Glib.Flags +import System.Glib.FFI +{#import System.Glib.GObject#} +{#import System.Glib.MainLoop#} + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Get the flags set on this bus. +busGetFlags :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO [BusFlags] -- ^ the flags set on @bus@ +busGetFlags = mkObjectGetFlags + +-- | Set flags on this bus. +busSetFlags :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> [BusFlags] -- ^ the flags to set on @bus@ + -> IO () +busSetFlags = mkObjectSetFlags + +-- | Unset flags on this bus. +busUnsetFlags :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> [BusFlags] -- ^ the flags to unset on @bus@ + -> IO () +busUnsetFlags = mkObjectUnsetFlags + +-- | Create a new bus. +busNew :: IO Bus -- ^ the newly created 'Bus' object +busNew = + {# call bus_new #} >>= takeObject + +-- | Post a message to the bus. +busPost :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Message -- ^ @message@ - the message to post + -> IO Bool -- ^ 'True' if the message was posted, or + -- 'False' if the bus is flushing +busPost bus message = + do {# call gst_mini_object_ref #} (toMiniObject message) + liftM toBool $ {# call bus_post #} (toBus bus) message + +-- | Check if there are pending messages on the bus. +busHavePending :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO Bool -- ^ 'True' if there are messages + -- on the bus to be handled, otherwise 'False' +busHavePending bus = + liftM toBool $ {# call bus_have_pending #} $ toBus bus + +-- | Get the message at the front of the queue. Any message returned +-- will remain on the queue. +busPeek :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO (Maybe Message) -- ^ the first 'Message' on the bus, or + -- 'Nothing' if the bus is empty +busPeek bus = + {# call bus_peek #} (toBus bus) >>= maybePeek takeMiniObject + +-- | Get the message at the front of the queue. It will be removed +-- from the queue. +busPop :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO (Maybe Message) -- ^ the first 'Message' on the bus, or + -- 'Nothing' if the bus is empty +busPop bus = + {# call bus_pop #} (toBus bus) >>= maybePeek takeMiniObject + +#if GST_CHECK_VERSION(0,10,12) +-- | Get a message from the bus, waiting up to the specified timeout. +-- If the time given is 'Nothing', the function will wait forever. +-- If the time given is @0@, the function will behave like 'busPop'. +-- +-- Since 0.10.12. +busTimedPop :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Maybe ClockTime -- ^ @timeoutM@ - the time to wait for, + -- or 'Nothing' to wait forever + -> IO (Maybe Message) -- ^ the first message recieved, or + -- 'Nothing' if the timeout has expired +busTimedPop bus timeoutM = + let timeout = case timeoutM of + Just timeout' -> timeout' + Nothing -> clockTimeNone + in {# call bus_timed_pop #} (toBus bus) (fromIntegral timeout) >>= + maybePeek takeMiniObject +#endif + +-- | If @flushing@ is 'True', the bus will flush out any queued +-- messages, as well as any future messages, until the function is +-- called with @flushing@ set to 'False'. +busSetFlushing :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Bool -- ^ @flushing@ - the new flushing state + -> IO () +busSetFlushing bus flushing = + {# call bus_set_flushing #} (toBus bus) $ fromBool flushing + +type CBusSyncHandler = Ptr Bus + -> Ptr Message + -> {# type gpointer #} + -> IO {# type GstBusSyncReply #} +marshalBusSyncHandler :: BusSyncHandler + -> IO {# type GstBusSyncHandler #} +marshalBusSyncHandler busSyncHandler = + makeBusSyncHandler cBusSyncHandler + where cBusSyncHandler :: CBusSyncHandler + cBusSyncHandler busPtr messagePtr _ = + do bus <- peekObject busPtr + message <- peekMiniObject messagePtr + reply <- busSyncHandler bus message + when (reply == BusDrop) $ + {# call gst_mini_object_unref #} (toMiniObject message) + return $ fromIntegral $ fromEnum reply +foreign import ccall "wrapper" + makeBusSyncHandler :: CBusSyncHandler + -> IO {# type GstBusSyncHandler #} + +-- See Graphics.UI.Gtk.General.Clipboard.clipboardSetWithData for an +-- explanation of this hack. +funPtrQuark :: Quark +funPtrQuark = unsafePerformIO $ quarkFromString "Gtk2HS::SyncHandlerFunPtr" + +-- | Set the synchronous message handler on the bus. The function will +-- be called every time a new message is posted to the bus. Note +-- that the function will be called from the thread context of the +-- poster. +-- +-- Calling this function will replace any previously set sync +-- handler. If 'Nothing' is passed to this function, it will unset +-- the handler. +busSetSyncHandler :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Maybe BusSyncHandler -- ^ @busSyncHandlerM@ - the new 'BusSyncHandler' + -> IO () +busSetSyncHandler bus Nothing = objectWithLock bus $ do + {#call bus_set_sync_handler #} (toBus bus) nullFunPtr nullPtr + {#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr +busSetSyncHandler bus (Just busSyncHandler) = objectWithLock bus $ do + funPtr <- marshalBusSyncHandler busSyncHandler + {#call bus_set_sync_handler #} (toBus bus) funPtr nullPtr + {#call unsafe g_object_set_qdata_full#} (toGObject bus) funPtrQuark + (castFunPtrToPtr funPtr) destroyFunPtr + +-- | Use a synchronous message handler that converts all messages to signals. +busUseSyncSignalHandler :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO () +busUseSyncSignalHandler bus = objectWithLock bus $ do + {# call bus_set_sync_handler #} (toBus bus) cBusSyncSignalHandlerPtr nullPtr + {#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr + +foreign import ccall unsafe "&gst_bus_sync_signal_handler" + cBusSyncSignalHandlerPtr :: {# type GstBusSyncHandler #} + +-- | Create a watch for the bus. The 'Source' will dispatch a signal +-- whenever a message is on the bus. After the signal is dispatched, +-- the message is popped off the bus. +busCreateWatch :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO Source -- ^ the new event 'Source' +busCreateWatch bus = + liftM Source $ {# call bus_create_watch #} (toBus bus) >>= + flip newForeignPtr sourceFinalizer +foreign import ccall unsafe "&g_source_unref" + sourceFinalizer :: FunPtr (Ptr Source -> IO ()) + +type CBusFunc = Ptr Bus + -> Ptr Message + -> {# type gpointer #} + -> IO {# type gboolean #} +marshalBusFunc :: BusFunc + -> IO {# type GstBusFunc #} +marshalBusFunc busFunc = + makeBusFunc cBusFunc + where cBusFunc :: CBusFunc + cBusFunc busPtr messagePtr userData = + do bus <- peekObject busPtr + message <- peekMiniObject messagePtr + liftM fromBool $ busFunc bus message +foreign import ccall "wrapper" + makeBusFunc :: CBusFunc + -> IO {# type GstBusFunc #} + +-- | Adds a bus watch to the default main context with the given +-- priority. This function is used to receive asynchronous messages +-- in the main loop. +-- +-- The watch can be removed by calling 'System.Glib.MainLoop.sourceRemove'. +busAddWatch :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Priority -- ^ @priority@ - the priority of the watch + -> BusFunc -- ^ @func@ - the action to perform when a message is recieved + -> IO HandlerId -- ^ the event source ID +busAddWatch bus priority func = + do busFuncPtr <- marshalBusFunc func + liftM fromIntegral $ + {# call bus_add_watch_full #} + (toBus bus) + (fromIntegral priority) + busFuncPtr + (castFunPtrToPtr busFuncPtr) + destroyFunPtr + +-- | Instructs GStreamer to stop emitting the 'busSyncMessage' signal +-- for this bus. See 'busEnableSyncMessageEmission' for more +-- information. +-- +-- In the event that multiple pieces of code have called +-- 'busEnableSyncMessageEmission', the sync-message +-- emissions will only be stopped after all calls to +-- 'busEnableSyncMessageEmission' were "cancelled" by +-- calling this function. +busDisableSyncMessageEmission :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO () +busDisableSyncMessageEmission = + {# call bus_disable_sync_message_emission #} . toBus + +-- | Instructs GStreamer to emit the 'busSyncMessage' signal after +-- running the bus's sync handler. This function is here so that +-- programmers can ensure that they can synchronously receive +-- messages without having to affect what the bin's sync handler is. +-- +-- This function may be called multiple times. To clean up, the +-- caller is responsible for calling 'busDisableSyncMessageEmission' +-- as many times as this function is called. +-- +-- While this function looks similar to 'busAddSignalWatch', it is +-- not exactly the same -- this function enables synchronous +-- emission of signals when messages arrive; 'busAddSignalWatch' +-- adds an idle callback to pop messages off the bus +-- asynchronously. The 'busSyncMessage' signal comes from the thread +-- of whatever object posted the message; the 'busMessage' signal is +-- marshalled to the main thread via the main loop. +busEnableSyncMessageEmission :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO () +busEnableSyncMessageEmission = + {# call bus_enable_sync_message_emission #} . toBus + +-- | Adds a bus signal watch to the default main context with the +-- given priority. After calling this method, the bus will emit the +-- 'busMessage' signal for each message posted on the bus. +-- +-- This function may be called multiple times. To clean up, the +-- caller is responsible for calling 'busRemoveSignalWatch' as many +-- times. +busAddSignalWatch :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> Priority -- ^ @priority@ - the priority of the watch + -> IO () +busAddSignalWatch bus priority = + {# call bus_add_signal_watch_full #} (toBus bus) $ fromIntegral priority + +-- | Remove the signal watch that was added with 'busAddSignalWatch'. +busRemoveSignalWatch :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> IO () +busRemoveSignalWatch = + {# call bus_remove_signal_watch #} . toBus + +-- | Poll the bus for a message. Will block while waiting for messages +-- to come. You can specify the maximum amount of time to wait with +-- the @timeout@ parameter. If @timeout@ is negative, the function +-- will wait indefinitely. +-- +-- Messages not in @events@ will be popped off the bus and ignored. +-- +-- Because 'busPoll' is implemented using the 'busMessage' signal +-- enabled by 'busAddSignalWatch', calling 'busPoll' will cause the +-- 'busMessage' signal to be emitted for every message that the +-- function sees. Thus, a 'busMessage' signal handler will see every +-- message that 'busPoll' sees -- neither will steal messages from +-- the other. +-- +-- This function will run a main loop in the default main context +-- while polling. +busPoll :: BusClass busT + => busT -- ^ @bus@ - a 'Bus' + -> [MessageType] -- ^ @events@ - the set of messages to poll for + -> ClockTimeDiff -- ^ @timeout@ - the time to wait, or -1 to wait indefinitely + -> IO Message +busPoll bus events timeout = + {# call bus_poll #} (toBus bus) + (fromIntegral $ fromFlags events) + (fromIntegral timeout) >>= + takeMiniObject + +-- | A message has been posted on the bus. This signal is emitted from +-- a 'Source' added to the 'MainLoop', and only when it is running. +busMessage :: BusClass busT + => Signal busT (Message -> IO ()) +busMessage = + Signal $ connect_BOXED__NONE "message" peekMiniObject + +-- | A message has been posted on the bus. This signal is emitted from +-- the thread that posted the message so one has to be careful with +-- locking. +-- +-- This signal will not be emitted by default, you must first call +-- 'busUseSyncSignalHandler' if you want this signal to be emitted +-- when a message is posted on the bus. +busSyncMessage :: BusClass busT + => Signal busT (Message -> IO ()) +busSyncMessage = + Signal $ connect_BOXED__NONE "sync-message" peekMiniObject diff --git a/Media/Streaming/GStreamer/Core/Caps.chs b/Media/Streaming/GStreamer/Core/Caps.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Caps.chs @@ -0,0 +1,329 @@ +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} +-- 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 +-- . +-- +-- 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) +-- +-- A structure describing sets of media formats. +module Media.Streaming.GStreamer.Core.Caps ( + +-- * Detail + -- | 'Caps' (short for /capabilities/) are lightweight objects + -- describing media types. They are composed of arrays of + -- 'Structure's. + -- + -- 'Caps' are exposed on 'PadTemplate's to describe all the + -- possible types a given 'Pad' can handle. They are also stored + -- in the 'Registry' along with the description of an 'Element'. + -- + -- 'Caps' can be retrieved from an 'Element'\'s 'Pad's using the + -- 'padGetCaps' function. The returned 'Caps' describes the possible + -- types that the pad can handle or produce at runtime. + -- + -- 'Caps' are also attached to 'Buffers' to describe the type of + -- the contained data using the function 'bufferSetCaps'. 'Caps' + -- attached to a buffer allow for format negotiation upstream and + -- downstream. + -- + -- 'Caps' are /fixed/ when they have no properties with ranges or + -- lists. Use 'capsIsFixed' to test for fixed caps. Only fixed + -- caps may be set on a 'Pad' or 'Buffer'. + +-- * Types + Caps, + capsNone, + capsAny, + +-- * Caps Operations + capsSize, + capsGetStructure, + capsIsEmpty, + capsIsFixed, + capsIsEqual, + capsIsEqualFixed, + capsIsAlwaysCompatible, + capsIsSubset, + capsIntersect, + capsUnion, + capsSubtract, + capsNormalize, + capsFromString, + capsToString, + +-- * Caps Mutation + CapsM, + capsCreate, + capsModify, + capsAppendStructure, +#if GST_CHECK_VERSION(0,10,10) + capsMergeStructure, + capsRemoveStructure, +#endif + capsTruncate + + ) where + +{# context lib = "gstreamer" prefix = "gst" #} + +import Control.Monad (liftM) +import Control.Monad.Reader +import System.Glib.FFI +import System.Glib.UTFString +{#import Media.Streaming.GStreamer.Core.Types#} + +-- | A 'Caps' that represents an undefined media type. +capsNone :: Caps +capsNone = + unsafePerformIO $ {# call caps_new_empty #} >>= takeCaps + +-- | A 'Caps' that represents all possible media types. +capsAny :: Caps +capsAny = + unsafePerformIO $ {# call caps_new_any #} >>= takeCaps + +-- | Get the number of structures contained in the 'Caps'. +capsSize :: Caps -- ^ @caps@ - a 'Caps' + -> Word -- ^ the number of structures contained in the 'Caps' +capsSize caps = + fromIntegral $ unsafePerformIO $ {# call caps_get_size #} caps + +-- | Get the 'Structure' at the given index. +capsGetStructure :: Caps -- ^ @caps@ - a 'Caps' + -> Word -- ^ @index@ - the index of the 'Structure' + -> Maybe Structure -- ^ the 'Structure' at the given index, or 'Nothing' + -- if @index@ is invalid +capsGetStructure caps index = + unsafePerformIO $ + {# call caps_get_structure #} caps (fromIntegral index) >>= + maybePeek peekStructure + +-- | Create a new 'Caps' containing only the 'Structure' at the given +-- index of the caps. +capsCopyNth :: Caps -- ^ @caps@ - a 'Caps' + -> Word -- ^ @index@ - the index of the 'Structure' + -> Maybe Caps -- ^ the new 'Caps', or 'Nothing' + -- if @index@ is invalid +capsCopyNth caps index = + unsafePerformIO $ + {# call caps_copy_nth #} caps (fromIntegral index) >>= + maybePeek takeCaps + +-- | Determine whether @caps@ represents no media formats. +capsIsEmpty :: Caps -- ^ @caps@ - a 'Caps' + -> Bool -- ^ 'True' if @caps@ is empty, otherwise 'False' +capsIsEmpty caps = + toBool $ unsafePerformIO $ + {# call caps_is_empty #} caps + +-- | Determine whether the @caps@ is fixed; that is, if it has exactly +-- one structure, and each field in the structure describes a fixed type. +capsIsFixed :: Caps -- ^ @caps@ - a 'Caps' + -> Bool -- ^ 'True' if @caps@ is fixed, otherwise 'False' +capsIsFixed caps = + toBool $ unsafePerformIO $ + {# call caps_is_fixed #} caps + +-- | Returns 'True' if the caps represent the same set of capabilities. +-- +-- This function does not work reliably if optional properties for +-- 'Caps' are included on one 'Caps' but omitted on the other. +capsIsEqual :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Bool -- ^ 'True' if both 'Caps' represent the same set + -- of capabilities. +capsIsEqual caps1 caps2 = + toBool $ unsafePerformIO $ + {# call caps_is_equal #} caps1 caps2 + +instance Eq Caps where + (==) = capsIsEqual + +-- | Returns 'True' if the caps are equal. The caps must both be +-- fixed. +capsIsEqualFixed :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Bool -- ^ 'True' if both 'Caps' represent the same set + -- of capabilities +capsIsEqualFixed caps1 caps2 = + toBool $ unsafePerformIO $ + {# call caps_is_equal_fixed #} caps1 caps2 + +-- | Returns 'True' if every media format in the first caps is also +-- contained by the second. That is, the first is a subset of the +-- second. +capsIsAlwaysCompatible :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Bool -- ^ 'True' if @caps1@ is a subset of @caps2@, otherwise 'False' +capsIsAlwaysCompatible caps1 caps2 = + toBool $ unsafePerformIO $ + {# call caps_is_always_compatible #} caps1 caps2 + +-- | Returns 'True' if all caps represented by the first argument are +-- also represented by the second. +-- +-- This function does not work reliably if optional properties for +-- caps are included on one caps and omitted on the other. +capsIsSubset :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Bool -- ^ 'True' if @caps1@ is a subset of @caps2@, otherwise 'False' +capsIsSubset caps1 caps2 = + toBool $ unsafePerformIO $ + {# call caps_is_subset #} caps1 caps2 + +-- | Creates a new caps containing all the formats that are common to +-- both of the caps. +capsIntersect :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Caps -- ^ a new 'Caps' containing all capabilities present + -- in both @caps1@ and @caps2@ +capsIntersect caps1 caps2 = + unsafePerformIO $ + {# call caps_intersect #} caps1 caps2 >>= + takeCaps + +-- | Creates a new caps containing all the formats that are common to +-- either of the caps. If either of the structures are equivalient +-- to 'capsAny', the result will be 'capsAny'. +capsUnion :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Caps -- ^ a new 'Caps' containing all capabilities present + -- in either @caps1@ and @caps2@ +capsUnion caps1 caps2 = + unsafePerformIO $ + {# call caps_union #} caps1 caps2 >>= + takeCaps + +-- | Creates a new caps containing all the formats that are in the +-- first but not the second. +capsSubtract :: Caps -- ^ @caps1@ - the first 'Caps' + -> Caps -- ^ @caps2@ - the second 'Caps' + -> Caps -- ^ a new 'Caps' containing all capabilities present + -- in @caps1@ but not @caps2@ +capsSubtract caps1 caps2 = + unsafePerformIO $ + {# call caps_subtract #} caps1 caps2 >>= + takeCaps + +-- | Creates a new caps that represents the same set of formats as the +-- argument, but that contains no lists. +capsNormalize :: Caps -- ^ @caps@ - a 'Caps' + -> Caps -- ^ the new, normalized 'Caps' +capsNormalize caps = + unsafePerformIO $ + {# call caps_normalize #} caps >>= takeCaps + +-- | Converts the argument to a string representation. The string can +-- be converted back to a caps using 'capsFromString'. +capsToString :: Caps -- ^ @caps@ - a 'Caps' + -> String -- ^ the string representation of 'Caps' +capsToString caps = + unsafePerformIO $ + {# call caps_to_string #} caps >>= readUTFString + +-- | Read a caps from a string. +capsFromString :: String -- ^ @string@ - the string representation of a 'Caps' + -> Maybe Caps -- ^ the new 'Caps', or 'Nothing' if @string@ is invalid +capsFromString string = + unsafePerformIO $ + withUTFString string {# call caps_from_string #} >>= + maybePeek takeCaps + +-- | A 'Monad' for sequencing modifications to a 'Caps'. +newtype CapsM a = + CapsM (ReaderT (Ptr Caps) IO a) + deriving (Functor, Monad) + +askCapsPtr :: CapsM (Ptr Caps) +askCapsPtr = CapsM $ ask + +marshalCapsModify :: IO (Ptr Caps) + -> CapsM a + -> (Caps, a) +marshalCapsModify mkCaps (CapsM action) = + unsafePerformIO $ + do ptr <- mkCaps + result <- runReaderT action ptr + caps <- takeCaps ptr + return (caps, result) + +-- | Create a caps and mutate it according to the given action. +capsCreate :: CapsM a -- ^ @mutate@ - the mutating action + -> (Caps, a) -- ^ the new 'Caps' and the action's result +capsCreate mutate = + marshalCapsModify + {# call caps_new_empty #} + mutate + +-- | Copy a caps and mutate it according to the given action. +capsModify :: Caps -- ^ @caps@ - the 'Caps' to modify + -> CapsM a -- ^ @mutate@ - the mutating action + -> (Caps, a) -- ^ the new 'Caps' and the action's result +capsModify caps mutate = + marshalCapsModify ({# call caps_copy #} caps) mutate + +-- | Append the given structure to the current caps. +capsAppendStructure :: Structure -- ^ @structure@ - the 'Structure' to append to the current 'Caps' + -> CapsM () +capsAppendStructure structure = do + capsPtr <- askCapsPtr + CapsM $ liftIO $ withStructure structure $ \structurePtr -> + do structurePtr' <- gst_structure_copy structurePtr + gst_caps_append_structure capsPtr structurePtr + where _ = {# call caps_append_structure #} + _ = {# call structure_copy #} + +#if GST_CHECK_VERSION(0,10,10) +-- | Append the structure to the current caps, if it is not already +-- expressed by the caps. +-- +-- Since 0.10.10. +capsMergeStructure :: Structure -- ^ @structure@ - the 'Structure' to merge with the current 'Caps' + -> CapsM () +capsMergeStructure structure = do + capsPtr <- askCapsPtr + CapsM $ liftIO $ withStructure structure $ \structurePtr -> + do structurePtr' <- gst_structure_copy structurePtr + gst_caps_merge_structure capsPtr structurePtr + where _ = {# call caps_merge_structure #} + _ = {# call structure_copy #} + +-- | Removes the structure at the given index from the current caps. +capsRemoveStructure :: Word -- ^ @idx@ - the index of the 'Structure' to remove + -> CapsM () +capsRemoveStructure idx = do + capsPtr <- askCapsPtr + CapsM $ liftIO $ gst_caps_remove_structure capsPtr $ fromIntegral idx + where _ = {# call caps_remove_structure #} +#endif + +-- | Discard all but the first structure from the current caps. +capsTruncate :: CapsM () +capsTruncate = do + capsPtr <- askCapsPtr + CapsM $ liftIO $ gst_caps_truncate capsPtr + where _ = {# call caps_truncate #} diff --git a/Media/Streaming/GStreamer/Core/Clock.chs b/Media/Streaming/GStreamer/Core/Clock.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Clock.chs @@ -0,0 +1,440 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- Abstract class of global clocks. +module Media.Streaming.GStreamer.Core.Clock ( + +-- * Detail + -- | GStreamer uses a global clock to synchronize the plugins in a + -- pipeline. Different clock implementations are possible by + -- implementing this abstract base class. + -- + -- The 'Clock' returns a monotonically increasing time with the + -- method 'clockGetTime'. Its accuracy and base time depend + -- on the specific clock implementation but time is always + -- expressed in nanoseconds. Since the baseline of the clock is + -- undefined, the clock time returned is not meaningful in itself, + -- what matters are the deltas between two clock times. The time + -- returned by a clock is called the absolute time. + -- + -- The pipeline uses the clock to calculate the stream + -- time. Usually all renderers synchronize to the global clock + -- using the buffer timestamps, the newsegment events and the + -- element's base time, see GstPipeline. + -- + -- A clock implementation can support periodic and single shot + -- clock notifications both synchronous and asynchronous. + -- + -- One first needs to create a 'ClockID' for the periodic or + -- single shot notification using 'clockNewSingleShotID' or + -- 'clockNewPeriodicID'. + -- + -- To perform a blocking wait for the specific time of the + -- 'ClockID' use 'clockIDWait'. This calls can be interrupted with + -- the 'clockIDUnschedule' call. If the blocking wait is + -- unscheduled a return value of 'ClockUnscheduled' is returned. + -- + -- Periodic callbacks scheduled async will be repeadedly called + -- automatically until it is unscheduled. To schedule a sync + -- periodic callback, 'clockIDWait' should be called repeatedly. + -- + -- The async callbacks can happen from any thread, either provided + -- by the core or from a streaming thread. The application should + -- be prepared for this. + -- + -- A 'ClockID' that has been unscheduled cannot be used again for + -- any wait operation; a new 'ClockID' should be created. + -- + -- It is possible to perform a blocking wait on the same 'ClockID' + -- from multiple threads. However, registering the same 'ClockID' + -- for multiple async notifications is not possible, the callback + -- will only be called for the thread registering the entry last. + -- + -- These clock operations do not operate on the stream time, so + -- the callbacks will also occur when not in the playing state as + -- if the clock just keeps on running. Some clocks however do not + -- progress when the element that provided the clock is not + -- playing. + -- + -- When a clock has the 'ClockFlagCanSetMaster' flag set, it can + -- be slaved to another 'Clock' with 'clockSetMaster'. The clock + -- will then automatically be synchronized to this master clock by + -- repeatedly sampling the master clock and the slave clock and + -- recalibrating the slave clock with 'clockSetCalibration'. This + -- feature is mostly useful for plugins that have an internal + -- clock but must operate with another clock selected by the + -- GstPipeline. They can track the offset and rate difference of + -- their internal clock relative to the master clock by using the + -- 'clockGetCalibration' function. + -- + -- The master\/slave synchronisation can be tuned with the + -- the 'clockTimeout', 'clockWindowSize' and 'clockWindowThreshold' properties. + -- The 'clockTimeout' property defines the interval to + -- sample the master clock and run the calibration + -- functions. 'clockWindowSize' defines the number of samples to + -- use when calibrating and 'clockWindowThreshold' defines the + -- minimum number of samples before the calibration is performed. + +-- * Types + Clock, + ClockClass, + castToClock, + gTypeClock, + + -- | A time value measured in nanoseconds. + ClockTime, + + -- | The 'ClockTime' value representing an invalid time. + clockTimeNone, + clockTimeIsValid, + + -- | The 'ClockTime' value representing 1 second, i.e. 1e9. + second, + -- | The 'ClockTime' value representing 1 millisecond, i.e. 1e6. + msecond, + -- | The 'ClockTime' value representing 1 microsecond, i.e. 1e3. + usecond, + -- | The 'ClockTime' value representing 1 nanosecond, i.e. 1. + nsecond, + -- | A value holding the difference between two 'ClockTime's. + ClockTimeDiff, + -- | An opaque identifier for a timer event. + ClockID, + -- | An enumeration type returned by 'clockIDWait'. + ClockReturn(..), + -- | The flags a 'Clock' may have. + ClockFlags(..), + clockGetFlags, + clockSetFlags, + clockUnsetFlags, + +-- * Clock Operations + clockAddObservation, + clockSetMaster, + clockGetMaster, + clockSetResolution, + clockGetResolution, + clockGetTime, + clockNewSingleShotID, + clockNewPeriodicID, + clockGetInternalTime, + clockGetCalibration, + clockSetCalibration, + clockIDGetTime, + clockIDWait, + clockIDUnschedule, + +-- * Clock Properties + clockTimeout, + clockWindowSize, + clockWindowThreshold + + ) where + +import Data.Ratio ( Ratio + , (%) + , numerator + , denominator ) +import Control.Monad ( liftM + , liftM4) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +import System.Glib.Attributes ( Attr + , newAttr ) +import System.Glib.Properties + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Get the flags set on the clock. +clockGetFlags :: ClockClass clockT + => clockT -- ^ @clock@ + -> IO [ClockFlags] -- ^ the flags currently set on the clock +clockGetFlags = mkObjectGetFlags + +-- | Set the given flags on the clock. +clockSetFlags :: ClockClass clockT + => clockT -- ^ @clock@ + -> [ClockFlags] -- ^ @flags@ - the flags to be set + -> IO () +clockSetFlags = mkObjectSetFlags + +-- | Unset the given flags on the clock. +clockUnsetFlags :: ClockClass clockT + => clockT -- ^ @clock@ + -> [ClockFlags] -- ^ @flags@ - the flags to be unset + -> IO () +clockUnsetFlags = mkObjectUnsetFlags + +-- | Returns 'True' if the given 'ClockTime' is valid, and 'False' +-- otherwise. +clockTimeIsValid :: ClockTime -- ^ @clockTime@ + -> Bool -- ^ 'True' if @clockTime@ is valid, 'False' otherwise +clockTimeIsValid = (/= clockTimeNone) + +-- | The time master of the master clock and the time slave of the +-- slave clock are added to the list of observations. If enough +-- observations are available, a linear regression algorithm is run +-- on the observations and clock is recalibrated. +-- +-- If a calibration is performed, the correlation coefficient of the +-- interpolation will be returned. A value of 1.0 means the clocks +-- are in perfect sync. This value can be used to control the +-- sampling frequency of the master and slave clocks. +clockAddObservation :: ClockClass clock + => clock + -> ClockTime + -> ClockTime + -> IO (Maybe Double) +clockAddObservation clock slave master = + alloca $ \rSquaredPtr -> + do success <- {# call clock_add_observation #} (toClock clock) + (fromIntegral slave) + (fromIntegral master) + rSquaredPtr + if toBool success + then liftM (Just . realToFrac) $ peek rSquaredPtr + else return Nothing + +-- | Set @master@ as the master clock for @clock@. The @clock@ will +-- automatically be calibrated so that 'clockGetTime' reports the +-- same time as the @master@ clock. +-- +-- A clock provider that slaves its clock to a master can get the +-- current calibration values with 'clockGetCalibration'. +-- +-- The @master@ clock can be 'Nothing' in which case @clock@ will +-- not be slaved any longer. It will, however, continue to report +-- its time adjusted using the last configured rate and time +-- offsets. +-- +-- Note that if @clock@ does not have the 'ClockFlagCanSetMaster' +-- flag set, this function will not succeed and return 'False'. +clockSetMaster :: (ClockClass clock, ClockClass master) + => clock -- ^ @clock@ + -> Maybe master -- ^ @master@ + -> IO Bool -- ^ 'True' if @clock@ is capable of + -- being slaved to the @master@ clock, otherwise 'False' +clockSetMaster clock master = + withObject (toClock clock) $ \clockPtr -> + maybeWith withObject (liftM toClock $ master) $ \masterPtr -> + liftM toBool $ gst_clock_set_master clockPtr masterPtr + where + _ = {# call clock_set_master #} + +-- | Return the master that @clock@ is slaved to, or 'Nothing' if +-- @clock@ is not slaved. +clockGetMaster :: ClockClass clock + => clock -- ^ @clock@ + -> IO (Maybe Clock) -- ^ the master that @clock@ is slaved to, or 'Nothing' +clockGetMaster clock = + {# call clock_get_master #} (toClock clock) >>= maybePeek takeObject + +-- | Set the resolution of @clock@. Some clocks have the possibility +-- to operate with different resolution at the expense of more +-- resource usage. There is normally no need to change the default +-- resolution of a clock. The resolution of a clock can only be +-- changed if the clock has the 'ClockFlagCanSetResolution' flag +-- set. +clockSetResolution :: ClockClass clock + => clock + -> ClockTime + -> IO ClockTime +clockSetResolution clock resolution = + liftM fromIntegral $ + {# call clock_set_resolution #} (toClock clock) + (fromIntegral resolution) + +-- | Get the resolution of the @clock@. The resolution of the clock is +-- the granularity of the values returned by 'clockGetTime'. +clockGetResolution :: ClockClass clock + => clock -- ^ @clock@ - + -> IO ClockTime -- ^ the resolution currently set in @clock@ +clockGetResolution clock = + liftM fromIntegral $ + {# call clock_get_resolution #} (toClock clock) + +-- | Get the current time stored in @clock@. The time is always +-- monotonically increasing and adjusted according to the current +-- offset and rate. +clockGetTime :: ClockClass clock + => clock -- ^ @clock@ + -> IO ClockTime -- ^ the current time in @clock@ +clockGetTime clock = + liftM fromIntegral $ + {# call clock_get_time #} (toClock clock) + +-- | Get a 'ClockID' from @clock@ to trigger a single shot +-- notification at the requested time. +clockNewSingleShotID :: ClockClass clock + => clock -- ^ @clock@ + -> ClockTime -- ^ @clockTime@ + -> IO ClockID -- ^ a single shot notification id triggered at @clockTime@ +clockNewSingleShotID clock time = + {# call clock_new_single_shot_id #} (toClock clock) + (fromIntegral time) >>= + takeClockID . castPtr + +-- | Get a 'ClockID' from @clock@ to trigger periodic +-- notifications. The notifications will start at time @startTime@ +-- and then be fired at each @interval@ after. +clockNewPeriodicID :: ClockClass clock + => clock -- ^ @clock@ + -> ClockTime -- ^ @startTime@ + -> ClockTime -- ^ @interval@ + -> IO ClockID -- ^ a periodic notification id +clockNewPeriodicID clock startTime interval = + {# call clock_new_periodic_id #} (toClock clock) + (fromIntegral startTime) + (fromIntegral interval) >>= + takeClockID . castPtr + +-- | Gets the current internal time of @clock@. The time is +-- returned unadjusted in the offset and rate. +clockGetInternalTime :: ClockClass clock + => clock -- ^ @clock@ + -> IO ClockTime -- ^ the clock's internal time value +clockGetInternalTime clock = + liftM fromIntegral $ + {# call clock_get_internal_time #} (toClock clock) + +-- | Gets the internal rate and reference time of @clock@. See +-- 'clockSetCalibration' for more information. +clockGetCalibration :: ClockClass clock + => clock -- ^ @clock@ + -> IO (ClockTime, ClockTime, Ratio ClockTime) + -- ^ the clock's internal time, external (adjusted) time, and skew rate +clockGetCalibration clock = + alloca $ \internalPtr -> + alloca $ \externalPtr -> + alloca $ \rateNumPtr -> + alloca $ \rateDenomPtr -> + do {# call clock_get_calibration #} (toClock clock) + internalPtr + externalPtr + rateNumPtr + rateDenomPtr + liftM4 (\a b c d -> + (fromIntegral a, + fromIntegral b, + fromIntegral c % fromIntegral d)) + (peek internalPtr) + (peek externalPtr) + (peek rateNumPtr) + (peek rateDenomPtr) + +-- | Adjusts the rate and time of clock. A rate of @1 % 1@ is the +-- normal speed of the clock. Larger values make the clock go +-- faster. +-- +-- The parameters @internal@ and @external@ specifying that +-- 'clockGetTime' should have returned @external@ when the clock had +-- internal time @internal@. The parameter @internal@ should not be +-- in the future; that is, it should be less than the value returned +-- by 'clockGetInternalTime' when this function is called. +-- +-- Subsequent calls to 'clockGetTime' will return clock times +-- computed as follows: +-- +-- > (clock_internal - internal) * rate + external +-- +-- Note that 'clockGetTime' always returns increasing values, so if +-- the clock is moved backwards, 'clockGetTime' will report the +-- previous value until the clock catches up. +clockSetCalibration :: ClockClass clock + => clock -- ^ @clock@ + -> ClockTime -- ^ @internal@ + -> ClockTime -- ^ @external@ + -> Ratio ClockTime -- ^ @rate@ + -> IO () +clockSetCalibration clock internal external rate = + {# call clock_set_calibration #} (toClock clock) + (fromIntegral internal) + (fromIntegral external) + (fromIntegral $ numerator rate) + (fromIntegral $ denominator rate) + +-- | Get the time of @clockID@. +clockIDGetTime :: ClockID -- ^ @clockID@ + -> IO ClockTime +clockIDGetTime clockID = + liftM fromIntegral $ withClockID clockID $ + {# call clock_id_get_time #} . castPtr + +-- | Perform a blocking wait on @clockID@. The parameter @clockID@ +-- should have been created with 'clockNewSingleShotID' or +-- 'clockNewPeriodicID', and should not been unscheduled with a call +-- to 'clockIDUnschedule'. +-- +-- If second value in the returned pair is not 'Nothing', it will +-- contain the difference against the clock and the time of +-- @clockID@ when this method was called. Positive values indicate +-- how late @clockID@ was relative to the clock. Negative values +-- indicate how much time was spend waiting on the clock before the +-- function returned. +clockIDWait :: ClockID -- ^ @clockID@ + -> IO (ClockReturn, Maybe ClockTimeDiff) +clockIDWait clockID = + alloca $ \jitterPtr -> + do result <- liftM cToEnum $ withClockID clockID $ \clockIDPtr -> + {# call clock_id_wait #} (castPtr clockIDPtr) jitterPtr + jitter <- let peekJitter = liftM (Just . fromIntegral) $ peek jitterPtr + in case result of + ClockOk -> peekJitter + ClockEarly -> peekJitter + _ -> return Nothing + return (result, jitter) + +-- | Cancel an outstanding request with @clockID@. After this call, +-- @clockID@ cannot be used anymore to recieve notifications; you +-- must create a new 'ClockID'. +clockIDUnschedule :: ClockID -- ^ @clockID@ + -> IO () +clockIDUnschedule clockID = + withClockID clockID $ {# call clock_id_unschedule #} . castPtr + +-- | The amount of time, in nanoseconds, between samples. +clockTimeout :: ClockClass clockT + => Attr clockT ClockTime +clockTimeout = newAttr + (objectGetPropertyUInt64 "timeout") + (objectSetPropertyUInt64 "timeout") + +-- | The size of the window used to calculate rate and offset. +clockWindowSize :: ClockClass clockT + => Attr clockT Int +clockWindowSize = + newAttrFromIntProperty "window-size" + +-- | The threshold to start calculating rate and offset. +clockWindowThreshold :: ClockClass clockT + => Attr clockT Int +clockWindowThreshold = + newAttrFromIntProperty "window-threshold" diff --git a/Media/Streaming/GStreamer/Core/Constants.hsc b/Media/Streaming/GStreamer/Core/Constants.hsc new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Constants.hsc @@ -0,0 +1,395 @@ +{-# OPTIONS_HADDOCK hide #-} +-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*- + +#include "hsgstreamer.h" +#include "template-hsc-gtk2hs.h" + +-- +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Core.Constants where + +import Data.Int +import Data.Word +import System.Glib.Flags + +-- | A time value in nanoseconds. +type ClockTime = Word64 + +-- | The undefined 'ClockTime' value. +clockTimeNone :: ClockTime +clockTimeNone = #{const GST_CLOCK_TIME_NONE} + +second, msecond, usecond, nsecond :: ClockTime +-- | One second as a 'ClockTime' value. +second = #{const GST_SECOND} +-- | One millisecond as a 'ClockTime' value. +msecond = #{const GST_MSECOND} +-- | One microsecond as a 'ClockTime' value. +usecond = #{const GST_USECOND} +-- | One nanosecond as a 'ClockTime' value. +nsecond = #{const GST_NSECOND} + +-- | The type for buffer offsets. +type BufferOffset = Word64 +-- | The undefined 'BufferOffset' value. +bufferOffsetNone :: BufferOffset +bufferOffsetNone = #{const GST_BUFFER_OFFSET_NONE} + +-- | A format identifier. +newtype FormatId = FormatId #{gtk2hs_type GstFormat} + deriving (Eq, Ord, Show) + +-- | An enumeration of standard predefined formats. +data Format = FormatUndefined -- ^ no format + | FormatDefault -- ^ the default format of the pad or element; this can be, e.g., samples for raw audio + | FormatBytes -- ^ bytes + | FormatTime -- ^ time in nanoseconds + | FormatBuffers -- ^ buffers + | FormatPercent -- ^ percentage of stream + | FormatUser FormatId -- ^ a user defined format + deriving (Eq, Ord, Show) +toFormat :: #{gtk2hs_type GstFormat} -> Format +toFormat n | n == #{const GST_FORMAT_UNDEFINED} = FormatUndefined + | n == #{const GST_FORMAT_DEFAULT} = FormatDefault + | n == #{const GST_FORMAT_BYTES} = FormatBytes + | n == #{const GST_FORMAT_TIME} = FormatTime + | n == #{const GST_FORMAT_BUFFERS} = FormatBuffers + | n == #{const GST_FORMAT_PERCENT} = FormatPercent + | otherwise = FormatUser (FormatId n) +fromFormat :: Format -> #{gtk2hs_type GstFormat} +fromFormat FormatUndefined = #{const GST_FORMAT_UNDEFINED} +fromFormat FormatDefault = #{const GST_FORMAT_DEFAULT} +fromFormat FormatBytes = #{const GST_FORMAT_BYTES} +fromFormat FormatTime = #{const GST_FORMAT_TIME} +fromFormat FormatBuffers = #{const GST_FORMAT_BUFFERS} +fromFormat FormatPercent = #{const GST_FORMAT_PERCENT} +fromFormat (FormatUser (FormatId id)) = id + +-- | The format value for 'FormatPercent' is between 0 and this value. +formatPercentMax :: Int64 +formatPercentMax = #{const GST_FORMAT_PERCENT_MAX} + +-- | The value used to scale down the reported 'FormatPercent' format +-- value to its real value. +formatPercentScale :: Int64 +formatPercentScale = #{const GST_FORMAT_PERCENT_SCALE} + +-- | The flags that an 'Object' may have. +data ObjectFlags = ObjectDisposing -- ^ The object has been + -- destroyed, don't use it any + -- more. + deriving (Bounded, Show) +instance Enum ObjectFlags where + toEnum n | n == #{const GST_OBJECT_DISPOSING} = ObjectDisposing + fromEnum ObjectDisposing = #{const GST_OBJECT_DISPOSING} +instance Flags ObjectFlags + +-- | The flags that a 'Pad' may have. +data PadFlags = PadBlocked -- ^ dataflow on the pad is blocked + | PadFlushing -- ^ the pad is refusing buffers + | PadInGetCaps -- ^ 'padGetCaps' is executing + | PadInSetCaps -- ^ 'padSetCaps' is executing +#if GST_CHECK_VERSION(0,10,11) + | PadBlocking -- ^ the pad is blocking on a buffer or event +#endif + deriving (Eq, Bounded, Show) +instance Enum PadFlags where + toEnum n | n == #{const GST_PAD_BLOCKED} = PadBlocked + | n == #{const GST_PAD_FLUSHING} = PadFlushing + | n == #{const GST_PAD_IN_GETCAPS} = PadInGetCaps + | n == #{const GST_PAD_IN_SETCAPS} = PadInSetCaps +#if GST_CHECK_VERSION(0,10,11) + | n == #{const GST_PAD_BLOCKING} = PadBlocking +#endif + fromEnum PadBlocked = #{const GST_PAD_BLOCKED} + fromEnum PadFlushing = #{const GST_PAD_FLUSHING} + fromEnum PadInGetCaps = #{const GST_PAD_IN_GETCAPS} + fromEnum PadInSetCaps = #{const GST_PAD_IN_SETCAPS} +#if GST_CHECK_VERSION(0,10,11) + fromEnum PadBlocking = #{const GST_PAD_BLOCKING} +#endif +instance Flags PadFlags + +-- | The flags that an 'Element' may have. +data ElementFlags = ElementLockedState -- ^ parent state changes are ignored + | ElementIsSink -- ^ the element is a sink + | ElementUnparenting -- ^ child is being removed + -- from the parent bin + deriving (Eq, Bounded, Show) +instance Enum ElementFlags where + toEnum n | n == #{const GST_ELEMENT_LOCKED_STATE} = ElementLockedState + | n == #{const GST_ELEMENT_IS_SINK} = ElementIsSink + | n == #{const GST_ELEMENT_UNPARENTING} = ElementUnparenting + fromEnum ElementLockedState = #{const GST_ELEMENT_LOCKED_STATE} + fromEnum ElementIsSink = #{const GST_ELEMENT_IS_SINK} + fromEnum ElementUnparenting = #{const GST_ELEMENT_UNPARENTING} +instance Flags ElementFlags + +-- | The different state changes that are passed to the state change +-- functions of 'Element's. +data StateChange = StateChangeNullToReady -- ^ state change from 'StateNull' to 'StateReady' + | StateChangeReadyToPaused -- ^ state change from 'StateReady' to 'StatePaused' + | StateChangePausedToPlaying -- ^ state change from 'StatePaused' to 'StatePlaying' + | StateChangePlayingToPaused -- ^ state change from 'StatePlaying' to 'StatePaused' + | StateChangePausedToReady -- ^ state change from 'StatePaused' to 'StateReady' + | StateChangeReadyToNull -- ^ state change from 'StateReady' to 'StateNull' + deriving (Eq, Show) +instance Enum StateChange where + toEnum n | n == #{const GST_STATE_CHANGE_NULL_TO_READY} = StateChangeNullToReady + | n == #{const GST_STATE_CHANGE_READY_TO_PAUSED} = StateChangeReadyToPaused + | n == #{const GST_STATE_CHANGE_PAUSED_TO_PLAYING} = StateChangePausedToPlaying + | n == #{const GST_STATE_CHANGE_PLAYING_TO_PAUSED} = StateChangePlayingToPaused + | n == #{const GST_STATE_CHANGE_PAUSED_TO_READY} = StateChangePausedToReady + | n == #{const GST_STATE_CHANGE_READY_TO_NULL} = StateChangeReadyToNull + + fromEnum StateChangeNullToReady = #{const GST_STATE_CHANGE_NULL_TO_READY} + fromEnum StateChangeReadyToPaused = #{const GST_STATE_CHANGE_READY_TO_PAUSED} + fromEnum StateChangePausedToPlaying = #{const GST_STATE_CHANGE_PAUSED_TO_PLAYING} + fromEnum StateChangePlayingToPaused = #{const GST_STATE_CHANGE_PLAYING_TO_PAUSED} + fromEnum StateChangePausedToReady = #{const GST_STATE_CHANGE_PAUSED_TO_READY} + fromEnum StateChangeReadyToNull = #{const GST_STATE_CHANGE_READY_TO_NULL} + +-- | The flags that a 'Bus' may have. +data BusFlags = BusFlushing -- ^ the bus is currently dropping all messages + deriving (Eq, Bounded, Show) +instance Enum BusFlags where + toEnum n | n == #{const GST_BUS_FLUSHING} = BusFlushing + fromEnum BusFlushing = #{const GST_BUS_FLUSHING} +instance Flags BusFlags + +-- | The flags that a 'Clock' may have. +data ClockFlags = ClockCanDoSingleSync -- ^ the clock can do a single sync timeout request + | ClockCanDoSingleAsync -- ^ the clock can do a single async timeout request + | ClockCanDoPeriodicSync -- ^ the clock can do periodic sync timeout requests + | ClockCanDoPeriodicAsync -- ^ the clock can do periodic async timeout requests + | ClockCanSetResolution -- ^ the clock's resolution can be changed + | ClockCanSetMaster -- ^ the clock can be slaved to a master clock + deriving (Eq, Bounded, Show) +instance Enum ClockFlags where + toEnum n | n == #{const GST_CLOCK_FLAG_CAN_DO_SINGLE_SYNC} = ClockCanDoSingleSync + | n == #{const GST_CLOCK_FLAG_CAN_DO_SINGLE_ASYNC} = ClockCanDoSingleAsync + | n == #{const GST_CLOCK_FLAG_CAN_DO_PERIODIC_SYNC} = ClockCanDoPeriodicSync + | n == #{const GST_CLOCK_FLAG_CAN_DO_PERIODIC_ASYNC} = ClockCanDoPeriodicAsync + | n == #{const GST_CLOCK_FLAG_CAN_SET_RESOLUTION} = ClockCanSetResolution + | n == #{const GST_CLOCK_FLAG_CAN_SET_MASTER} = ClockCanSetMaster + + fromEnum ClockCanDoSingleSync = #{const GST_CLOCK_FLAG_CAN_DO_SINGLE_SYNC} + fromEnum ClockCanDoSingleAsync = #{const GST_CLOCK_FLAG_CAN_DO_SINGLE_ASYNC} + fromEnum ClockCanDoPeriodicSync = #{const GST_CLOCK_FLAG_CAN_DO_PERIODIC_SYNC} + fromEnum ClockCanDoPeriodicAsync = #{const GST_CLOCK_FLAG_CAN_DO_PERIODIC_ASYNC} + fromEnum ClockCanSetResolution = #{const GST_CLOCK_FLAG_CAN_SET_RESOLUTION} + fromEnum ClockCanSetMaster = #{const GST_CLOCK_FLAG_CAN_SET_MASTER} +instance Flags ClockFlags + +-- | The flags an 'Index' may have. +data IndexFlags = IndexWritable -- ^ the index is writable + | IndexReadable -- ^ the index is readable + deriving (Eq, Bounded, Show) +instance Enum IndexFlags where + toEnum n | n == #{const GST_INDEX_WRITABLE} = IndexWritable + | n == #{const GST_INDEX_READABLE} = IndexReadable + fromEnum IndexWritable = #{const GST_INDEX_WRITABLE} + fromEnum IndexReadable = #{const GST_INDEX_READABLE} +instance Flags IndexFlags + +-- | The flags a 'MiniObject' may have. +data MiniObjectFlags = MiniObjectReadOnly -- ^ the object is not writable + deriving (Eq, Bounded, Show) +instance Enum MiniObjectFlags where + toEnum n | n == #{const GST_MINI_OBJECT_FLAG_READONLY} = MiniObjectReadOnly + fromEnum MiniObjectReadOnly = #{const GST_MINI_OBJECT_FLAG_READONLY} +instance Flags MiniObjectFlags + +-- | The flags a 'Buffer' may have. +data BufferFlags = BufferPreroll -- ^ the buffer is part of a preroll and should not be displayed + | BufferDiscont -- ^ the buffer marks a discontinuity in the stream + | BufferInCaps -- ^ the buffer has been added as a field in a 'Caps' + | BufferGap -- ^ the buffer has been created to fill a gap in the stream + | BufferDeltaUnit -- ^ the buffer cannot be decoded independently + deriving (Eq, Bounded, Show) +instance Enum BufferFlags where + toEnum n | n == #{const GST_BUFFER_FLAG_PREROLL} = BufferPreroll + | n == #{const GST_BUFFER_FLAG_DISCONT} = BufferDiscont + | n == #{const GST_BUFFER_FLAG_IN_CAPS} = BufferInCaps + | n == #{const GST_BUFFER_FLAG_GAP} = BufferGap + | n == #{const GST_BUFFER_FLAG_DELTA_UNIT} = BufferDeltaUnit + fromEnum BufferPreroll = #{const GST_BUFFER_FLAG_PREROLL} + fromEnum BufferDiscont = #{const GST_BUFFER_FLAG_DISCONT} + fromEnum BufferInCaps = #{const GST_BUFFER_FLAG_IN_CAPS} + fromEnum BufferGap = #{const GST_BUFFER_FLAG_GAP} + fromEnum BufferDeltaUnit = #{const GST_BUFFER_FLAG_DELTA_UNIT} +instance Flags BufferFlags + +-- | The event types that may occur in a pipeline. +data EventType = EventUnknown -- ^ an unknown event + | EventFlushStart -- ^ start a flush operation + | EventFlushStop -- ^ stop a flush operation + | EventEOS -- ^ end of stream + | EventNewSegment -- ^ a new segment follows in the dataflow + | EventTag -- ^ a new set of metadata tags has been found + | EventBufferSize -- ^ notification of buffering requirements + | EventQOS -- ^ quality of service notification + | EventSeek -- ^ a request for a new playback position and rate + | EventNavigation -- ^ notification of user request +#if GST_CHECK_VERSION(0, 10, 12) + | EventLatency -- ^ notification of latency adjustment +#endif + | EventCustomUpstream -- ^ custom upstream event + | EventCustomDownstream -- ^ custom downstream event + | EventCustomDownstreamOOB -- ^ custom downstream out-of-band event + | EventCustomBoth -- ^ custom bidirectional event + | EventCustomBothOOB -- ^ custom bidirectional out-of-band event + deriving (Eq, Bounded, Show) +instance Enum EventType where + toEnum n | n == #{const GST_EVENT_UNKNOWN} = EventUnknown + | n == #{const GST_EVENT_FLUSH_START} = EventFlushStart + | n == #{const GST_EVENT_FLUSH_STOP} = EventFlushStop + | n == #{const GST_EVENT_EOS} = EventEOS + | n == #{const GST_EVENT_NEWSEGMENT} = EventNewSegment + | n == #{const GST_EVENT_TAG} = EventTag + | n == #{const GST_EVENT_BUFFERSIZE} = EventBufferSize + | n == #{const GST_EVENT_QOS} = EventQOS + | n == #{const GST_EVENT_SEEK} = EventSeek + | n == #{const GST_EVENT_NAVIGATION} = EventNavigation +#if GST_CHECK_VERSION(0, 10, 12) + | n == #{const GST_EVENT_LATENCY} = EventLatency +#endif + | n == #{const GST_EVENT_CUSTOM_UPSTREAM} = EventCustomUpstream + | n == #{const GST_EVENT_CUSTOM_DOWNSTREAM} = EventCustomDownstream + | n == #{const GST_EVENT_CUSTOM_DOWNSTREAM_OOB} = EventCustomDownstreamOOB + | n == #{const GST_EVENT_CUSTOM_BOTH} = EventCustomBoth + | n == #{const GST_EVENT_CUSTOM_BOTH_OOB} = EventCustomBothOOB + + fromEnum EventUnknown = #{const GST_EVENT_UNKNOWN} + fromEnum EventFlushStart = #{const GST_EVENT_FLUSH_START} + fromEnum EventFlushStop = #{const GST_EVENT_FLUSH_STOP} + fromEnum EventEOS = #{const GST_EVENT_EOS} + fromEnum EventNewSegment = #{const GST_EVENT_NEWSEGMENT} + fromEnum EventTag = #{const GST_EVENT_TAG} + fromEnum EventBufferSize = #{const GST_EVENT_BUFFERSIZE} + fromEnum EventQOS = #{const GST_EVENT_QOS} + fromEnum EventSeek = #{const GST_EVENT_SEEK} + fromEnum EventNavigation = #{const GST_EVENT_NAVIGATION} +#if GST_CHECK_VERSION(0, 10, 12) + fromEnum EventLatency = #{const GST_EVENT_LATENCY} +#endif + fromEnum EventCustomUpstream = #{const GST_EVENT_CUSTOM_UPSTREAM} + fromEnum EventCustomDownstream = #{const GST_EVENT_CUSTOM_DOWNSTREAM} + fromEnum EventCustomDownstreamOOB = #{const GST_EVENT_CUSTOM_DOWNSTREAM_OOB} + fromEnum EventCustomBoth = #{const GST_EVENT_CUSTOM_BOTH} + fromEnum EventCustomBothOOB = #{const GST_EVENT_CUSTOM_BOTH_OOB} + +-- | The messages types that may be sent by a pipeline. +data MessageType = MessageEOS -- ^ end-of-stream + | MessageError -- ^ an error message + | MessageWarning -- ^ a warning message + | MessageInfo -- ^ an informational message + | MessageTag -- ^ a metadata tag + | MessageBuffering -- ^ the pipeline is buffering + | MessageStateChanged -- ^ the pipeline changed state + | MessageStepDone -- ^ a framestep finished + | MessageClockProvide -- ^ an element is able to provide a clock + | MessageClockLost -- ^ the current clock has become unusable + | MessageNewClock -- ^ a new clock was selected by the pipeline + | MessageStructureChange -- ^ the structure of the pipeline has changed + | MessageStreamStatus -- ^ a stream status message + | MessageApplication -- ^ a message posted by the application + | MessageElement -- ^ an element specific message + | MessageSegmentStart -- ^ the pipeline started playback of a segment + | MessageSegmentDone -- ^ the pipeline finished playback of a segment + | MessageDuration -- ^ the duration of the pipeline changed +#if GST_CHECK_VERSION(0, 10, 12) + | MessageLatency -- ^ an element's latency has changed +#endif +#if GST_CHECK_VERSION(0, 10, 13) + | MessageAsyncStart -- ^ an element has started an async state change; used internally + | MessageAsyncDone -- ^ an element has completed an async state change; used internally +#endif + deriving (Eq, Bounded, Show) +instance Enum MessageType where + toEnum n | n == #{const GST_MESSAGE_EOS} = MessageEOS + | n == #{const GST_MESSAGE_ERROR} = MessageError + | n == #{const GST_MESSAGE_WARNING} = MessageWarning + | n == #{const GST_MESSAGE_INFO} = MessageInfo + | n == #{const GST_MESSAGE_TAG} = MessageTag + | n == #{const GST_MESSAGE_BUFFERING} = MessageBuffering + | n == #{const GST_MESSAGE_STATE_CHANGED} = MessageStateChanged + | n == #{const GST_MESSAGE_STEP_DONE} = MessageStepDone + | n == #{const GST_MESSAGE_CLOCK_PROVIDE} = MessageClockProvide + | n == #{const GST_MESSAGE_CLOCK_LOST} = MessageClockLost + | n == #{const GST_MESSAGE_NEW_CLOCK} = MessageNewClock + | n == #{const GST_MESSAGE_STRUCTURE_CHANGE} = MessageStructureChange + | n == #{const GST_MESSAGE_STREAM_STATUS} = MessageStreamStatus + | n == #{const GST_MESSAGE_APPLICATION} = MessageApplication + | n == #{const GST_MESSAGE_ELEMENT} = MessageElement + | n == #{const GST_MESSAGE_SEGMENT_START} = MessageSegmentStart + | n == #{const GST_MESSAGE_SEGMENT_DONE} = MessageSegmentDone + | n == #{const GST_MESSAGE_DURATION} = MessageDuration +#if GST_CHECK_VERSION(0, 10, 12) + | n == #{const GST_MESSAGE_LATENCY} = MessageLatency +#endif +#if GST_CHECK_VERSION(0, 10, 13) + | n == #{const GST_MESSAGE_ASYNC_START} = MessageAsyncStart + | n == #{const GST_MESSAGE_ASYNC_DONE} = MessageAsyncDone +#endif + fromEnum MessageEOS = #{const GST_MESSAGE_EOS} + fromEnum MessageError = #{const GST_MESSAGE_ERROR} + fromEnum MessageWarning = #{const GST_MESSAGE_WARNING} + fromEnum MessageInfo = #{const GST_MESSAGE_INFO} + fromEnum MessageTag = #{const GST_MESSAGE_TAG} + fromEnum MessageBuffering = #{const GST_MESSAGE_BUFFERING} + fromEnum MessageStateChanged = #{const GST_MESSAGE_STATE_CHANGED} + fromEnum MessageStepDone = #{const GST_MESSAGE_STEP_DONE} + fromEnum MessageClockProvide = #{const GST_MESSAGE_CLOCK_PROVIDE} + fromEnum MessageClockLost = #{const GST_MESSAGE_CLOCK_LOST} + fromEnum MessageNewClock = #{const GST_MESSAGE_NEW_CLOCK} + fromEnum MessageStructureChange = #{const GST_MESSAGE_STRUCTURE_CHANGE} + fromEnum MessageStreamStatus = #{const GST_MESSAGE_STREAM_STATUS} + fromEnum MessageApplication = #{const GST_MESSAGE_APPLICATION} + fromEnum MessageElement = #{const GST_MESSAGE_ELEMENT} + fromEnum MessageSegmentStart = #{const GST_MESSAGE_SEGMENT_START} + fromEnum MessageSegmentDone = #{const GST_MESSAGE_SEGMENT_DONE} + fromEnum MessageDuration = #{const GST_MESSAGE_DURATION} +#if GST_CHECK_VERSION(0, 10, 12) + fromEnum MessageLatency = #{const GST_MESSAGE_LATENCY} +#endif +#if GST_CHECK_VERSION(0, 10, 13) + fromEnum MessageAsyncStart = #{const GST_MESSAGE_ASYNC_START} + fromEnum MessageAsyncDone = #{const GST_MESSAGE_ASYNC_DONE} +#endif +instance Flags MessageType + +-- | The flags that a 'Caps' may have. +data CapsFlags = CapsAny + deriving (Eq, Bounded, Show) +instance Enum CapsFlags where + toEnum n | n == #{const GST_CAPS_FLAGS_ANY} = CapsAny + fromEnum CapsAny = #{const GST_CAPS_FLAGS_ANY} +instance Flags CapsFlags diff --git a/Media/Streaming/GStreamer/Core/Element.chs b/Media/Streaming/GStreamer/Core/Element.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Element.chs @@ -0,0 +1,780 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- Abstract class of pipeline elements. +module Media.Streaming.GStreamer.Core.Element ( + +-- * Detail + + -- | 'Element' is the abstract base class needed to construct an + -- element that can be used in a GStreamer pipeline. + -- + -- All elements have pads (of the type 'Pad'). These pads link to + -- pads on other elements. 'Buffer's flow between these linked + -- pads. An 'Element' has a 'Pad' for each input (or sink) and + -- output (or source). + -- + -- An element's pad can be retrieved by name with + -- 'elementGetStaticPad' or 'elementGetRequestPad'. An 'Iterator' + -- over all an element's pads can be retrieved with + -- 'elementIteratePads'. + -- + -- Elements can be linked through their pads. If the link is + -- straightforward, use the 'elementLink' convenience function to + -- link two elements. Use 'elementLinkFiltered' to link two + -- elements constrained by a specified set of 'Caps'. For finer + -- control, use 'elementLinkPads' and 'elementLinkPadsFiltered' to + -- specify the pads to link on each element by name. + -- + -- Each element has a 'State'. You can get and set the state of an + -- element with 'elementGetState' and 'elementSetState'. To get a + -- string representation of a 'State', use 'elementStateGetName'. + -- + -- You can get and set a 'Clock' on an element using + -- 'elementGetClock' and 'elementSetClock'. Some elements can + -- provide a clock for the pipeline if 'elementProvidesClock' + -- returns 'True'. With the 'elementProvideClock' method one can + -- retrieve the clock provided by such an element. Not all + -- elements require a clock to operate correctly. If + -- 'elementRequiresClock' returns 'True', a clock should be set on + -- the element with 'elementSetClock'. + -- + -- Note that clock slection and distribution is normally handled + -- by the toplevel 'Pipeline' so the clock functions should only + -- be used in very specific situations. + +-- * Types + Element, + ElementClass, + castToElement, + gTypeElement, + + ElementFlags(..), + State(..), + StateChange(..), + StateChangeReturn(..), + +-- * Element Operations + elementAddPad, + elementGetCompatiblePad, + elementGetCompatiblePadTemplate, + elementGetRequestPad, + elementGetStaticPad, + elementReleaseRequestPad, + elementRemovePad, + elementIteratePads, + elementIterateSinkPads, + elementIterateSrcPads, + elementLink, + elementUnlink, + elementLinkPads, + elementUnlinkPads, + elementLinkPadsFiltered, + elementLinkFiltered, + elementSetBaseTime, + elementGetBaseTime, + elementSetBus, + elementGetBus, + elementGetFactory, + elementSetIndex, + elementIsIndexable, + elementRequiresClock, + elementSetClock, + elementGetClock, + elementProvidesClock, + elementProvideClock, + elementSetState, + elementGetState, + elementSetLockedState, + elementIsLockedState, + elementAbortState, + elementStateGetName, +#if GST_CHECK_VERSION(0,10,11) + elementStateChangeReturnGetName, +#endif + elementSyncStateWithParent, + elementGetQueryTypes, + elementQuery, + elementQueryConvert, + elementQueryPosition, + elementQueryDuration, + elementSendEvent, +#if GST_CHECK_VERSION(0,10,7) + elementSeekSimple, +#endif + elementSeek, + elementNoMorePads, + elementPadAdded, + elementPadRemoved, + + ) where + +import Control.Monad ( liftM ) +import Data.Maybe ( fromMaybe ) +import System.Glib.FFI +import System.Glib.Flags +import System.Glib.UTFString ( withUTFString + , peekUTFString ) +{#import System.Glib.Signals#} +{#import System.Glib.GObject#} +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Get the flags set on the element. +elementGetFlags :: ElementClass elementT + => elementT -- ^ @element@ - an element + -> IO [ElementFlags] +elementGetFlags = mkObjectGetFlags + +-- | Set the given flags on the element. +elementSetFlags :: ElementClass elementT + => elementT + -> [ElementFlags] + -> IO () +elementSetFlags = mkObjectSetFlags + +-- | Unset the given flags on the element. +elementUnsetFlags :: ElementClass elementT + => elementT + -> [ElementFlags] + -> IO () +elementUnsetFlags = mkObjectUnsetFlags + +-- | Add a pad (link point) to an element. The pad's parent will be set to +-- @element@. +-- +-- Pads are not automatically activated so elements should perform +-- the needed steps to activate the pad in case this pad is added in +-- the 'StatePaused' or 'StatePlaying' state. See 'padSetActive' for +-- more information about activating pads. +-- +-- This function will emit the 'elementPadAdded' signal on the +-- element. +elementAddPad :: (ElementClass elementT, PadClass padT) + => elementT -- ^ @element@ - an element + -> padT -- ^ @pad@ - + -> IO Bool +elementAddPad element pad = + liftM toBool $ {# call element_add_pad #} (toElement element) (toPad pad) + +-- | Look for an unlinked pad to which the @pad@ can link. It is not +-- guaranteed that linking the pads will work, though it should work in most +-- cases. +elementGetCompatiblePad :: (ElementClass elementT, PadClass padT) + => elementT -- ^ @element@ - an element + -> padT -- ^ @pad@ - a pad + -> Caps -- ^ @caps@ - the 'Caps' to + -- use as a filter + -> IO (Maybe Pad) -- ^ a 'Pad' that is compatible with @pad@, or + -- 'Nothing' if none was found +elementGetCompatiblePad element pad caps = + {# call element_get_compatible_pad #} (toElement element) (toPad pad) caps >>= + maybePeek takeObject + +-- | Retrieve a pad template from @element@ that is compatible with +-- @padTemplate@. Pads from compatible templates can be linked +-- together. +elementGetCompatiblePadTemplate :: (ElementClass elementT, PadTemplateClass padTemplateT) + => elementT -- ^ @element@ - an element + -> padTemplateT -- ^ @padTemplate@ - a pad template + -> IO (Maybe PadTemplate) -- ^ the compatible 'PadTemplate', + -- or 'Nothing' if none was found +elementGetCompatiblePadTemplate element padTemplate = + {# call element_get_compatible_pad_template #} (toElement element) (toPadTemplate padTemplate) >>= + maybePeek takeObject + +-- | Retrieve a pad from the element by name. This version only +-- retrieves request pads. The pad should be released with +-- 'elementReleaseRequestPad'. +elementGetRequestPad :: ElementClass elementT + => elementT -- ^ @element@ - an element + -> String -- ^ @name@ - + -> IO (Maybe Pad) -- ^ the requested 'Pad' if + -- found, otherwise 'Nothing'. +elementGetRequestPad element name = + (withUTFString name $ {# call element_get_request_pad #} (toElement element)) >>= + maybePeek peekObject + +-- | Retreive a pad from @element@ by name. This version only +-- retrieves already-existing (i.e. "static") pads. +elementGetStaticPad :: ElementClass elementT + => elementT -- ^ @element@ - an element + -> String -- ^ @name@ - + -> IO (Maybe Pad) -- ^ the requested 'Pad' if + -- found, otherwise 'Nothing'. +elementGetStaticPad element name = + (withUTFString name $ {# call element_get_static_pad #} (toElement element)) >>= + maybePeek takeObject + +-- | Release a request pad that was previously obtained with +-- 'elementGetRequestPad'. +elementReleaseRequestPad :: (ElementClass elementT, PadClass padT) + => elementT -- ^ @element@ - + -> padT -- ^ @pad@ - + -> IO () +elementReleaseRequestPad element pad = + {# call element_release_request_pad #} (toElement element) (toPad pad) + +-- | Remove @pad@ from @element@. +-- +-- This function is used by plugin developers and should not be used +-- by applications. Pads that were dynamically requested from +-- elements with 'elementGetRequestPad' should be released with the +-- 'elementReleaseRequestPad' function instead. +-- +-- Pads are not automatically deactivated so elements should perform the needed +-- steps to deactivate the pad in case this pad is removed in the PAUSED or +-- PLAYING state. See 'padSetActive' for more information about +-- deactivating pads. +-- +-- The pad and the element should be unlocked when calling this function. +-- +-- This function will emit the 'padRemoved' signal on the element. +-- +-- Returns: 'True' if the pad could be removed. Can return 'False' if the +-- pad does not belong to the provided element. +elementRemovePad :: (ElementClass elementT, PadClass padT) + => elementT -- ^ @element@ - + -> padT -- ^ @pad@ - + -> IO Bool -- ^ 'True' if the pad was succcessfully + -- removed, otherwise 'False' +elementRemovePad element pad = + liftM toBool $ {# call element_remove_pad #} (toElement element) (toPad pad) + +-- | Retrieve an 'Iterator' over @element@'s pads. +elementIteratePads :: (ElementClass elementT) + => elementT -- ^ @element@ - + -> IO (Iterator Pad) -- ^ an iterator over the element's pads. +elementIteratePads element = + {# call element_iterate_pads #} (toElement element) >>= takeIterator + + +-- | Retrieve an 'Iterator' over @element@'s sink pads. +elementIterateSinkPads :: (ElementClass elementT) + => elementT + -> IO (Iterator Pad) +elementIterateSinkPads element = + {# call element_iterate_sink_pads #} (toElement element) >>= takeIterator + +-- | Retrieve an 'Iterator' over @element@'s src pads. +elementIterateSrcPads :: (ElementClass elementT) + => elementT + -> IO (Iterator Pad) +elementIterateSrcPads element = + {# call element_iterate_sink_pads #} (toElement element) >>= takeIterator + +-- | Link @src@ to @sink@. The link must be from source to +-- sink; the other direction will not be tried. The function +-- looks for existing pads that aren't linked yet. It will request +-- new pads if necessary. Such pads must be released manually (with +-- 'elementReleaseRequestPad') when unlinking. If multiple links are +-- possible, only one is established. +-- +-- Make sure you have added your elements to a 'Bin' or 'Pipeline' +-- with 'binAdd' before trying to link them. +elementLink :: (ElementClass srcT, ElementClass sinkT) + => srcT -- ^ @src@ - + -> sinkT -- ^ @sink@ - + -> IO Bool -- ^ 'True' if the pads could be linked, + -- otherwise 'False' +elementLink src sink = + liftM toBool $ {# call element_link #} (toElement src) (toElement sink) + +-- | Unlink all source pads of the @src@ from all sink pads of the +-- @sink@. +elementUnlink :: (ElementClass srcT, ElementClass sinkT) + => srcT + -> sinkT + -> IO () +elementUnlink src sink = + {# call element_unlink #} (toElement src) (toElement sink) + +-- | Link the named pads of @src@ and @sink@. +elementLinkPads :: (ElementClass srcT, ElementClass sinkT) + => srcT -- ^ @src@ - the element containing the source pad + -> Maybe String -- ^ @srcPadName@ - the name of the source pad, or 'Nothing' for any pad + -> sinkT -- ^ @sink@ - the element containing the sink pad + -> Maybe String -- ^ @sinkPadName@ - the name of the sink pad, or 'Nothing' for any pad + -> IO Bool -- ^ 'True' if the pads could be linked, otherwise 'False' +elementLinkPads src srcPadName sink sinkPadName = + maybeWith withUTFString sinkPadName $ \cSinkPadName -> + maybeWith withUTFString srcPadName $ \cSrcPadName -> + liftM toBool $ {# call element_link_pads #} (toElement src) cSrcPadName (toElement sink) cSinkPadName + +-- | Unlink the named pads of @src@ and @sink@. +elementUnlinkPads :: (ElementClass srcT, ElementClass sinkT) + => srcT -- ^ @src@ - + -> String -- ^ @srcPadName@ - + -> sinkT -- ^ @sink@ - + -> String -- ^ @sinkPadName@ - + -> IO () +elementUnlinkPads src srcPadName sink sinkPadName = + withUTFString sinkPadName $ \cSinkPadName -> + withUTFString srcPadName $ \cSrcPadName -> + {# call element_unlink_pads #} (toElement src) cSrcPadName (toElement sink) cSinkPadName + +-- | Link the named pads of @src@ and @sink@. A side effect is that if +-- one of the pads has no parent, it becomes a child of the parent +-- of the other element. If they have different parents, the link +-- will fail. If @caps@ is not 'Nothing', make sure that the 'Caps' +-- of the link is a subset of @caps@. +elementLinkPadsFiltered :: (ElementClass srcT, ElementClass sinkT) + => srcT -- ^ @src@ - + -> Maybe String -- ^ @srcPadName@ - + -> sinkT -- ^ @sink@ - + -> Maybe String -- ^ @sinkPadName@ - + -> Caps -- ^ @caps@ - + -> IO Bool -- ^ 'True' if the pads could be + -- linked, otherwise 'False' +elementLinkPadsFiltered src srcPadName sink sinkPadName filter = + maybeWith withUTFString sinkPadName $ \cSinkPadName -> + maybeWith withUTFString srcPadName $ \cSrcPadName -> + liftM toBool $ {# call element_link_pads_filtered #} (toElement src) cSrcPadName (toElement sink) cSinkPadName filter + +-- | Link @src@ to @dest@ using the given 'Caps' as a filter. The link +-- must be from source to sink; the other direction will not be +-- tried. The function looks for existing pads that aren't linked +-- yet. If will request new pads if necessary. If multiple links are +-- possible, only one is established. +-- +-- Make sure you have added your elements to a 'Bin' or 'Pipeline' +-- with 'binAdd' before trying to link them. +elementLinkFiltered :: (ElementClass srcT, ElementClass sinkT) + => srcT -- ^ @src@ - + -> sinkT -- ^ @sink@ - + -> Maybe Caps -- ^ @caps@ - + -> IO Bool -- ^ 'True' if the pads could be + -- linked, otherwise 'False' +elementLinkFiltered src sink filter = + liftM toBool $ + {# call element_link_filtered #} (toElement src) (toElement sink) $ + fromMaybe (Caps nullForeignPtr) filter + +-- | Set the base time of @element@. See 'elementGetBaseTime' for more +-- information. +elementSetBaseTime :: ElementClass elementT + => elementT -- ^ @element@ - + -> ClockTimeDiff -- ^ @time@ - + -> IO () +elementSetBaseTime element time = + {# call element_set_base_time #} (toElement element) $ fromIntegral time + +-- | Return the base time of @element@. The base time is the absolute +-- time of the clock when this element was last set to +-- 'StatePlaying'. Subtract the base time from the clock time to get +-- the stream time of the element. +elementGetBaseTime :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO ClockTimeDiff -- ^ the base time of the element +elementGetBaseTime element = + liftM fromIntegral $ {# call element_get_base_time #} (toElement element) + +-- | Set the 'Bus' used by @element@. For internal use only, unless +-- you're testing elements. +elementSetBus :: (ElementClass elementT, BusClass busT) + => elementT -- ^ @element@ - + -> busT -- ^ @bus@ - + -> IO () +elementSetBus element bus = + {# call element_set_bus #} (toElement element) (toBus bus) + +-- | Get the bus of @element@. Not that only a 'Pipeline' will +-- provide a bus for the application. +elementGetBus :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bus -- ^ the bus used by the element +elementGetBus element = + {# call element_get_bus #} (toElement element) >>= takeObject + +-- | Get the factory used to create @element@. +elementGetFactory :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO ElementFactory -- ^ the factory that created @element@ +elementGetFactory element = + {# call element_get_factory #} (toElement element) >>= peekObject + +-- | Set the 'Index' used by @element@. +elementSetIndex :: (ElementClass elementT, IndexClass indexT) + => elementT -- ^ @element@ - + -> indexT -- ^ @index@ - + -> IO () +elementSetIndex element index = + {# call element_set_index #} (toElement element) (toIndex index) + +-- | Get the 'Index' used by @element@. +elementGetIndex :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO (Maybe Index) -- ^ the index, or 'Nothing' if @element@ has none +elementGetIndex element = + {# call element_get_index #} (toElement element) >>= maybePeek takeObject + +-- | Determine whether @element@ can be indexed. +elementIsIndexable :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bool -- ^ 'True' if the element can be indexed +elementIsIndexable element = + liftM toBool $ {# call element_is_indexable #} (toElement element) + +-- | Determine whether @element@ requires a clock. +elementRequiresClock :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bool -- ^ 'True' if the element requires a clock +elementRequiresClock element = + liftM toBool $ {# call element_requires_clock #} (toElement element) + +-- | Set the 'Clock' used by @element@. +elementSetClock :: (ElementClass elementT, ClockClass clockT) + => elementT -- ^ @element@ - + -> clockT -- ^ @clock@ - + -> IO Bool -- ^ 'True' if the element accepted the clock +elementSetClock element clock = + liftM toBool $ {# call element_set_clock #} (toElement element) (toClock clock) + +-- | Get the 'Clock' used by @element@. +elementGetClock :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO (Maybe Clock) -- ^ the clock, or 'Nothing' if @element@ has none +elementGetClock element = + {# call element_get_clock #} (toElement element) >>= maybePeek takeObject + +-- | Determine whether @element@ provides a clock. A 'Clock' provided +-- by an element can be used as the global clock for a pipeline. An +-- element that can provide a clock is only required to do so in the +-- 'StatePaused' state, meaning that it is fully negotiated and has +-- allocated the resources needed to operate the clock. +elementProvidesClock :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bool -- ^ 'True' if the element provides a clock +elementProvidesClock element = + liftM toBool $ {# call element_provides_clock #} $ toElement element + +-- | Get the 'Clock' provided by @element@. +-- +-- Note that an element is only required to provide a clock in the +-- 'StatePaused' state. Some elements can provide a clock in other +-- states. +elementProvideClock :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO (Maybe Clock) -- ^ a 'Clock', or 'Nothing' if + -- none could be provided +elementProvideClock element = + {# call element_provide_clock #} (toElement element) >>= maybePeek takeObject + +-- | Set the state of @element@ to @state@. This function will try to +-- set the requested state by going through all the intermediary +-- states and calling the class's state change function for each. +-- +-- This function can return 'StateChangeAsync', in which case the +-- element will perform the remainder of the state change +-- asynchronously in another thread. An application can use +-- 'elementGetState' to wait for the completion of the state change +-- or it can wait for a state change message on the bus. +elementSetState :: ElementClass elementT + => elementT -- ^ @element@ - + -> State -- ^ @state@ - + -> IO StateChangeReturn -- ^ the result of the state change +elementSetState element state = + liftM (toEnum . fromIntegral) $ {# call element_set_state #} (toElement element) $ + fromIntegral $ fromEnum state + +-- | Get the state of @element@. +-- +-- For elements that performed an asynchronous state change, as +-- reported by 'elementSetState', this function will block up to the +-- specified timeout value for the state change to complete. If the +-- element completes the state change or goes into an error, this +-- function returns immediately with a return value of +-- 'StateChangeSuccess' or 'StateChangeFailure', respectively. +-- +-- This function returns 'StateChangeNoPreroll' if the element +-- successfully changed its state but is not able to provide data +-- yet. This mostly happens for live sources that not only produce +-- data in the 'StatePlaying' state. While the state change return +-- is equivalent to 'StateChangeSuccess', it is returned to the +-- application to signal that some sink elements might not be able +-- to somplete their state change because an element is not +-- producing data to complete the preroll. When setting the element +-- to playing, the preroll will complete and playback will start. +elementGetState :: ElementClass elementT + => elementT -- ^ @element@ - + -> ClockTime -- ^ @timeout@ - + -> IO (StateChangeReturn, Maybe State, Maybe State) + -- ^ the result of the state change, the current + -- state, and the pending state +elementGetState element timeout = + alloca $ \statePtr -> + alloca $ \pendingPtr -> + do poke statePtr (-1) -- -1 is not use by any enum value + poke pendingPtr (-1) + result <- {# call element_get_state #} (toElement element) + statePtr + pendingPtr + (fromIntegral timeout) + state <- unmarshalState statePtr + pending <- unmarshalState pendingPtr + return (toEnum $ fromIntegral result, state, pending) + where unmarshalState statePtr = do + cState <- peek statePtr + if cState /= -1 + then return $ Just $ toEnum $ fromIntegral cState + else return Nothing + +-- | Lock the state of @element@, so state changes in the parent don't +-- affect this element any longer. +elementSetLockedState :: ElementClass elementT + => elementT -- ^ @element@ - + -> Bool -- ^ @lockedState@ - 'True' for locked, 'False' for unlocked + -> IO Bool -- ^ 'True' if the state was changed, 'False' if bad + -- parameters were given or no change was needed +elementSetLockedState element lockedState = + liftM toBool $ {# call element_set_locked_state #} (toElement element) $ fromBool lockedState + +-- | Determine whether @element@'s state is locked. +elementIsLockedState :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bool -- ^ 'True' if @element@'s state is locked, 'False' otherwise +elementIsLockedState element = + liftM toBool $ {# call element_is_locked_state #} $ toElement element + +-- | Abort @element@'s state change. This function is used by elements +-- that do asynchronous state changes and find out something is wrong. +-- +-- This function should be called with the state lock held. +elementAbortState :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO () +elementAbortState element = + {# call element_abort_state #} $ toElement element + +-- | Get a string representation of @state@. +elementStateGetName :: State -- ^ @state@ - + -> String -- ^ the name of @state@ +elementStateGetName state = + unsafePerformIO $ ({# call element_state_get_name #} $ fromIntegral $ fromEnum state) >>= peekUTFString + +#if GST_CHECK_VERSION(0,10,11) +-- | Get a string representation of @stateRet@. +-- +-- Since 0.10.11. +elementStateChangeReturnGetName :: StateChangeReturn -- ^ @stateRet@ - + -> String -- ^ the name of @stateRet@ +elementStateChangeReturnGetName stateRet = + unsafePerformIO $ ({# call element_state_change_return_get_name #} $ fromIntegral $ fromEnum stateRet) >>= peekUTFString +#endif + +-- | Try to change the state of @element@ to the same as its +-- parent. If this function returns 'False', the state of the +-- element is undefined. +elementSyncStateWithParent :: ElementClass elementT + => elementT -- ^ @element@ - + -> IO Bool -- ^ 'True' if the element's state could be + -- synced with its parent's state +elementSyncStateWithParent element = + liftM toBool $ {# call element_sync_state_with_parent #} $ toElement element + +elementGetQueryTypes :: ElementClass element + => element + -> IO [QueryType] +elementGetQueryTypes element = + liftM (map (toEnum . fromIntegral)) $ + {# call element_get_query_types #} (toElement element) >>= + peekArray0 0 + +-- | Perform a query on the given element. +-- +-- For elements that don't implement a query handler, this function +-- forwards the query to a random srcpad or to the peer of a random +-- linked sinkpad of this element. +elementQuery :: (ElementClass element, QueryClass query) + => element -- ^ @element@ - + -> query -- ^ @query@ - + -> IO Bool -- ^ 'True' if the query could be performed +elementQuery element query = + do query' <- {# call mini_object_copy #} (toMiniObject query) >>= + newForeignPtr_ . castPtr + fmap toBool $ {# call element_query #} (toElement element) $ Query query' + +-- | Query an element for the convertion of a value from one format to +-- another. +elementQueryConvert :: ElementClass element + => element -- ^ @element@ - the element to query + -> Format -- ^ @srcFormat@ - the format to convert from + -> Int64 -- ^ @srcVal@ - the value to convert + -> Format -- ^ @destFormat@ - the format to convert to + -> IO (Maybe (Format, Word64)) -- ^ the resulting format and value +elementQueryConvert element srcFormat srcVal destFormat = + alloca $ \destFormatPtr -> + alloca $ \destValPtr -> + do poke destFormatPtr $ fromIntegral $ fromFormat destFormat + success <- {# call element_query_convert #} (toElement element) + (fromIntegral $ fromFormat srcFormat) + (fromIntegral srcVal) + destFormatPtr + destValPtr + if toBool success + then do destFormat <- peek destFormatPtr + destVal <- peek destValPtr + return $ Just (toFormat $ fromIntegral destFormat, + fromIntegral destVal) + else return Nothing + +-- | Query an element for its stream position. +elementQueryPosition :: ElementClass element + => element -- ^ @element@ - the element to query + -> Format -- ^ @format@ - the format requested + -> IO (Maybe (Format, Word64)) -- ^ the resulting format and value +elementQueryPosition element format = + alloca $ \formatPtr -> + alloca $ \curPtr -> + do poke formatPtr $ fromIntegral $ fromFormat format + success <- {# call element_query_position #} (toElement element) formatPtr curPtr + if toBool success + then do format <- peek formatPtr + cur <- peek curPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral cur) + else return Nothing + +-- | Query an element for its stream duration. +elementQueryDuration :: ElementClass element + => element -- ^ @element@ - the element to query + -> Format -- ^ @format@ - the format requested + -> IO (Maybe (Format, Word64)) -- ^ the resulting format and value +elementQueryDuration element format = + alloca $ \formatPtr -> + alloca $ \durationPtr -> + do poke formatPtr $ fromIntegral $ fromFormat format + success <- {# call element_query_duration #} (toElement element) formatPtr durationPtr + if toBool success + then do format <- peek formatPtr + duration <- peek durationPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral duration) + else return Nothing + +-- | Send an event to an element. +-- +-- If the element doesn't implement an event handler, the event will +-- be pushed to a random linked sink pad for upstream events or a +-- random linked source pad for downstream events. +elementSendEvent :: (ElementClass element, EventClass event) + => element -- ^ @element@ - the element to send the event to + -> event -- ^ @event@ - the event to send + -> IO Bool -- ^ 'True' if the event was handled +elementSendEvent element event = + liftM toBool $ + giveMiniObject (toEvent event) $ {# call element_send_event #} (toElement element) + +#if GST_CHECK_VERSION(0,10,7) +-- | Perform a seek on the given element. This function only supports +-- seeking to a position relative to the start of the stream. For +-- more complex operations like segment seeks (such as for looping), +-- or changing the playback rate, or seeking relative to the last +-- configured playback segment you should use 'elementSeek'. +-- +-- In a completely prerolled pipeline in the 'StatePaused' or +-- 'StatePlaying' states, seeking is always guaranteed to return +-- 'True' on a seekable media type, or 'False' when the media type +-- is certainly not seekable (such as a live stream). +-- +-- Some elements allow for seeking in the 'StateReady' state, in +-- which case they will store the seek event and execute it when +-- they are put into the 'StatePaused' state. If the element +-- supports seek in "StateReady", it will always return 'True' when +-- it recieves the event in the 'StateReady' state. +elementSeekSimple :: ElementClass element + => element -- ^ @element@ - the element to seek on + -> Format -- ^ @format@ - the 'Format' to evecute the seek in, + -- such as 'FormatTime' + -> [SeekFlags] -- ^ @seekFlags@ - seek options; playback applications + -- will usually want to use + -- @['SeekFlagFlush','SeekFlagKeyUnit']@ + -> Int64 -- ^ @seekPos@ - the position to seek to, relative to + -- start; if you are doing a seek in + -- 'FormatTime' this value is in nanoseconds; + -- see 'second', 'msecond', 'usecond', & + -- 'nsecond' + -> IO Bool -- ^ 'True' if the seek operation succeeded +elementSeekSimple element format seekFlags seekPos = + liftM toBool $ + {# call element_seek_simple #} (toElement element) + (fromIntegral $ fromFormat format) + (fromIntegral $ fromFlags seekFlags) + (fromIntegral seekPos) +#endif + +-- | Send a seek event to an element. See +-- 'Media.Streaming.GStreamer.Core.Event.eventNewSeek' for the +-- details of the parameters. The seek event is sent to the element +-- using 'elementSendEvent'. +elementSeek :: ElementClass element + => element -- ^ @element@ - the element to seek on + -> Double -- ^ @rate@ - the new playback rate + -> Format -- ^ @format@ - the format of the seek values + -> [SeekFlags] -- ^ @seekFlags@ - the options to use + -> SeekType -- ^ @curType@ - type and flags for the new current position + -> Int64 -- ^ @cur@ - the value of the new current position + -> SeekType -- ^ @stopType@ - type and flags for the new stop position + -> Int64 -- ^ @stop@ - the value of the new stop position + -> IO Bool -- ^ 'True' if the event was handled +elementSeek element rate format flags curType cur stopType stop = + liftM toBool $ + {# call element_seek #} (toElement element) + (realToFrac rate) + (fromIntegral $ fromFormat format) + (fromIntegral $ fromFlags flags) + (fromIntegral $ fromEnum curType) + (fromIntegral cur) + (fromIntegral $ fromEnum stopType) + (fromIntegral stop) + +-- | The signal emitted when an element will not generate more dynamic +-- pads. +elementNoMorePads :: (ElementClass element) + => Signal element (IO ()) +elementNoMorePads = + Signal $ connect_NONE__NONE "no-more-pads" + +-- | The signal emitted when a new 'Pad' has been added to the +-- element. +elementPadAdded :: (ElementClass element) + => Signal element (Pad -> IO ()) +elementPadAdded = + Signal $ connect_OBJECT__NONE "pad-added" + +-- | The signal emitted when a 'Pad' has been removed from the +-- element. +elementPadRemoved :: (ElementClass element) + => Signal element (Pad -> IO ()) +elementPadRemoved = + Signal $ connect_OBJECT__NONE "pad-removed" diff --git a/Media/Streaming/GStreamer/Core/ElementFactory.chs b/Media/Streaming/GStreamer/Core/ElementFactory.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/ElementFactory.chs @@ -0,0 +1,224 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- A factory for creating 'Element's. +module Media.Streaming.GStreamer.Core.ElementFactory ( + +-- * Detail + + -- | 'ElementFactory' is used to create instances of 'Element's. + -- + -- Use 'elementFactoryFind' and 'elementFactoryCreate' to create + -- element instances, or use 'elementFactoryMake' as a convenient + -- shortcut. + +-- * Types + ElementFactory, + ElementFactoryClass, + castToElementFactory, + gTypeElementFactory, + +-- * ElementFactory Operations + elementFactoryFind, + elementFactoryGetElementType, + elementFactoryGetLongname, + elementFactoryGetKlass, + elementFactoryGetDescription, + elementFactoryGetAuthor, + elementFactoryGetNumPadTemplates, + elementFactoryGetURIType, + elementFactoryGetURIProtocols, +#if GST_CHECK_VERSION(0,10,14) + elementFactoryHasInterface, +#endif + elementFactoryCreate, + elementFactoryMake, + elementFactoryCanSinkCaps, + elementFactoryCanSrcCaps, + elementFactoryGetPadTemplates + + ) where + +import Control.Monad ( liftM ) +import Data.Maybe ( fromMaybe ) +import System.Glib.FFI +import System.Glib.UTFString ( withUTFString + , peekUTFString + , peekUTFStringArray0 ) +import System.Glib.GType ( GType ) +import System.Glib.GList ( readGList ) +{# import Media.Streaming.GStreamer.Core.Types #} + +{# context lib = "gstreamer" prefix = "gst" #} + +-- | Search for an element factory with the given name. +elementFactoryFind :: String -- ^ @name@ - the name of the desired factory + -> IO (Maybe ElementFactory) -- ^ the factory if found, otherwise 'Nothing' +elementFactoryFind name = + withUTFString name {# call element_factory_find #} >>= maybePeek takeObject + +-- | Get the 'GType' for elements managed by the given factory. The type +-- can only be retrieved if the element factory is loaded, which can +-- be assured with +-- 'Media.Streaming.GStreamer.Core.PluginFeature.pluginFeatureLoad'. +elementFactoryGetElementType :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO (Maybe GType) -- ^ the type of elements managed + -- by the factory, or 'Nothing' if + -- the factory is not loaded +elementFactoryGetElementType factory = + do gtype <- {# call element_factory_get_element_type #} (toElementFactory factory) + if gtype == 0 + then return $ Just $ fromIntegral gtype + else return Nothing + +-- | Get the long name for the given factory. +elementFactoryGetLongname :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO String -- ^ the factory's long name +elementFactoryGetLongname factory = + {# call element_factory_get_longname #} (toElementFactory factory) >>= + peekUTFString + +-- | Get the class for the given factory. +elementFactoryGetKlass :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO String -- ^ the factory's class +elementFactoryGetKlass factory = + {# call element_factory_get_klass #} (toElementFactory factory) >>= + peekUTFString + +-- | Get the description for the given factory. +elementFactoryGetDescription :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO String -- ^ the factory's description +elementFactoryGetDescription factory = + {# call element_factory_get_description #} (toElementFactory factory) >>= + peekUTFString + +-- | Get the author of the given factory. +elementFactoryGetAuthor :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO String -- ^ the factory's author +elementFactoryGetAuthor factory = + {# call element_factory_get_author #} (toElementFactory factory) >>= + peekUTFString + +-- | Get the number of 'PadTemplate's provided by the given factory. +elementFactoryGetNumPadTemplates :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO Word -- ^ the number of 'PadTemplate's +elementFactoryGetNumPadTemplates factory = + liftM fromIntegral $ + {# call element_factory_get_num_pad_templates #} $ toElementFactory factory + +-- | Get the type of URIs supported by the given factory. +elementFactoryGetURIType :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO Int -- ^ the type of URIs supported by the factory +elementFactoryGetURIType factory = + liftM fromIntegral $ + {# call element_factory_get_uri_type #} $ toElementFactory factory + +-- | Get the list of protocols supported by the given factory. +elementFactoryGetURIProtocols :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO [String] -- ^ the supported protocols +elementFactoryGetURIProtocols factory = + {# call element_factory_get_uri_protocols #} (toElementFactory factory) >>= + liftM (fromMaybe []) . maybePeek peekUTFStringArray0 + +#if GST_CHECK_VERSION(0,10,14) +-- | Check if the given factory implements the interface with the given name. +-- +-- Since 0.10.14. +elementFactoryHasInterface :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> String -- ^ @name@ - the interface name + -> IO Bool -- ^ true if the interface is implemented +elementFactoryHasInterface factory name = + liftM toBool . + withUTFString name . + {# call element_factory_has_interface #} . + toElementFactory $ + factory +#endif + +-- | Create a new element of the type supplied by the given +-- factory. It will be given the name supplied. +elementFactoryCreate :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> String -- ^ @name@ - the new element's name + -> IO (Maybe Element) -- ^ the new element if it could be created, + -- otherwise 'Nothing' +elementFactoryCreate factory name = + withUTFString name $ \cName -> + {# call element_factory_create #} (toElementFactory factory) cName >>= + maybePeek takeObject + +-- | Create a new element of the type supplied by the named +-- factory. +elementFactoryMake :: String -- ^ @factoryName@ - the name of an element factory + -> Maybe String -- ^ @name@ - the new element's name, or + -- 'Nothing' generate a unique name + -> IO (Maybe Element) -- ^ the new element if it could be created, + -- otherwise 'Nothing' +elementFactoryMake factoryName name = + withUTFString factoryName $ \cFactoryName -> + maybeWith withUTFString name $ \cName -> + {# call element_factory_make #} cFactoryName cName >>= + maybePeek takeObject + +-- | Check if the given factory can sink the given capabilities. +elementFactoryCanSinkCaps :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> Caps -- ^ @caps@ - the capabilities to check for + -> IO Bool -- ^ 'True' if @factory@ can sink the given capabilities +elementFactoryCanSinkCaps factory caps = + liftM toBool $ {# call element_factory_can_sink_caps #} (toElementFactory factory) caps + +-- | Check if the given factory can source the given capabilities. +elementFactoryCanSrcCaps :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> Caps -- ^ @caps@ - the capabilities to check for + -> IO Bool -- ^ 'True' if @factory@ can source the given capabilities +elementFactoryCanSrcCaps factory caps = + liftM toBool $ {# call element_factory_can_src_caps #} (toElementFactory factory) caps + +-- | Get the pad templates provided by the given factory. +elementFactoryGetPadTemplates :: (ElementFactoryClass elementFactory) + => elementFactory -- ^ @factory@ - an element factory + -> IO [PadTemplate] -- ^ the provided pad templates +elementFactoryGetPadTemplates = + {# call element_factory_get_static_pad_templates #} . toElementFactory >=> + readGList >=> mapM staticPadTemplateGet + where infixr 8 >=> + a >=> b = \x -> a x >>= b diff --git a/Media/Streaming/GStreamer/Core/Event.chs b/Media/Streaming/GStreamer/Core/Event.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Event.chs @@ -0,0 +1,338 @@ +{-# 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 +-- . +-- +-- 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) +-- +-- An object describing events that are passed up and down a pipeline. +module Media.Streaming.GStreamer.Core.Event ( + +-- * Detail + + -- | An 'Event' is a message that is passed up and down a pipeline. + -- + -- There are a number of predefined events and functions returning + -- events. To send an event an application will usually use + -- 'Media.Streaming.GStreamer.Core.Element.elementSendEvent', and + -- elements will use + -- 'Media.Streaming.GStreamer.Core.Pad.padSendEvent' or + -- 'Media.Streaming.GStreamer.Core.padPushEvent'. + -- + -- + +-- * Types + Event, + EventClass, + EventType(..), + SeekFlags(..), + SeekType(..), + +-- * Event Operations + eventType, + eventNewCustom, + eventNewEOS, + eventNewFlushStart, + eventNewFlushStop, +#if GST_CHECK_VERSION(0,10,12) + eventNewLatency, +#endif + eventNewNavigation, + eventNewNewSegment, + eventNewNewSegmentFull, + eventNewQOS, + eventNewSeek, + eventNewTag, + eventParseBufferSize, +#if GST_CHECK_VERSION(0,10,12) + eventParseLatency, +#endif + eventParseNewSegment, + eventParseNewSegmentFull, + eventParseQOS, + eventParseSeek, + eventParseTag, + eventTypeGetName, + eventTypeGetFlags, + ) 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" #} + +eventType :: EventClass event + => event + -> EventType +eventType event = + cToEnum $ unsafePerformIO $ withMiniObject (toEvent event) cEventType +foreign import ccall unsafe "_hs_gst_event_type" + cEventType :: Ptr Event + -> IO {# type GstEventType #} + +eventNewCustom :: EventType + -> Structure + -> IO Event +eventNewCustom eventType structure = + {# call event_new_custom #} (cFromEnum eventType) + structure >>= + takeMiniObject + +eventNewEOS, eventNewFlushStart, eventNewFlushStop :: IO Event +eventNewEOS = {# call event_new_eos #} >>= takeMiniObject +eventNewFlushStart = {# call event_new_flush_start #} >>= takeMiniObject +eventNewFlushStop = {# call event_new_flush_stop #} >>= takeMiniObject + +#if GST_CHECK_VERSION(0,10,12) +eventNewLatency :: ClockTime + -> IO Event +eventNewLatency latency = + {# call event_new_latency #} (fromIntegral latency) >>= + takeMiniObject +#endif + +eventNewNavigation :: Structure + -> IO Event +eventNewNavigation structure = + {# call event_new_navigation #} structure >>= + takeMiniObject + +eventNewNewSegment :: Bool + -> Double + -> Format + -> Int64 + -> Int64 + -> Int64 + -> IO Event +eventNewNewSegment update rate format start stop position = + {# call event_new_new_segment #} (fromBool update) + (realToFrac rate) + (fromIntegral $ fromFormat format) + (fromIntegral start) + (fromIntegral stop) + (fromIntegral position) >>= + takeMiniObject + +eventNewNewSegmentFull :: Bool + -> Double + -> Double + -> Format + -> Int64 + -> Int64 + -> Int64 + -> IO Event +eventNewNewSegmentFull update appliedRate rate format start stop position = + {# call event_new_new_segment_full #} (fromBool update) + (realToFrac rate) + (realToFrac appliedRate) + (fromIntegral $ fromFormat format) + (fromIntegral start) + (fromIntegral stop) + (fromIntegral position) >>= + takeMiniObject + +eventNewQOS :: Double + -> ClockTimeDiff + -> ClockTime + -> IO Event +eventNewQOS proportion diff timestamp = + {# call event_new_qos #} (realToFrac proportion) + (fromIntegral diff) + (fromIntegral timestamp) >>= + takeMiniObject + +eventNewSeek :: Double + -> Format + -> [SeekFlags] + -> SeekType + -> Int64 + -> SeekType + -> Int64 + -> IO Event +eventNewSeek rate format flags startType start stopType stop = + {# call event_new_seek #} (realToFrac rate) + (fromIntegral $ fromFormat format) + (cFromFlags flags) + (cFromEnum startType) + (fromIntegral start) + (cFromEnum stopType) + (fromIntegral stop) >>= + takeMiniObject + +eventNewTag :: TagList + -> IO Event +eventNewTag tagList = + withTagList tagList ({# call event_new_tag #} . castPtr) >>= + takeMiniObject + +eventParseBufferSize :: EventClass event + => event + -> Maybe (Format, Int64, Int64, Bool) +eventParseBufferSize event | eventType event == EventBufferSize = + Just $ unsafePerformIO $ alloca $ \formatPtr -> alloca $ \minSizePtr -> + alloca $ \maxSizePtr -> alloca $ \asyncPtr -> + do {# call event_parse_buffer_size #} (toEvent event) + formatPtr + minSizePtr + maxSizePtr + asyncPtr + format <- liftM (toFormat . fromIntegral) $ peek formatPtr + minSize <- liftM fromIntegral $ peek minSizePtr + maxSize <- liftM fromIntegral $ peek maxSizePtr + async <- liftM toBool $ peek asyncPtr + return (format, minSize, maxSize, async) + | otherwise = Nothing + +#if GST_CHECK_VERSION(0,10,12) +eventParseLatency :: EventClass event + => event + -> Maybe ClockTime +eventParseLatency event | eventType event == EventLatency = + Just $ unsafePerformIO $ alloca $ \latencyPtr -> + do {# call event_parse_latency #} (toEvent event) + latencyPtr + liftM fromIntegral $ peek latencyPtr + | otherwise = Nothing +#endif + +eventParseNewSegment :: EventClass event + => event + -> Maybe (Bool, Double, Format, Int64, Int64, Int64) +eventParseNewSegment event | eventType event == EventNewSegment = + Just $ unsafePerformIO $ alloca $ \updatePtr -> + alloca $ \ratePtr -> alloca $ \formatPtr -> + alloca $ \startPtr -> alloca $ \stopPtr -> + alloca $ \positionPtr -> + do {# call event_parse_new_segment #} (toEvent event) + ratePtr + updatePtr + formatPtr + startPtr + stopPtr + positionPtr + update <- liftM toBool $ peek updatePtr + rate <- liftM realToFrac $ peek ratePtr + format <- liftM (toFormat . fromIntegral) $ peek formatPtr + start <- liftM fromIntegral $ peek startPtr + stop <- liftM fromIntegral $ peek stopPtr + position <- liftM fromIntegral $ peek positionPtr + return (update, rate, format, start, stop, position) + | otherwise = Nothing + +eventParseNewSegmentFull :: EventClass event + => event + -> Maybe (Bool, Double, Double, Format, Int64, Int64, Int64) +eventParseNewSegmentFull event | eventType event == EventNewSegment = + Just $ unsafePerformIO $ alloca $ \updatePtr -> + alloca $ \ratePtr -> alloca $ \appliedRatePtr -> + alloca $ \formatPtr -> alloca $ \startPtr -> + alloca $ \stopPtr -> alloca $ \positionPtr -> + do {# call event_parse_new_segment_full #} (toEvent event) + ratePtr + appliedRatePtr + updatePtr + formatPtr + startPtr + stopPtr + positionPtr + update <- liftM toBool $ peek updatePtr + rate <- liftM realToFrac $ peek ratePtr + appliedRate <- liftM realToFrac $ peek appliedRatePtr + format <- liftM (toFormat . fromIntegral) $ peek formatPtr + start <- liftM fromIntegral $ peek startPtr + stop <- liftM fromIntegral $ peek stopPtr + position <- liftM fromIntegral $ peek positionPtr + return (update, rate, appliedRate, format, start, stop, position) + | otherwise = Nothing + +eventParseQOS :: EventClass event + => event + -> Maybe (Double, ClockTimeDiff, ClockTime) +eventParseQOS event | eventType event == EventQOS = + Just $ unsafePerformIO $ alloca $ \proportionPtr -> + alloca $ \diffPtr -> alloca $ \timestampPtr -> + do {# call event_parse_qos #} (toEvent event) + proportionPtr + diffPtr + timestampPtr + proportion <- liftM realToFrac $ peek proportionPtr + diff <- liftM fromIntegral $ peek diffPtr + timestamp <- liftM fromIntegral $ peek timestampPtr + return (proportion, diff, timestamp) + | otherwise = Nothing + +eventParseSeek :: EventClass event + => event + -> Maybe (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64) +eventParseSeek event | eventType event == EventSeek = + Just $ unsafePerformIO $ alloca $ \ratePtr -> + alloca $ \formatPtr -> alloca $ \flagsPtr -> + alloca $ \startTypePtr -> alloca $ \startPtr -> + alloca $ \stopTypePtr -> alloca $ \stopPtr -> + do {# call event_parse_seek #} (toEvent event) + ratePtr + formatPtr + flagsPtr + startTypePtr + startPtr + stopTypePtr + stopPtr + rate <- liftM realToFrac $ peek ratePtr + format <- liftM (toFormat . fromIntegral) $ peek formatPtr + flags <- liftM cToFlags $ peek flagsPtr + startType <- liftM cToEnum $ peek startTypePtr + start <- liftM fromIntegral $ peek startPtr + stopType <- liftM cToEnum $ peek stopTypePtr + stop <- liftM fromIntegral $ peek stopPtr + return (rate, format, flags, startType, start, stopType, stop) + | otherwise = Nothing + +eventParseTag :: EventClass event + => event + -> Maybe TagList +eventParseTag event | eventType event == EventTag = + Just $ unsafePerformIO $ alloca $ \tagListPtr -> + do {# call event_parse_tag #} (toEvent event) (castPtr tagListPtr) + peek tagListPtr >>= peekTagList + | otherwise = Nothing + +eventTypeGetName :: EventType + -> String +eventTypeGetName eventType = + unsafePerformIO $ + {# call event_type_get_name #} (cFromEnum eventType) >>= + peekUTFString + +eventTypeGetFlags :: EventType + -> [EventTypeFlags] +eventTypeGetFlags = + cToFlags . {# call fun event_type_get_flags #} . cFromEnum diff --git a/Media/Streaming/GStreamer/Core/Format.chs b/Media/Streaming/GStreamer/Core/Format.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Format.chs @@ -0,0 +1,101 @@ +-- 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 +-- . +-- +-- 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.Format ( + + -- * Types + Format(..), + FormatDefinition(..), + FormatId, + + -- * Format Operations + formatPercentMax, + formatPercentScale, + formatGetName, + formatToQuark, + formatRegister, + formatGetByNick, + formatGetDetails, + formatIterateDefinitions + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} + +{# context lib = "gstreamer" prefix = "gst" #} + +import Control.Monad (liftM) +import System.Glib.FFI +import System.Glib.UTFString +{#import System.Glib.GObject#} + +-- | Get a printable name for the given format. +formatGetName :: Format -- ^ @format@ - a format + -> IO String -- ^ the name of the format +formatGetName format = + peekUTFString $ + ({# call fun format_get_name #} $ + fromIntegral $ fromFormat format) + +-- | Get the unique quark for the given format. +formatToQuark :: Format -- ^ @format@ - a format + -> IO Quark -- ^ the unique quark for the format +formatToQuark = + {# call format_to_quark #} . fromIntegral . fromFormat + +-- | Create a new format based on the given nickname, or register a new format with that nickname. +formatRegister :: String -- ^ @nick@ - the nickname for the format + -> String -- ^ @description@ - the description for the format + -> IO Format -- ^ the format with the given nickname +formatRegister nick description = + liftM (toFormat . fromIntegral) $ + withUTFString nick $ \cNick -> + (withUTFString description $ + {# call format_register #} cNick) + +-- | Get the format with the given nickname, or 'FormatUndefined' if +-- no format by that nickname was found. +formatGetByNick :: String -- ^ @nick@ - the nickname for the format + -> IO Format -- ^ the format with the given nickname, + -- or 'FormatUndefined' if it was not found +formatGetByNick nick = + liftM (toFormat . fromIntegral) $ + withUTFString nick {# call format_get_by_nick #} + +-- | Get the given format's definition. +formatGetDetails :: Format -- ^ @format@ - a format + -> IO (Maybe FormatDefinition) -- ^ the definition for the given format, or + -- 'Nothing' if the format was not found +formatGetDetails format = + ({# call format_get_details #} $ fromIntegral $ fromFormat format) >>= + maybePeek peek . castPtr + +-- | Get an Iterator over all registered formats. +formatIterateDefinitions :: IO (Iterator FormatDefinition) +formatIterateDefinitions = + {# call format_iterate_definitions #} >>= takeIterator diff --git a/Media/Streaming/GStreamer/Core/GhostPad.chs b/Media/Streaming/GStreamer/Core/GhostPad.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/GhostPad.chs @@ -0,0 +1,100 @@ +{-# 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 +-- . +-- +-- 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.GhostPad ( + + GhostPad, + GhostPadClass, + castToGhostPad, + gTypeGhostPad, + + ghostPadNew, + ghostPadNewNoTarget, +#if GST_CHECK_VERSION(0,10,10) + ghostPadNewFromTemplate, + ghostPadNewNoTargetFromTemplate, +#endif + ghostPadSetTarget, + ghostPadGetTarget + + ) where + +import Control.Monad (liftM) +import System.Glib.FFI +import System.Glib.UTFString +{#import Media.Streaming.GStreamer.Core.Types#} + +{# context lib = "gstreamer" prefix = "gst" #} + +ghostPadNew :: PadClass pad + => String + -> pad + -> IO (Maybe Pad) +ghostPadNew name target = + (withUTFString name $ + flip {# call ghost_pad_new #} $ toPad target) >>= + maybePeek takeObject + +ghostPadNewNoTarget :: String + -> PadDirection + -> IO (Maybe Pad) +ghostPadNewNoTarget name dir = + (withUTFString name $ + flip {# call ghost_pad_new_no_target #} $ cFromEnum dir) >>= + maybePeek takeObject + +#if GST_CHECK_VERSION(0,10,10) +ghostPadNewFromTemplate :: String + -> Pad + -> PadTemplate + -> IO (Maybe Pad) +ghostPadNewFromTemplate name target templ = + withUTFString name $ \cName -> + {# call ghost_pad_new_from_template #} cName target templ >>= + maybePeek takeObject + +ghostPadNewNoTargetFromTemplate :: String + -> PadTemplate + -> IO (Maybe Pad) +ghostPadNewNoTargetFromTemplate name templ = + withUTFString name $ \cName -> + {# call ghost_pad_new_no_target_from_template #} cName templ >>= + maybePeek takeObject +#endif + +ghostPadSetTarget :: GhostPad + -> Pad + -> IO Bool +ghostPadSetTarget gpad newtarget = + liftM toBool $ {# call ghost_pad_set_target #} gpad newtarget + +ghostPadGetTarget :: GhostPad + -> IO Pad +ghostPadGetTarget gpad = + {# call ghost_pad_get_target #} gpad >>= takeObject diff --git a/Media/Streaming/GStreamer/Core/Hierarchy.chs b/Media/Streaming/GStreamer/Core/Hierarchy.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Hierarchy.chs @@ -0,0 +1,968 @@ +{-# OPTIONS_HADDOCK hide #-} +-- -*-haskell-*- +-- -------------------- automatically generated file - do not edit ---------- +-- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell +-- +-- Author : Axel Simon +-- +-- Copyright (C) 2001-2005 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. +-- +-- #hide + +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- This file reflects the Gtk+ object hierarchy in terms of Haskell classes. +-- +-- Note: the mk... functions were originally meant to simply be an alias +-- for the constructor. However, in order to communicate the destructor +-- of an object to objectNew, the mk... functions are now a tuple containing +-- Haskell constructor and the destructor function pointer. This hack avoids +-- changing all modules that simply pass mk... to objectNew. +-- +module Media.Streaming.GStreamer.Core.Hierarchy ( + + module System.Glib.GObject, + Object(Object), ObjectClass, + toObject, + mkObject, unObject, + castToObject, gTypeObject, + Pad(Pad), PadClass, + toPad, + mkPad, unPad, + castToPad, gTypePad, + GhostPad(GhostPad), GhostPadClass, + toGhostPad, + mkGhostPad, unGhostPad, + castToGhostPad, gTypeGhostPad, + PluginFeature(PluginFeature), PluginFeatureClass, + toPluginFeature, + mkPluginFeature, unPluginFeature, + castToPluginFeature, gTypePluginFeature, + ElementFactory(ElementFactory), ElementFactoryClass, + toElementFactory, + mkElementFactory, unElementFactory, + castToElementFactory, gTypeElementFactory, + TypeFindFactory(TypeFindFactory), TypeFindFactoryClass, + toTypeFindFactory, + mkTypeFindFactory, unTypeFindFactory, + castToTypeFindFactory, gTypeTypeFindFactory, + IndexFactory(IndexFactory), IndexFactoryClass, + toIndexFactory, + mkIndexFactory, unIndexFactory, + castToIndexFactory, gTypeIndexFactory, + Element(Element), ElementClass, + toElement, + mkElement, unElement, + castToElement, gTypeElement, + Bin(Bin), BinClass, + toBin, + mkBin, unBin, + castToBin, gTypeBin, + Pipeline(Pipeline), PipelineClass, + toPipeline, + mkPipeline, unPipeline, + castToPipeline, gTypePipeline, + ImplementsInterface(ImplementsInterface), ImplementsInterfaceClass, + toImplementsInterface, + mkImplementsInterface, unImplementsInterface, + castToImplementsInterface, gTypeImplementsInterface, + TagSetter(TagSetter), TagSetterClass, + toTagSetter, + mkTagSetter, unTagSetter, + castToTagSetter, gTypeTagSetter, + BaseSrc(BaseSrc), BaseSrcClass, + toBaseSrc, + mkBaseSrc, unBaseSrc, + castToBaseSrc, gTypeBaseSrc, + PushSrc(PushSrc), PushSrcClass, + toPushSrc, + mkPushSrc, unPushSrc, + castToPushSrc, gTypePushSrc, + BaseSink(BaseSink), BaseSinkClass, + toBaseSink, + mkBaseSink, unBaseSink, + castToBaseSink, gTypeBaseSink, + BaseTransform(BaseTransform), BaseTransformClass, + toBaseTransform, + mkBaseTransform, unBaseTransform, + castToBaseTransform, gTypeBaseTransform, + Plugin(Plugin), PluginClass, + toPlugin, + mkPlugin, unPlugin, + castToPlugin, gTypePlugin, + Registry(Registry), RegistryClass, + toRegistry, + mkRegistry, unRegistry, + castToRegistry, gTypeRegistry, + Bus(Bus), BusClass, + toBus, + mkBus, unBus, + castToBus, gTypeBus, + Clock(Clock), ClockClass, + toClock, + mkClock, unClock, + castToClock, gTypeClock, + AudioClock(AudioClock), AudioClockClass, + toAudioClock, + mkAudioClock, unAudioClock, + castToAudioClock, gTypeAudioClock, + SystemClock(SystemClock), SystemClockClass, + toSystemClock, + mkSystemClock, unSystemClock, + castToSystemClock, gTypeSystemClock, + NetClientClock(NetClientClock), NetClientClockClass, + toNetClientClock, + mkNetClientClock, unNetClientClock, + castToNetClientClock, gTypeNetClientClock, + Index(Index), IndexClass, + toIndex, + mkIndex, unIndex, + castToIndex, gTypeIndex, + PadTemplate(PadTemplate), PadTemplateClass, + toPadTemplate, + mkPadTemplate, unPadTemplate, + castToPadTemplate, gTypePadTemplate, + Task(Task), TaskClass, + toTask, + mkTask, unTask, + castToTask, gTypeTask, + XML(XML), XMLClass, + toXML, + mkXML, unXML, + castToXML, gTypeXML, + ChildProxy(ChildProxy), ChildProxyClass, + toChildProxy, + mkChildProxy, unChildProxy, + castToChildProxy, gTypeChildProxy, + CollectPads(CollectPads), CollectPadsClass, + toCollectPads, + mkCollectPads, unCollectPads, + castToCollectPads, gTypeCollectPads, + URIHandler(URIHandler), URIHandlerClass, + toURIHandler, + mkURIHandler, unURIHandler, + castToURIHandler, gTypeURIHandler, + Adapter(Adapter), AdapterClass, + toAdapter, + mkAdapter, unAdapter, + castToAdapter, gTypeAdapter, + Controller(Controller), ControllerClass, + toController, + mkController, unController, + castToController, gTypeController + ) where + +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) +import Foreign.C.Types (CULong, CUInt) +import System.Glib.GType (GType, typeInstanceIsA) +{#import System.Glib.GObject#} + +{# context lib="gstreamer" prefix="gtk" #} + +-- The usage of foreignPtrToPtr should be safe as the evaluation will only be +-- forced if the object is used afterwards +-- +castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String + -> (obj -> obj') +castTo gtype objTypeName obj = + case toGObject obj of + gobj@(GObject objFPtr) + | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype + -> unsafeCastGObject gobj + | otherwise -> error $ "Cannot cast object to " ++ objTypeName + + +-- ********************************************************************* Object + +{#pointer *GstObject as Object foreign newtype #} deriving (Eq,Ord) + +mkObject = (Object, objectUnref) +unObject (Object o) = o + +class GObjectClass o => ObjectClass o +toObject :: ObjectClass o => o -> Object +toObject = unsafeCastGObject . toGObject + +instance ObjectClass Object +instance GObjectClass Object where + toGObject = GObject . castForeignPtr . unObject + unsafeCastGObject = Object . castForeignPtr . unGObject + +castToObject :: GObjectClass obj => obj -> Object +castToObject = castTo gTypeObject "Object" + +gTypeObject :: GType +gTypeObject = + {# call fun unsafe gst_object_get_type #} + +-- ************************************************************************ Pad + +{#pointer *GstPad as Pad foreign newtype #} deriving (Eq,Ord) + +mkPad = (Pad, objectUnref) +unPad (Pad o) = o + +class ObjectClass o => PadClass o +toPad :: PadClass o => o -> Pad +toPad = unsafeCastGObject . toGObject + +instance PadClass Pad +instance ObjectClass Pad +instance GObjectClass Pad where + toGObject = GObject . castForeignPtr . unPad + unsafeCastGObject = Pad . castForeignPtr . unGObject + +castToPad :: GObjectClass obj => obj -> Pad +castToPad = castTo gTypePad "Pad" + +gTypePad :: GType +gTypePad = + {# call fun unsafe gst_pad_get_type #} + +-- ******************************************************************* GhostPad + +{#pointer *GstGhostPad as GhostPad foreign newtype #} deriving (Eq,Ord) + +mkGhostPad = (GhostPad, objectUnref) +unGhostPad (GhostPad o) = o + +class PadClass o => GhostPadClass o +toGhostPad :: GhostPadClass o => o -> GhostPad +toGhostPad = unsafeCastGObject . toGObject + +instance GhostPadClass GhostPad +instance PadClass GhostPad +instance ObjectClass GhostPad +instance GObjectClass GhostPad where + toGObject = GObject . castForeignPtr . unGhostPad + unsafeCastGObject = GhostPad . castForeignPtr . unGObject + +castToGhostPad :: GObjectClass obj => obj -> GhostPad +castToGhostPad = castTo gTypeGhostPad "GhostPad" + +gTypeGhostPad :: GType +gTypeGhostPad = + {# call fun unsafe gst_ghost_pad_get_type #} + +-- ************************************************************** PluginFeature + +{#pointer *GstPluginFeature as PluginFeature foreign newtype #} deriving (Eq,Ord) + +mkPluginFeature = (PluginFeature, objectUnref) +unPluginFeature (PluginFeature o) = o + +class ObjectClass o => PluginFeatureClass o +toPluginFeature :: PluginFeatureClass o => o -> PluginFeature +toPluginFeature = unsafeCastGObject . toGObject + +instance PluginFeatureClass PluginFeature +instance ObjectClass PluginFeature +instance GObjectClass PluginFeature where + toGObject = GObject . castForeignPtr . unPluginFeature + unsafeCastGObject = PluginFeature . castForeignPtr . unGObject + +castToPluginFeature :: GObjectClass obj => obj -> PluginFeature +castToPluginFeature = castTo gTypePluginFeature "PluginFeature" + +gTypePluginFeature :: GType +gTypePluginFeature = + {# call fun unsafe gst_plugin_feature_get_type #} + +-- ************************************************************* ElementFactory + +{#pointer *GstElementFactory as ElementFactory foreign newtype #} deriving (Eq,Ord) + +mkElementFactory = (ElementFactory, objectUnref) +unElementFactory (ElementFactory o) = o + +class PluginFeatureClass o => ElementFactoryClass o +toElementFactory :: ElementFactoryClass o => o -> ElementFactory +toElementFactory = unsafeCastGObject . toGObject + +instance ElementFactoryClass ElementFactory +instance PluginFeatureClass ElementFactory +instance ObjectClass ElementFactory +instance GObjectClass ElementFactory where + toGObject = GObject . castForeignPtr . unElementFactory + unsafeCastGObject = ElementFactory . castForeignPtr . unGObject + +castToElementFactory :: GObjectClass obj => obj -> ElementFactory +castToElementFactory = castTo gTypeElementFactory "ElementFactory" + +gTypeElementFactory :: GType +gTypeElementFactory = + {# call fun unsafe gst_element_factory_get_type #} + +-- ************************************************************ TypeFindFactory + +{#pointer *GstTypeFindFactory as TypeFindFactory foreign newtype #} deriving (Eq,Ord) + +mkTypeFindFactory = (TypeFindFactory, objectUnref) +unTypeFindFactory (TypeFindFactory o) = o + +class PluginFeatureClass o => TypeFindFactoryClass o +toTypeFindFactory :: TypeFindFactoryClass o => o -> TypeFindFactory +toTypeFindFactory = unsafeCastGObject . toGObject + +instance TypeFindFactoryClass TypeFindFactory +instance PluginFeatureClass TypeFindFactory +instance ObjectClass TypeFindFactory +instance GObjectClass TypeFindFactory where + toGObject = GObject . castForeignPtr . unTypeFindFactory + unsafeCastGObject = TypeFindFactory . castForeignPtr . unGObject + +castToTypeFindFactory :: GObjectClass obj => obj -> TypeFindFactory +castToTypeFindFactory = castTo gTypeTypeFindFactory "TypeFindFactory" + +gTypeTypeFindFactory :: GType +gTypeTypeFindFactory = + {# call fun unsafe gst_type_find_factory_get_type #} + +-- *************************************************************** IndexFactory + +{#pointer *GstIndexFactory as IndexFactory foreign newtype #} deriving (Eq,Ord) + +mkIndexFactory = (IndexFactory, objectUnref) +unIndexFactory (IndexFactory o) = o + +class PluginFeatureClass o => IndexFactoryClass o +toIndexFactory :: IndexFactoryClass o => o -> IndexFactory +toIndexFactory = unsafeCastGObject . toGObject + +instance IndexFactoryClass IndexFactory +instance PluginFeatureClass IndexFactory +instance ObjectClass IndexFactory +instance GObjectClass IndexFactory where + toGObject = GObject . castForeignPtr . unIndexFactory + unsafeCastGObject = IndexFactory . castForeignPtr . unGObject + +castToIndexFactory :: GObjectClass obj => obj -> IndexFactory +castToIndexFactory = castTo gTypeIndexFactory "IndexFactory" + +gTypeIndexFactory :: GType +gTypeIndexFactory = + {# call fun unsafe gst_index_factory_get_type #} + +-- ******************************************************************** Element + +{#pointer *GstElement as Element foreign newtype #} deriving (Eq,Ord) + +mkElement = (Element, objectUnref) +unElement (Element o) = o + +class ObjectClass o => ElementClass o +toElement :: ElementClass o => o -> Element +toElement = unsafeCastGObject . toGObject + +instance ElementClass Element +instance ObjectClass Element +instance GObjectClass Element where + toGObject = GObject . castForeignPtr . unElement + unsafeCastGObject = Element . castForeignPtr . unGObject + +castToElement :: GObjectClass obj => obj -> Element +castToElement = castTo gTypeElement "Element" + +gTypeElement :: GType +gTypeElement = + {# call fun unsafe gst_element_get_type #} + +-- ************************************************************************ Bin + +{#pointer *GstBin as Bin foreign newtype #} deriving (Eq,Ord) + +mkBin = (Bin, objectUnref) +unBin (Bin o) = o + +class ElementClass o => BinClass o +toBin :: BinClass o => o -> Bin +toBin = unsafeCastGObject . toGObject + +instance BinClass Bin +instance ElementClass Bin +instance ObjectClass Bin +instance GObjectClass Bin where + toGObject = GObject . castForeignPtr . unBin + unsafeCastGObject = Bin . castForeignPtr . unGObject + +castToBin :: GObjectClass obj => obj -> Bin +castToBin = castTo gTypeBin "Bin" + +gTypeBin :: GType +gTypeBin = + {# call fun unsafe gst_bin_get_type #} + +-- ******************************************************************* Pipeline + +{#pointer *GstPipeline as Pipeline foreign newtype #} deriving (Eq,Ord) + +mkPipeline = (Pipeline, objectUnref) +unPipeline (Pipeline o) = o + +class BinClass o => PipelineClass o +toPipeline :: PipelineClass o => o -> Pipeline +toPipeline = unsafeCastGObject . toGObject + +instance PipelineClass Pipeline +instance BinClass Pipeline +instance ElementClass Pipeline +instance ObjectClass Pipeline +instance GObjectClass Pipeline where + toGObject = GObject . castForeignPtr . unPipeline + unsafeCastGObject = Pipeline . castForeignPtr . unGObject + +castToPipeline :: GObjectClass obj => obj -> Pipeline +castToPipeline = castTo gTypePipeline "Pipeline" + +gTypePipeline :: GType +gTypePipeline = + {# call fun unsafe gst_pipeline_get_type #} + +-- ******************************************************** ImplementsInterface + +{#pointer *GstImplementsInterface as ImplementsInterface foreign newtype #} deriving (Eq,Ord) + +mkImplementsInterface = (ImplementsInterface, objectUnref) +unImplementsInterface (ImplementsInterface o) = o + +class ElementClass o => ImplementsInterfaceClass o +toImplementsInterface :: ImplementsInterfaceClass o => o -> ImplementsInterface +toImplementsInterface = unsafeCastGObject . toGObject + +instance ImplementsInterfaceClass ImplementsInterface +instance ElementClass ImplementsInterface +instance ObjectClass ImplementsInterface +instance GObjectClass ImplementsInterface where + toGObject = GObject . castForeignPtr . unImplementsInterface + unsafeCastGObject = ImplementsInterface . castForeignPtr . unGObject + +castToImplementsInterface :: GObjectClass obj => obj -> ImplementsInterface +castToImplementsInterface = castTo gTypeImplementsInterface "ImplementsInterface" + +gTypeImplementsInterface :: GType +gTypeImplementsInterface = + {# call fun unsafe gst_implements_interface_get_type #} + +-- ****************************************************************** TagSetter + +{#pointer *GstTagSetter as TagSetter foreign newtype #} deriving (Eq,Ord) + +mkTagSetter = (TagSetter, objectUnref) +unTagSetter (TagSetter o) = o + +class ElementClass o => TagSetterClass o +toTagSetter :: TagSetterClass o => o -> TagSetter +toTagSetter = unsafeCastGObject . toGObject + +instance TagSetterClass TagSetter +instance ElementClass TagSetter +instance ObjectClass TagSetter +instance GObjectClass TagSetter where + toGObject = GObject . castForeignPtr . unTagSetter + unsafeCastGObject = TagSetter . castForeignPtr . unGObject + +castToTagSetter :: GObjectClass obj => obj -> TagSetter +castToTagSetter = castTo gTypeTagSetter "TagSetter" + +gTypeTagSetter :: GType +gTypeTagSetter = + {# call fun unsafe gst_tag_setter_get_type #} + +-- ******************************************************************** BaseSrc + +{#pointer *GstBaseSrc as BaseSrc foreign newtype #} deriving (Eq,Ord) + +mkBaseSrc = (BaseSrc, objectUnref) +unBaseSrc (BaseSrc o) = o + +class ElementClass o => BaseSrcClass o +toBaseSrc :: BaseSrcClass o => o -> BaseSrc +toBaseSrc = unsafeCastGObject . toGObject + +instance BaseSrcClass BaseSrc +instance ElementClass BaseSrc +instance ObjectClass BaseSrc +instance GObjectClass BaseSrc where + toGObject = GObject . castForeignPtr . unBaseSrc + unsafeCastGObject = BaseSrc . castForeignPtr . unGObject + +castToBaseSrc :: GObjectClass obj => obj -> BaseSrc +castToBaseSrc = castTo gTypeBaseSrc "BaseSrc" + +gTypeBaseSrc :: GType +gTypeBaseSrc = + {# call fun unsafe gst_base_src_get_type #} + +-- ******************************************************************** PushSrc + +{#pointer *GstPushSrc as PushSrc foreign newtype #} deriving (Eq,Ord) + +mkPushSrc = (PushSrc, objectUnref) +unPushSrc (PushSrc o) = o + +class BaseSrcClass o => PushSrcClass o +toPushSrc :: PushSrcClass o => o -> PushSrc +toPushSrc = unsafeCastGObject . toGObject + +instance PushSrcClass PushSrc +instance BaseSrcClass PushSrc +instance ElementClass PushSrc +instance ObjectClass PushSrc +instance GObjectClass PushSrc where + toGObject = GObject . castForeignPtr . unPushSrc + unsafeCastGObject = PushSrc . castForeignPtr . unGObject + +castToPushSrc :: GObjectClass obj => obj -> PushSrc +castToPushSrc = castTo gTypePushSrc "PushSrc" + +gTypePushSrc :: GType +gTypePushSrc = + {# call fun unsafe gst_push_src_get_type #} + +-- ******************************************************************* BaseSink + +{#pointer *GstBaseSink as BaseSink foreign newtype #} deriving (Eq,Ord) + +mkBaseSink = (BaseSink, objectUnref) +unBaseSink (BaseSink o) = o + +class ElementClass o => BaseSinkClass o +toBaseSink :: BaseSinkClass o => o -> BaseSink +toBaseSink = unsafeCastGObject . toGObject + +instance BaseSinkClass BaseSink +instance ElementClass BaseSink +instance ObjectClass BaseSink +instance GObjectClass BaseSink where + toGObject = GObject . castForeignPtr . unBaseSink + unsafeCastGObject = BaseSink . castForeignPtr . unGObject + +castToBaseSink :: GObjectClass obj => obj -> BaseSink +castToBaseSink = castTo gTypeBaseSink "BaseSink" + +gTypeBaseSink :: GType +gTypeBaseSink = + {# call fun unsafe gst_base_sink_get_type #} + +-- ************************************************************** BaseTransform + +{#pointer *GstBaseTransform as BaseTransform foreign newtype #} deriving (Eq,Ord) + +mkBaseTransform = (BaseTransform, objectUnref) +unBaseTransform (BaseTransform o) = o + +class ElementClass o => BaseTransformClass o +toBaseTransform :: BaseTransformClass o => o -> BaseTransform +toBaseTransform = unsafeCastGObject . toGObject + +instance BaseTransformClass BaseTransform +instance ElementClass BaseTransform +instance ObjectClass BaseTransform +instance GObjectClass BaseTransform where + toGObject = GObject . castForeignPtr . unBaseTransform + unsafeCastGObject = BaseTransform . castForeignPtr . unGObject + +castToBaseTransform :: GObjectClass obj => obj -> BaseTransform +castToBaseTransform = castTo gTypeBaseTransform "BaseTransform" + +gTypeBaseTransform :: GType +gTypeBaseTransform = + {# call fun unsafe gst_base_transform_get_type #} + +-- ********************************************************************* Plugin + +{#pointer *GstPlugin as Plugin foreign newtype #} deriving (Eq,Ord) + +mkPlugin = (Plugin, objectUnref) +unPlugin (Plugin o) = o + +class ObjectClass o => PluginClass o +toPlugin :: PluginClass o => o -> Plugin +toPlugin = unsafeCastGObject . toGObject + +instance PluginClass Plugin +instance ObjectClass Plugin +instance GObjectClass Plugin where + toGObject = GObject . castForeignPtr . unPlugin + unsafeCastGObject = Plugin . castForeignPtr . unGObject + +castToPlugin :: GObjectClass obj => obj -> Plugin +castToPlugin = castTo gTypePlugin "Plugin" + +gTypePlugin :: GType +gTypePlugin = + {# call fun unsafe gst_plugin_get_type #} + +-- ******************************************************************* Registry + +{#pointer *GstRegistry as Registry foreign newtype #} deriving (Eq,Ord) + +mkRegistry = (Registry, objectUnref) +unRegistry (Registry o) = o + +class ObjectClass o => RegistryClass o +toRegistry :: RegistryClass o => o -> Registry +toRegistry = unsafeCastGObject . toGObject + +instance RegistryClass Registry +instance ObjectClass Registry +instance GObjectClass Registry where + toGObject = GObject . castForeignPtr . unRegistry + unsafeCastGObject = Registry . castForeignPtr . unGObject + +castToRegistry :: GObjectClass obj => obj -> Registry +castToRegistry = castTo gTypeRegistry "Registry" + +gTypeRegistry :: GType +gTypeRegistry = + {# call fun unsafe gst_registry_get_type #} + +-- ************************************************************************ Bus + +{#pointer *GstBus as Bus foreign newtype #} deriving (Eq,Ord) + +mkBus = (Bus, objectUnref) +unBus (Bus o) = o + +class ObjectClass o => BusClass o +toBus :: BusClass o => o -> Bus +toBus = unsafeCastGObject . toGObject + +instance BusClass Bus +instance ObjectClass Bus +instance GObjectClass Bus where + toGObject = GObject . castForeignPtr . unBus + unsafeCastGObject = Bus . castForeignPtr . unGObject + +castToBus :: GObjectClass obj => obj -> Bus +castToBus = castTo gTypeBus "Bus" + +gTypeBus :: GType +gTypeBus = + {# call fun unsafe gst_bus_get_type #} + +-- ********************************************************************** Clock + +{#pointer *GstClock as Clock foreign newtype #} deriving (Eq,Ord) + +mkClock = (Clock, objectUnref) +unClock (Clock o) = o + +class ObjectClass o => ClockClass o +toClock :: ClockClass o => o -> Clock +toClock = unsafeCastGObject . toGObject + +instance ClockClass Clock +instance ObjectClass Clock +instance GObjectClass Clock where + toGObject = GObject . castForeignPtr . unClock + unsafeCastGObject = Clock . castForeignPtr . unGObject + +castToClock :: GObjectClass obj => obj -> Clock +castToClock = castTo gTypeClock "Clock" + +gTypeClock :: GType +gTypeClock = + {# call fun unsafe gst_clock_get_type #} + +-- ***************************************************************** AudioClock + +{#pointer *GstAudioClock as AudioClock foreign newtype #} deriving (Eq,Ord) + +mkAudioClock = (AudioClock, objectUnref) +unAudioClock (AudioClock o) = o + +class ClockClass o => AudioClockClass o +toAudioClock :: AudioClockClass o => o -> AudioClock +toAudioClock = unsafeCastGObject . toGObject + +instance AudioClockClass AudioClock +instance ClockClass AudioClock +instance ObjectClass AudioClock +instance GObjectClass AudioClock where + toGObject = GObject . castForeignPtr . unAudioClock + unsafeCastGObject = AudioClock . castForeignPtr . unGObject + +castToAudioClock :: GObjectClass obj => obj -> AudioClock +castToAudioClock = castTo gTypeAudioClock "AudioClock" + +gTypeAudioClock :: GType +gTypeAudioClock = + {# call fun unsafe gst_audio_clock_get_type #} + +-- **************************************************************** SystemClock + +{#pointer *GstSystemClock as SystemClock foreign newtype #} deriving (Eq,Ord) + +mkSystemClock = (SystemClock, objectUnref) +unSystemClock (SystemClock o) = o + +class ClockClass o => SystemClockClass o +toSystemClock :: SystemClockClass o => o -> SystemClock +toSystemClock = unsafeCastGObject . toGObject + +instance SystemClockClass SystemClock +instance ClockClass SystemClock +instance ObjectClass SystemClock +instance GObjectClass SystemClock where + toGObject = GObject . castForeignPtr . unSystemClock + unsafeCastGObject = SystemClock . castForeignPtr . unGObject + +castToSystemClock :: GObjectClass obj => obj -> SystemClock +castToSystemClock = castTo gTypeSystemClock "SystemClock" + +gTypeSystemClock :: GType +gTypeSystemClock = + {# call fun unsafe gst_system_clock_get_type #} + +-- ************************************************************* NetClientClock + +{#pointer *GstNetClientClock as NetClientClock foreign newtype #} deriving (Eq,Ord) + +mkNetClientClock = (NetClientClock, objectUnref) +unNetClientClock (NetClientClock o) = o + +class ClockClass o => NetClientClockClass o +toNetClientClock :: NetClientClockClass o => o -> NetClientClock +toNetClientClock = unsafeCastGObject . toGObject + +instance NetClientClockClass NetClientClock +instance ClockClass NetClientClock +instance ObjectClass NetClientClock +instance GObjectClass NetClientClock where + toGObject = GObject . castForeignPtr . unNetClientClock + unsafeCastGObject = NetClientClock . castForeignPtr . unGObject + +castToNetClientClock :: GObjectClass obj => obj -> NetClientClock +castToNetClientClock = castTo gTypeNetClientClock "NetClientClock" + +gTypeNetClientClock :: GType +gTypeNetClientClock = + {# call fun unsafe gst_net_client_clock_get_type #} + +-- ********************************************************************** Index + +{#pointer *GstIndex as Index foreign newtype #} deriving (Eq,Ord) + +mkIndex = (Index, objectUnref) +unIndex (Index o) = o + +class ObjectClass o => IndexClass o +toIndex :: IndexClass o => o -> Index +toIndex = unsafeCastGObject . toGObject + +instance IndexClass Index +instance ObjectClass Index +instance GObjectClass Index where + toGObject = GObject . castForeignPtr . unIndex + unsafeCastGObject = Index . castForeignPtr . unGObject + +castToIndex :: GObjectClass obj => obj -> Index +castToIndex = castTo gTypeIndex "Index" + +gTypeIndex :: GType +gTypeIndex = + {# call fun unsafe gst_index_get_type #} + +-- **************************************************************** PadTemplate + +{#pointer *GstPadTemplate as PadTemplate foreign newtype #} deriving (Eq,Ord) + +mkPadTemplate = (PadTemplate, objectUnref) +unPadTemplate (PadTemplate o) = o + +class ObjectClass o => PadTemplateClass o +toPadTemplate :: PadTemplateClass o => o -> PadTemplate +toPadTemplate = unsafeCastGObject . toGObject + +instance PadTemplateClass PadTemplate +instance ObjectClass PadTemplate +instance GObjectClass PadTemplate where + toGObject = GObject . castForeignPtr . unPadTemplate + unsafeCastGObject = PadTemplate . castForeignPtr . unGObject + +castToPadTemplate :: GObjectClass obj => obj -> PadTemplate +castToPadTemplate = castTo gTypePadTemplate "PadTemplate" + +gTypePadTemplate :: GType +gTypePadTemplate = + {# call fun unsafe gst_pad_template_get_type #} + +-- *********************************************************************** Task + +{#pointer *GstTask as Task foreign newtype #} deriving (Eq,Ord) + +mkTask = (Task, objectUnref) +unTask (Task o) = o + +class ObjectClass o => TaskClass o +toTask :: TaskClass o => o -> Task +toTask = unsafeCastGObject . toGObject + +instance TaskClass Task +instance ObjectClass Task +instance GObjectClass Task where + toGObject = GObject . castForeignPtr . unTask + unsafeCastGObject = Task . castForeignPtr . unGObject + +castToTask :: GObjectClass obj => obj -> Task +castToTask = castTo gTypeTask "Task" + +gTypeTask :: GType +gTypeTask = + {# call fun unsafe gst_task_get_type #} + +-- ************************************************************************ XML + +{#pointer *GstXML as XML foreign newtype #} deriving (Eq,Ord) + +mkXML = (XML, objectUnref) +unXML (XML o) = o + +class ObjectClass o => XMLClass o +toXML :: XMLClass o => o -> XML +toXML = unsafeCastGObject . toGObject + +instance XMLClass XML +instance ObjectClass XML +instance GObjectClass XML where + toGObject = GObject . castForeignPtr . unXML + unsafeCastGObject = XML . castForeignPtr . unGObject + +castToXML :: GObjectClass obj => obj -> XML +castToXML = castTo gTypeXML "XML" + +gTypeXML :: GType +gTypeXML = + {# call fun unsafe gst_xml_get_type #} + +-- ***************************************************************** ChildProxy + +{#pointer *GstChildProxy as ChildProxy foreign newtype #} deriving (Eq,Ord) + +mkChildProxy = (ChildProxy, objectUnref) +unChildProxy (ChildProxy o) = o + +class ObjectClass o => ChildProxyClass o +toChildProxy :: ChildProxyClass o => o -> ChildProxy +toChildProxy = unsafeCastGObject . toGObject + +instance ChildProxyClass ChildProxy +instance ObjectClass ChildProxy +instance GObjectClass ChildProxy where + toGObject = GObject . castForeignPtr . unChildProxy + unsafeCastGObject = ChildProxy . castForeignPtr . unGObject + +castToChildProxy :: GObjectClass obj => obj -> ChildProxy +castToChildProxy = castTo gTypeChildProxy "ChildProxy" + +gTypeChildProxy :: GType +gTypeChildProxy = + {# call fun unsafe gst_child_proxy_get_type #} + +-- **************************************************************** CollectPads + +{#pointer *GstCollectPads as CollectPads foreign newtype #} deriving (Eq,Ord) + +mkCollectPads = (CollectPads, objectUnref) +unCollectPads (CollectPads o) = o + +class ObjectClass o => CollectPadsClass o +toCollectPads :: CollectPadsClass o => o -> CollectPads +toCollectPads = unsafeCastGObject . toGObject + +instance CollectPadsClass CollectPads +instance ObjectClass CollectPads +instance GObjectClass CollectPads where + toGObject = GObject . castForeignPtr . unCollectPads + unsafeCastGObject = CollectPads . castForeignPtr . unGObject + +castToCollectPads :: GObjectClass obj => obj -> CollectPads +castToCollectPads = castTo gTypeCollectPads "CollectPads" + +gTypeCollectPads :: GType +gTypeCollectPads = + {# call fun unsafe gst_collect_pads_get_type #} + +-- ***************************************************************** URIHandler + +{#pointer *GstURIHandler as URIHandler foreign newtype #} deriving (Eq,Ord) + +mkURIHandler = (URIHandler, objectUnref) +unURIHandler (URIHandler o) = o + +class GObjectClass o => URIHandlerClass o +toURIHandler :: URIHandlerClass o => o -> URIHandler +toURIHandler = unsafeCastGObject . toGObject + +instance URIHandlerClass URIHandler +instance GObjectClass URIHandler where + toGObject = GObject . castForeignPtr . unURIHandler + unsafeCastGObject = URIHandler . castForeignPtr . unGObject + +castToURIHandler :: GObjectClass obj => obj -> URIHandler +castToURIHandler = castTo gTypeURIHandler "URIHandler" + +gTypeURIHandler :: GType +gTypeURIHandler = + {# call fun unsafe gst_uri_handler_get_type #} + +-- ******************************************************************** Adapter + +{#pointer *GstAdapter as Adapter foreign newtype #} deriving (Eq,Ord) + +mkAdapter = (Adapter, objectUnref) +unAdapter (Adapter o) = o + +class GObjectClass o => AdapterClass o +toAdapter :: AdapterClass o => o -> Adapter +toAdapter = unsafeCastGObject . toGObject + +instance AdapterClass Adapter +instance GObjectClass Adapter where + toGObject = GObject . castForeignPtr . unAdapter + unsafeCastGObject = Adapter . castForeignPtr . unGObject + +castToAdapter :: GObjectClass obj => obj -> Adapter +castToAdapter = castTo gTypeAdapter "Adapter" + +gTypeAdapter :: GType +gTypeAdapter = + {# call fun unsafe gst_adapter_get_type #} + +-- ***************************************************************** Controller + +{#pointer *GstController as Controller foreign newtype #} deriving (Eq,Ord) + +mkController = (Controller, objectUnref) +unController (Controller o) = o + +class GObjectClass o => ControllerClass o +toController :: ControllerClass o => o -> Controller +toController = unsafeCastGObject . toGObject + +instance ControllerClass Controller +instance GObjectClass Controller where + toGObject = GObject . castForeignPtr . unController + unsafeCastGObject = Controller . castForeignPtr . unGObject + +castToController :: GObjectClass obj => obj -> Controller +castToController = castTo gTypeController "Controller" + +gTypeController :: GType +gTypeController = + {# call fun unsafe gst_controller_get_type #} + diff --git a/Media/Streaming/GStreamer/Core/HierarchyBase.hs b/Media/Streaming/GStreamer/Core/HierarchyBase.hs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/HierarchyBase.hs @@ -0,0 +1,62 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- # hide + +-- | Maintainer : gtk2hs-devel\@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Core.HierarchyBase ( + mkCastToGObject, + mkIsGObject, + ) where + +import System.Glib.FFI +import System.Glib.GType +import System.Glib.GObject + +-- The usage of foreignPtrToPtr should be safe as the evaluation will only be +-- forced if the object is used afterwards +-- +mkCastToGObject :: (GObjectClass obj, GObjectClass obj') + => GType + -> String + -> (obj -> obj') +mkCastToGObject gtype objTypeName obj = + case toGObject obj of + gobj@(GObject objFPtr) + | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype + -> unsafeCastGObject gobj + | otherwise -> error $ "Cannot cast object to " ++ objTypeName + +mkIsGObject :: GObjectClass obj + => GType + -> obj + -> Bool +mkIsGObject gType obj = + unsafePerformIO $ + withForeignPtr (unGObject $ toGObject obj) $ \objPtr -> + return $ typeInstanceIsA (castPtr objPtr) gType diff --git a/Media/Streaming/GStreamer/Core/ImplementsInterface.chs b/Media/Streaming/GStreamer/Core/ImplementsInterface.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/ImplementsInterface.chs @@ -0,0 +1,51 @@ +-- 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 +-- . +-- +-- 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.ImplementsInterface ( + + ImplementsInterface, + ImplementsInterfaceClass, + castToImplementsInterface, + toImplementsInterface, + elementImplementsInterface + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +{#import System.Glib.GType#} + +{# context lib = "gstreamer" prefix = "gst" #} + +elementImplementsInterface :: ElementClass element + => element + -> GType + -> IO Bool +elementImplementsInterface element ifaceType = + liftM toBool $ {# call element_implements_interface #} (toElement element) ifaceType diff --git a/Media/Streaming/GStreamer/Core/Index.chs b/Media/Streaming/GStreamer/Core/Index.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Index.chs @@ -0,0 +1,228 @@ +-- 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 +-- . +-- +-- 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.Index ( + + Index, + IndexClass, + castToIndex, + gTypeIndex, + + indexNew, + indexCommit, + indexGetGroup, + indexNewGroup, + indexSetGroup, + indexSetCertainty, + indexSetFilter, + indexGetWriterId, + indexAddFormat, + indexAddAssociations, + indexAddId, + indexGetAssocEntry, + indexEntryAssocMap, + onIndexEntryAdded, + afterIndexEntryAdded, + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} +import System.Glib.Flags +import System.Glib.FFI +import System.Glib.UTFString +{#import System.Glib.Signals#} +{#import System.Glib.GObject#} (destroyFunPtr) + +{# context lib = "gstreamer" prefix = "gst" #} + +indexGetFlags :: IndexClass indexT + => indexT + -> IO [IndexFlags] +indexGetFlags = mkObjectGetFlags + +indexSetFlags :: IndexClass indexT + => indexT + -> [IndexFlags] + -> IO () +indexSetFlags = mkObjectSetFlags + +indexUnsetFlags :: IndexClass indexT + => indexT + -> [IndexFlags] + -> IO () +indexUnsetFlags = mkObjectUnsetFlags + +indexNew :: IO Index +indexNew = + {# call index_new #} >>= takeObject + +indexCommit :: IndexClass index + => index + -> Int + -> IO () +indexCommit index id = + {# call index_commit #} (toIndex index) $ fromIntegral id + +indexGetGroup :: IndexClass index + => index + -> IO Int +indexGetGroup index = + liftM fromIntegral $ {# call index_get_group #} $ toIndex index + +indexNewGroup :: IndexClass index + => index + -> IO Int +indexNewGroup index = + liftM fromIntegral $ {# call index_new_group #} $ toIndex index + +indexSetGroup :: IndexClass index + => index + -> Int + -> IO Bool +indexSetGroup index groupnum = + liftM toBool $ {# call index_set_group #} (toIndex index) $ fromIntegral groupnum + +indexSetCertainty :: IndexClass index + => index + -> IndexCertainty + -> IO () +indexSetCertainty index certainty = + {# call index_set_certainty #} (toIndex index) $ cFromEnum certainty + +type CIndexFilter = Ptr Index + -> Ptr IndexEntry + -> {# type gpointer #} + -> IO {# type gboolean #} +marshalIndexFilter :: IndexFilter + -> IO {# type GstIndexFilter #} +marshalIndexFilter indexFilter = + makeIndexFilter cIndexFilter + where cIndexFilter :: CIndexFilter + cIndexFilter cIndex cIndexEntry _ = + do index <- peekObject cIndex + indexEntry <- peekIndexEntry cIndexEntry + liftM fromBool $ indexFilter index indexEntry +foreign import ccall "wrapper" + makeIndexFilter :: CIndexFilter + -> IO {# type GstIndexFilter #} + +indexSetFilter :: IndexClass index + => index + -> IndexFilter + -> IO () +indexSetFilter index filter = + do cFilter <- marshalIndexFilter filter + {# call index_set_filter_full #} (toIndex index) cFilter + (castFunPtrToPtr cFilter) destroyFunPtr + +indexGetWriterId :: IndexClass index + => index + -> Object + -> IO (Maybe Int) +indexGetWriterId index writer = + alloca $ \idPtr -> + do result <- {# call index_get_writer_id #} (toIndex index) (toObject writer) idPtr + if toBool result + then liftM (Just . fromIntegral) $ peek idPtr + else return Nothing + +indexAddFormat :: IndexClass index + => index + -> Int + -> Format + -> IO IndexEntry +indexAddFormat index id format = + {# call index_add_format #} (toIndex index) + (fromIntegral id) + (fromIntegral $ fromFormat format) >>= + peekIndexEntry + +indexAddAssociations :: IndexClass index + => index + -> Int + -> [AssocFlags] + -> [IndexAssociation] + -> IO IndexEntry +indexAddAssociations index id flags associations = + withArrayLen associations $ \numAssociations cAssociations -> + {# call index_add_associationv #} (toIndex index) + (fromIntegral id) + (fromIntegral $ fromFlags flags) + (fromIntegral numAssociations) + (castPtr cAssociations) >>= + peekIndexEntry + +indexAddId :: IndexClass index + => index + -> Int + -> String + -> IO IndexEntry +indexAddId index id description = + withUTFString description + ({# call index_add_id #} (toIndex index) $ fromIntegral id) >>= + peekIndexEntry + +indexGetAssocEntry :: IndexClass index + => index + -> Int + -> IndexLookupMethod + -> [AssocFlags] + -> Format + -> Int64 + -> IO (Maybe IndexEntry) +indexGetAssocEntry index id method flags format value = + {# call index_get_assoc_entry #} (toIndex index) + (fromIntegral id) + (cFromEnum method) + (fromIntegral $ fromFlags flags) + (fromIntegral $ fromFormat format) + (fromIntegral value) >>= + maybePeek peekIndexEntry + +indexEntryAssocMap :: IndexEntry + -> Format + -> Maybe Int64 +indexEntryAssocMap entry format = + unsafePerformIO $ alloca $ \valuePtr -> + do result <- {# call gst_index_entry_assoc_map #} entry + (fromIntegral $ fromFormat format) + valuePtr + if toBool result + then liftM (Just . fromIntegral) $ peek valuePtr + else return Nothing + +onIndexEntryAdded, afterIndexEntryAdded :: IndexClass index + => index + -> (IndexEntry -> IO ()) + -> IO (ConnectId index) +onIndexEntryAdded = + connect_BOXED__NONE "entry-added" peekIndexEntry False +afterIndexEntryAdded = + connect_BOXED__NONE "entry-added" peekIndexEntry True diff --git a/Media/Streaming/GStreamer/Core/IndexFactory.chs b/Media/Streaming/GStreamer/Core/IndexFactory.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/IndexFactory.chs @@ -0,0 +1,63 @@ +-- 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 +-- . +-- +-- 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.IndexFactory ( + + IndexFactory, + IndexFactoryClass, + castToIndexFactory, + gTypeIndexFactory, + + indexFactoryFind, + indexFactoryCreate, + indexFactoryMake + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +import System.Glib.UTFString + +{# context lib = "gstreamer" prefix = "gst" #} + +indexFactoryFind :: String + -> IO (Maybe IndexFactory) +indexFactoryFind name = + withUTFString name {# call index_factory_find #} >>= + maybePeek takeObject + +indexFactoryCreate :: IndexFactory + -> IO Index +indexFactoryCreate indexFactory = + {# call index_factory_create #} indexFactory >>= + takeObject + +indexFactoryMake :: String + -> IO Index +indexFactoryMake name = + withUTFString name {# call index_factory_make #} >>= + takeObject diff --git a/Media/Streaming/GStreamer/Core/Init.chs b/Media/Streaming/GStreamer/Core/Init.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Init.chs @@ -0,0 +1,119 @@ +{-# 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 +-- . +-- +-- 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.Init ( + init, + initCheck, + deinit, + version, + versionString, +#if GST_CHECK_VERSION(0,10,10) + segtrapIsEnabled, + segtrapSetEnabled, + registryForkIsEnabled, + registryForkSetEnabled, +#endif +#if GST_CHECK_VERSION(0,10,12) + updateRegistry +#endif + ) where + +import Control.Exception ( assert ) +import Control.Monad ( liftM ) +import Prelude hiding ( init ) +import System.Glib.FFI +import System.Glib.GError +import System.Glib.UTFString ( peekUTFString ) + +{# context lib = "gstreamer" prefix = "gst" #} + +init :: IO () +init = + {# call init #} nullPtr nullPtr + +initCheck :: IO () +initCheck = + propagateGError $ \gErrorPtr -> + do succeeded <- liftM toBool $ + {# call init_check #} nullPtr nullPtr gErrorPtr + assert (if succeeded + then gErrorPtr == nullPtr + else gErrorPtr /= nullPtr) $ return () + +deinit :: IO () +deinit = + {# call deinit #} + +version :: (Word, Word, Word, Word) +version = + unsafePerformIO $ + alloca $ \majorPtr -> + alloca $ \minorPtr -> + alloca $ \microPtr -> + alloca $ \nanoPtr -> + do {# call version #} majorPtr minorPtr microPtr nanoPtr + major <- peek majorPtr + minor <- peek minorPtr + micro <- peek microPtr + nano <- peek nanoPtr + return (fromIntegral major, + fromIntegral minor, + fromIntegral micro, + fromIntegral nano) + +versionString :: String +versionString = + unsafePerformIO $ + {# call version_string #} >>= peekUTFString + +#if GST_CHECK_VERSION(0,10,10) +segtrapIsEnabled :: IO Bool +segtrapIsEnabled = + liftM toBool {# call segtrap_is_enabled #} + +segtrapSetEnabled :: Bool + -> IO () +segtrapSetEnabled enabled = + {# call segtrap_set_enabled #} $ fromBool enabled + +registryForkIsEnabled :: IO Bool +registryForkIsEnabled = + liftM toBool {# call registry_fork_is_enabled #} + +registryForkSetEnabled :: Bool + -> IO () +registryForkSetEnabled enabled = + {# call registry_fork_set_enabled #} $ fromBool enabled +#endif + +#if GST_CHECK_VERSION(0,10,12) +updateRegistry :: IO Bool +updateRegistry = + liftM toBool {# call update_registry #} +#endif diff --git a/Media/Streaming/GStreamer/Core/Iterator.chs b/Media/Streaming/GStreamer/Core/Iterator.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Iterator.chs @@ -0,0 +1,151 @@ +-- 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 +-- . +-- +-- 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.Iterator ( + + Iterator, + Iterable, + IteratorFilter, + IteratorFoldFunction, + IteratorResult(..), + + iteratorNext, + iteratorResync, + iteratorFilter, + iteratorFold, + iteratorForeach, + iteratorFind + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} + +import Data.Maybe (fromJust) +import System.Glib.FFI +{#import System.Glib.GValue#} +import Data.IORef + +{# context lib = "gstreamer" prefix = "gst" #} + +iteratorNext :: Iterable a + => Iterator a + -> IO (IteratorResult, Maybe a) +iteratorNext (Iterator iterator) = + alloca $ \elemPtr -> + do result <- {# call iterator_next #} iterator elemPtr + obj <- peek elemPtr >>= maybePeek peekIterable + return (toEnum $ fromIntegral result, obj) + +iteratorResync :: Iterator a + -> IO () +iteratorResync (Iterator iterator) = + {# call iterator_resync #} iterator + +type CIteratorFilter = {# type gpointer #} + -> {# type gpointer #} + -> IO {# type gint #} +marshalIteratorFilter :: Iterable a + => IteratorFilter a + -> IO {# type GCompareFunc #} +marshalIteratorFilter iteratorFilter = + makeIteratorFilter cIteratorFilter + where cIteratorFilter elementPtr _ = + do include <- peekIterable elementPtr >>= iteratorFilter + return $ if include then 1 else 0 +foreign import ccall "wrapper" + makeIteratorFilter :: CIteratorFilter + -> IO {# type GCompareFunc #} + +iteratorFilter :: Iterable a + => Iterator a + -> IteratorFilter a + -> IO (Iterator a) +iteratorFilter (Iterator iterator) filter = + do cFilter <- marshalIteratorFilter filter + {# call iterator_filter #} iterator cFilter nullPtr >>= + takeIterator + +{- type IteratorFoldFunction itemT accumT = itemT + -> accumT + -> IO (Maybe accumT) -} +type CIteratorFoldFunction = {# type gpointer #} + -> GValue + -> {# type gpointer #} + -> IO {# type gboolean #} +marshalIteratorFoldFunction :: Iterable itemT + => IteratorFoldFunction itemT accumT + -> IORef accumT + -> IO {# type GstIteratorFoldFunction #} +marshalIteratorFoldFunction iteratorFoldFunction accumRef = + makeIteratorFoldFunction cIteratorFoldFunction + where cIteratorFoldFunction :: CIteratorFoldFunction + cIteratorFoldFunction itemPtr _ _ = + do item <- peekIterable itemPtr + accum <- readIORef accumRef + (continue, accum') <- iteratorFoldFunction item accum + writeIORef accumRef accum' + return $ fromBool continue +foreign import ccall "wrapper" + makeIteratorFoldFunction :: CIteratorFoldFunction + -> IO {# type GstIteratorFoldFunction #} + +iteratorFold :: Iterable itemT + => Iterator itemT + -> accumT + -> IteratorFoldFunction itemT accumT + -> IO (IteratorResult, accumT) +iteratorFold (Iterator iterator) init func = + do accumRef <- newIORef init + func' <- marshalIteratorFoldFunction func accumRef + result <- {# call iterator_fold #} iterator + func' + (GValue nullPtr) + nullPtr + freeHaskellFunPtr func' + accum <- readIORef accumRef + return (toEnum $ fromIntegral result, accum) + +iteratorForeach :: Iterable itemT + => Iterator itemT + -> (itemT -> IO ()) + -> IO IteratorResult +iteratorForeach iterator func = + do (result, _) <- iteratorFold iterator () $ \item _ -> + func item >> return (True, ()) + return result + +iteratorFind :: Iterable itemT + => Iterator itemT + -> (itemT -> IO Bool) + -> IO (IteratorResult, Maybe itemT) +iteratorFind iterator pred = + iteratorFold iterator Nothing $ \item accum -> + do found <- pred item + if found + then return (False, Just item) + else return (True, accum) diff --git a/Media/Streaming/GStreamer/Core/Message.chs b/Media/Streaming/GStreamer/Core/Message.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Message.chs @@ -0,0 +1,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 +-- . +-- +-- 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 diff --git a/Media/Streaming/GStreamer/Core/MiniHierarchy.chs b/Media/Streaming/GStreamer/Core/MiniHierarchy.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/MiniHierarchy.chs @@ -0,0 +1,167 @@ +{-# OPTIONS_HADDOCK hide #-} +-- -*-haskell-*- +-- -------------------- automatically generated file - do not edit ---------- +-- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell +-- +-- Author : Axel Simon +-- +-- Copyright (C) 2001-2005 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. +-- +-- #hide + +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- This file reflects the Gtk+ object hierarchy in terms of Haskell classes. +-- +-- Note: the mk... functions were originally meant to simply be an alias +-- for the constructor. However, in order to communicate the destructor +-- of an object to objectNew, the mk... functions are now a tuple containing +-- Haskell constructor and the destructor function pointer. This hack avoids +-- changing all modules that simply pass mk... to objectNew. +-- +module Media.Streaming.GStreamer.Core.MiniHierarchy ( + + module Media.Streaming.GStreamer.Core.MiniHierarchyBase, + Buffer(Buffer), BufferClass, + toBuffer, + mkBuffer, unBuffer, + castToBuffer, gTypeBuffer, + Event(Event), EventClass, + toEvent, + mkEvent, unEvent, + castToEvent, gTypeEvent, + Message(Message), MessageClass, + toMessage, + mkMessage, unMessage, + castToMessage, gTypeMessage, + Query(Query), QueryClass, + toQuery, + mkQuery, unQuery, + castToQuery, gTypeQuery + ) where + +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) +import Foreign.C.Types (CULong, CUInt) +import System.Glib.GType (GType, typeInstanceIsA) +{#import Media.Streaming.GStreamer.Core.MiniHierarchyBase#} + +{# context lib="gstreamer" prefix="gst" #} + +-- The usage of foreignPtrToPtr should be safe as the evaluation will only be +-- forced if the object is used afterwards +-- +castTo :: (MiniObjectClass obj, MiniObjectClass obj') => GType -> String + -> (obj -> obj') +castTo gtype objTypeName obj = + case toMiniObject obj of + gobj@(MiniObject objFPtr) + | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype + -> unsafeCastMiniObject gobj + | otherwise -> error $ "Cannot cast object to " ++ objTypeName + + +-- ********************************************************************* Buffer + +{#pointer *Buffer foreign newtype #} deriving (Eq,Ord) + +mkBuffer = (Buffer, miniObjectUnref) +unBuffer (Buffer o) = o + +class MiniObjectClass o => BufferClass o +toBuffer :: BufferClass o => o -> Buffer +toBuffer = unsafeCastMiniObject . toMiniObject + +instance BufferClass Buffer +instance MiniObjectClass Buffer where + toMiniObject = MiniObject . castForeignPtr . unBuffer + unsafeCastMiniObject = Buffer . castForeignPtr . unMiniObject + +castToBuffer :: MiniObjectClass obj => obj -> Buffer +castToBuffer = castTo gTypeBuffer "Buffer" + +gTypeBuffer :: GType +gTypeBuffer = + {# call fun unsafe gst_buffer_get_type #} + +-- ********************************************************************** Event + +{#pointer *Event foreign newtype #} deriving (Eq,Ord) + +mkEvent = (Event, miniObjectUnref) +unEvent (Event o) = o + +class MiniObjectClass o => EventClass o +toEvent :: EventClass o => o -> Event +toEvent = unsafeCastMiniObject . toMiniObject + +instance EventClass Event +instance MiniObjectClass Event where + toMiniObject = MiniObject . castForeignPtr . unEvent + unsafeCastMiniObject = Event . castForeignPtr . unMiniObject + +castToEvent :: MiniObjectClass obj => obj -> Event +castToEvent = castTo gTypeEvent "Event" + +gTypeEvent :: GType +gTypeEvent = + {# call fun unsafe gst_event_get_type #} + +-- ******************************************************************** Message + +{#pointer *Message foreign newtype #} deriving (Eq,Ord) + +mkMessage = (Message, miniObjectUnref) +unMessage (Message o) = o + +class MiniObjectClass o => MessageClass o +toMessage :: MessageClass o => o -> Message +toMessage = unsafeCastMiniObject . toMiniObject + +instance MessageClass Message +instance MiniObjectClass Message where + toMiniObject = MiniObject . castForeignPtr . unMessage + unsafeCastMiniObject = Message . castForeignPtr . unMiniObject + +castToMessage :: MiniObjectClass obj => obj -> Message +castToMessage = castTo gTypeMessage "Message" + +gTypeMessage :: GType +gTypeMessage = + {# call fun unsafe gst_message_get_type #} + +-- ********************************************************************** Query + +{#pointer *Query foreign newtype #} deriving (Eq,Ord) + +mkQuery = (Query, miniObjectUnref) +unQuery (Query o) = o + +class MiniObjectClass o => QueryClass o +toQuery :: QueryClass o => o -> Query +toQuery = unsafeCastMiniObject . toMiniObject + +instance QueryClass Query +instance MiniObjectClass Query where + toMiniObject = MiniObject . castForeignPtr . unQuery + unsafeCastMiniObject = Query . castForeignPtr . unMiniObject + +castToQuery :: MiniObjectClass obj => obj -> Query +castToQuery = castTo gTypeQuery "Query" + +gTypeQuery :: GType +gTypeQuery = + {# call fun unsafe gst_query_get_type #} + diff --git a/Media/Streaming/GStreamer/Core/MiniHierarchyBase.chs b/Media/Streaming/GStreamer/Core/MiniHierarchyBase.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/MiniHierarchyBase.chs @@ -0,0 +1,74 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel\@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Core.MiniHierarchyBase ( + miniObjectUnref, + MiniObject(..), + MiniObjectClass(..), + mkMiniObject, + unMiniObject, + isMiniObject, + castToMiniObject, + ) where + +import System.Glib.FFI +import System.Glib.GType + +{# context lib = "gstreamer" prefix = "gst" #} + +{# pointer *GstMiniObject as MiniObject foreign newtype #} + +mkMiniObject = (MiniObject, miniObjectUnref) +unMiniObject (MiniObject o) = o + + +isMiniObject :: MiniObjectClass obj + => obj + -> Bool +isMiniObject _ = True + +class MiniObjectClass o where + toMiniObject :: o -> MiniObject + unsafeCastMiniObject :: MiniObject -> o + +instance MiniObjectClass MiniObject where + toMiniObject = id + unsafeCastMiniObject = id + +castToMiniObject :: MiniObjectClass obj + => obj + -> MiniObject +castToMiniObject = toMiniObject + +-- | Decrease the reference counter of an object +-- +foreign import ccall unsafe "&gst_mini_object_unref" + miniObjectUnref :: FinalizerPtr a diff --git a/Media/Streaming/GStreamer/Core/MiniObject.chs b/Media/Streaming/GStreamer/Core/MiniObject.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/MiniObject.chs @@ -0,0 +1,84 @@ +-- 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 +-- . +-- +-- 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.MiniObject ( + + MiniObject, + MiniObjectClass, + MiniObjectFlags, -- deliberately not exporting constructors + MiniObjectT, + toMiniObject, + castToMiniObject, + + miniObjectGetFlags, + miniObjectGetFlagsM, + miniObjectSetFlagsM, + miniObjectUnsetFlagsM, + + ) where + +import Control.Monad (liftM) +import Control.Monad.Trans +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +miniObjectGetFlags :: MiniObjectClass miniObjectT + => miniObjectT + -> [MiniObjectFlags] +miniObjectGetFlags = + mkMiniObjectGetFlags + +miniObjectGetFlagsM :: (MiniObjectClass miniObjectT, MonadIO m) + => MiniObjectT miniObjectT m [MiniObjectFlags] +miniObjectGetFlagsM = + mkMiniObjectGetFlagsM + +miniObjectSetFlagsM :: (MiniObjectClass miniObjectT, MonadIO m) + => [MiniObjectFlags] + -> MiniObjectT miniObjectT m () +miniObjectSetFlagsM = + mkMiniObjectSetFlagsM + +miniObjectUnsetFlagsM :: (MiniObjectClass miniObjectT, MonadIO m) + => [MiniObjectFlags] + -> MiniObjectT miniObjectT m () +miniObjectUnsetFlagsM = + mkMiniObjectUnsetFlagsM + +miniObjectCreateCopy :: (MiniObjectClass miniObjectT, MonadIO m) + => miniObjectT + -> MiniObjectT miniObjectT m a + -> m (miniObjectT, a) +miniObjectCreateCopy miniObject action = + marshalMiniObjectModify + (liftIO $ liftM castPtr $ + {# call mini_object_copy #} $ + toMiniObject miniObject) + action diff --git a/Media/Streaming/GStreamer/Core/Object.chs b/Media/Streaming/GStreamer/Core/Object.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Object.chs @@ -0,0 +1,218 @@ +{-# 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 +-- . +-- +-- 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.Object ( + + Object, + ObjectClass, + castToObject, + gTypeObject, + + objectGetFlags, + objectSetFlags, + objectUnsetFlags, + objectSetName, + objectGetName, + objectSetParent, + objectGetParent, + objectUnparent, + objectGetNamePrefix, + objectSetNamePrefix, + objectHasAncestor, + objectWithLock, + objectWithTrylock, + objectLock, + objectTrylock, + objectUnlock, + + onObjectParentSet, + afterObjectParentSet, + onObjectParentUnset, + afterObjectParentUnset, + + objectName + + ) where + +import Control.Exception ( bracket, + bracket_ ) +import Control.Monad ( liftM, + when ) +import System.Glib.FFI +import System.Glib.GObject +import System.Glib.UTFString ( withUTFString + , readUTFString ) +import System.Glib.Properties ( newAttrFromMaybeStringProperty ) +import System.Glib.Attributes ( Attr ) +import System.Glib.Signals +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} + +{# context lib = "gstreamer" prefix = "gst" #} + +objectGetFlags :: ObjectClass objectT + => objectT + -> IO [ObjectFlags] +objectGetFlags = mkObjectGetFlags + +objectSetFlags :: ObjectClass objectT + => objectT + -> [ObjectFlags] + -> IO () +objectSetFlags = mkObjectSetFlags + +objectUnsetFlags :: ObjectClass objectT + => objectT + -> [ObjectFlags] + -> IO () +objectUnsetFlags = mkObjectUnsetFlags + +objectSetName :: ObjectClass obj => + obj + -> Maybe String + -> IO Bool +objectSetName obj name = + liftM toBool $ maybeWith withUTFString name $ + {# call object_set_name #} (toObject obj) + +objectGetName :: ObjectClass obj => + obj + -> IO (Maybe String) +objectGetName obj = + {# call object_get_name #} (toObject obj) >>= maybePeek readUTFString + +objectSetParent :: (ObjectClass obj, + ObjectClass parent) => + obj + -> parent + -> IO Bool +objectSetParent obj parent = + liftM toBool $ {# call object_set_parent #} (toObject obj) (toObject parent) + +objectGetParent :: ObjectClass obj => + obj + -> IO (Maybe Object) +objectGetParent obj = + {# call object_get_parent #} (toObject obj) >>= + maybePeek takeObject + +objectUnparent :: ObjectClass obj => + obj + -> IO () +objectUnparent obj = + {# call object_unparent #} $ toObject obj + +objectGetNamePrefix :: ObjectClass obj => + obj + -> IO (Maybe String) +objectGetNamePrefix obj = + {# call object_get_name_prefix #} (toObject obj) >>= maybePeek readUTFString + +objectSetNamePrefix :: ObjectClass obj => + obj + -> Maybe String + -> IO () +objectSetNamePrefix obj namePrefix = + maybeWith withUTFString namePrefix $ {# call object_set_name_prefix #} (toObject obj) + +objectHasAncestor :: (ObjectClass obj, ObjectClass obj') => + obj + -> obj' + -> IO Bool +objectHasAncestor object ancestor = + liftM toBool $ {# call object_has_ancestor #} (toObject object) (toObject ancestor) + +objectWithLock :: ObjectClass objectT => + objectT + -> IO a + -> IO a +objectWithLock object action = + bracket_ (objectLock object) + (objectUnlock object) + action + +objectWithTrylock :: ObjectClass objectT => + objectT + -> IO a + -> IO (Maybe a) +objectWithTrylock object action = + bracket (objectTrylock object) + (\locked -> when locked $ objectUnlock object) + (\locked -> if locked + then liftM Just $ action + else return Nothing) + +objectLock :: ObjectClass objectT => + objectT + -> IO () +objectLock object = + withObject (toObject object) cGstObjectLock +foreign import ccall unsafe "_hs_gst_object_lock" + cGstObjectLock :: Ptr Object + -> IO () + +objectTrylock :: ObjectClass objectT => + objectT + -> IO Bool +objectTrylock object = + liftM toBool $ withObject (toObject object) cGstObjectTrylock +foreign import ccall unsafe "_hs_gst_object_trylock" + cGstObjectTrylock :: Ptr Object + -> IO {# type gboolean #} + +objectUnlock :: ObjectClass objectT => + objectT + -> IO () +objectUnlock object = + withObject (toObject object) cGstObjectUnlock +foreign import ccall unsafe "_hs_gst_object_unlock" + cGstObjectUnlock :: Ptr Object + -> IO () + +onObjectParentSet, afterObjectParentSet :: ObjectClass objectT + => objectT + -> (GObject -> IO ()) + -> IO (ConnectId objectT) +onObjectParentSet = + connect_OBJECT__NONE "parent-set" False +afterObjectParentSet = + connect_OBJECT__NONE "parent-set" True + +onObjectParentUnset, afterObjectParentUnset :: ObjectClass objectT + => objectT + -> (GObject -> IO ()) + -> IO (ConnectId objectT) +onObjectParentUnset = + connect_OBJECT__NONE "parent-unset" False +afterObjectParentUnset = + connect_OBJECT__NONE "parent-unset" True + +objectName :: ObjectClass objectT + => Attr objectT (Maybe String) +objectName = newAttrFromMaybeStringProperty "name" diff --git a/Media/Streaming/GStreamer/Core/Pad.chs b/Media/Streaming/GStreamer/Core/Pad.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Pad.chs @@ -0,0 +1,469 @@ +{-# 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 +-- . +-- +-- 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.Pad ( + + Pad, + PadClass, + castToPad, + gTypePad, + + PadFlags(..), + + PadDirection(..), + PadLinkReturn(..), + FlowReturn(..), + ActivateMode(..), + + padGetFlags, + padSetFlags, + padUnsetFlags, + padNew, + padGetDirection, + padGetParentElement, + padLink, + padUnlink, + padIsLinked, + padCanLink, + padGetCaps, + padGetAllowedCaps, + padGetNegotiatedCaps, + padGetPadTemplateCaps, + padSetCaps, + padGetPeer, + padPeerGetCaps, + padIsActive, + padSetBlocked, + padIsBlocked, +#if GST_CHECK_VERSION(0,10,11) + padIsBlocking, +#endif + padNewFromTemplate, + padAcceptCaps, + padProxyGetcaps, + padFixateCaps, + padPeerAcceptCaps, + padSendEvent, + padQuery, + padQueryPosition, + padQueryDuration, + padQueryConvert, + padQueryPeerPosition, + padQueryPeerDuration, + padQueryPeerConvert, + padGetQueryTypes, + onPadLinked, + afterPadLinked, + onPadRequestLink, + afterPadRequestLink, + onPadUnlinked, + afterPadUnlinked, + + padCaps, + padDirection, + padTemplate, + + ) where + +import Control.Monad (liftM) +import Data.Maybe (fromMaybe) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} + +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.GList +import System.Glib.Properties ( objectGetPropertyGObject ) +import System.Glib.Attributes ( ReadAttr + , readAttr ) +{#import System.Glib.Signals#} + +{# context lib = "gstreamer" prefix = "gst" #} + +padGetFlags :: PadClass padT + => padT + -> IO [PadFlags] +padGetFlags = mkObjectGetFlags + +padSetFlags :: PadClass padT + => padT + -> [PadFlags] + -> IO () +padSetFlags = mkObjectSetFlags + +padUnsetFlags :: PadClass padT + => padT + -> [PadFlags] + -> IO () +padUnsetFlags = mkObjectUnsetFlags + +padNew :: String + -> PadDirection + -> IO Pad +padNew name direction = + withUTFString name $ \cName -> + {# call pad_new #} cName (fromIntegral $ fromEnum direction) >>= + takeObject + +padGetDirection :: PadClass pad + => pad + -> IO PadDirection +padGetDirection pad = + liftM (toEnum . fromIntegral) $ + {# call pad_get_direction #} $ toPad pad + +padGetParentElement :: PadClass pad + => pad + -> IO Element +padGetParentElement pad = + {# call pad_get_parent_element #} (toPad pad) >>= + peekObject + +padLink :: (PadClass srcpad, PadClass sinkpad) + => srcpad + -> sinkpad + -> IO PadLinkReturn +padLink srcpad sinkpad = + liftM (toEnum . fromIntegral) $ + {# call pad_link #} (toPad srcpad) (toPad sinkpad) + +padUnlink :: (PadClass srcpad, PadClass sinkpad) + => srcpad + -> sinkpad + -> IO Bool +padUnlink srcpad sinkpad = + liftM toBool $ + {# call pad_unlink #} (toPad srcpad) (toPad sinkpad) + +padIsLinked :: PadClass pad + => pad + -> IO Bool +padIsLinked pad = + liftM toBool $ + {# call pad_is_linked #} (toPad pad) + +padCanLink :: (PadClass srcpad, PadClass sinkpad) + => srcpad + -> sinkpad + -> IO Bool +padCanLink srcpad sinkpad = + liftM toBool $ + {# call pad_can_link #} (toPad srcpad) (toPad sinkpad) + +padGetCaps :: PadClass pad + => pad + -> IO Caps +padGetCaps pad = + {# call pad_get_caps #} (toPad pad) >>= takeCaps + +padGetAllowedCaps :: PadClass pad + => pad + -> IO (Maybe Caps) +padGetAllowedCaps pad = + {# call pad_get_allowed_caps #} (toPad pad) >>= + maybePeek takeCaps + +padGetNegotiatedCaps :: PadClass pad + => pad + -> IO (Maybe Caps) +padGetNegotiatedCaps pad = + {# call pad_get_negotiated_caps #} (toPad pad) >>= + maybePeek takeCaps + +padGetPadTemplateCaps :: PadClass pad + => pad + -> IO Caps +padGetPadTemplateCaps pad = + (liftM Caps $ + {# call pad_get_pad_template_caps #} (toPad pad) >>= + newForeignPtr_) >>= + {# call caps_copy #} >>= takeCaps + +padSetCaps :: PadClass pad + => pad + -> Maybe Caps + -> IO Bool +padSetCaps pad caps = + liftM toBool $ {# call pad_set_caps #} (toPad pad) $ + fromMaybe (Caps nullForeignPtr) caps + +padGetPeer :: PadClass pad + => pad + -> IO (Maybe Pad) +padGetPeer pad = + {# call pad_get_peer #} (toPad pad) >>= maybePeek takeObject + +padPeerGetCaps :: PadClass pad + => pad + -> IO (Maybe Caps) +padPeerGetCaps pad = + {# call pad_peer_get_caps #} (toPad pad) >>= maybePeek takeCaps + +padIsActive :: PadClass pad + => pad + -> IO Bool +padIsActive = + (liftM toBool) . {# call pad_is_active #} . toPad + +padSetBlocked :: PadClass pad + => pad + -> Bool + -> IO Bool +padSetBlocked pad blocked = + liftM toBool $ + {# call pad_set_blocked #} (toPad pad) (fromBool blocked) + +padIsBlocked :: PadClass pad + => pad + -> IO Bool +padIsBlocked = + (liftM toBool) . {# call pad_is_blocked #} . toPad + +#if GST_CHECK_VERSION(0,10,11) +padIsBlocking :: PadClass pad + => pad + -> IO Bool +padIsBlocking = + (liftM toBool) . {# call pad_is_blocking #} . toPad +#endif + +padNewFromTemplate :: PadTemplateClass padTemplate + => padTemplate + -> String + -> IO (Maybe Pad) +padNewFromTemplate padTemplate name = + withUTFString name $ \cName -> + {# call pad_new_from_template #} (toPadTemplate padTemplate) cName >>= + maybePeek takeObject + +padAcceptCaps :: PadClass pad + => pad + -> Caps + -> IO Bool +padAcceptCaps pad caps = + liftM toBool $ {# call pad_accept_caps #} (toPad pad) caps + +padProxyGetcaps :: PadClass pad + => pad + -> IO Caps +padProxyGetcaps pad = + {# call pad_proxy_getcaps #} (toPad pad) >>= takeCaps + +padFixateCaps :: PadClass pad + => pad + -> Caps + -> IO Caps +padFixateCaps pad caps = + do caps' <- {# call caps_copy #} caps >>= newForeignPtr_ + {# call pad_fixate_caps #} (toPad pad) (Caps caps') + withForeignPtr caps' takeCaps + +padPeerAcceptCaps :: PadClass pad + => pad + -> Caps + -> IO Bool +padPeerAcceptCaps pad caps = + liftM toBool $ {# call pad_peer_accept_caps #} (toPad pad) caps + +padSendEvent :: (PadClass pad, EventClass event) + => pad + -> event + -> IO Bool +padSendEvent pad event = + liftM toBool $ + giveMiniObject (toEvent event) $ {# call pad_send_event #} (toPad pad) + +padQuery :: (PadClass pad, QueryClass query) + => pad + -> query + -> IO (Maybe query) +padQuery pad query = + do query' <- {# call mini_object_copy #} (toMiniObject query) >>= + newForeignPtr_ . castPtr + success <- {# call pad_query #} (toPad pad) $ Query query' + if toBool success + then liftM Just $ withForeignPtr query' $ takeMiniObject . castPtr + else return Nothing + +padQueryPosition :: PadClass pad + => pad + -> IO (Maybe (Format, Int64)) +padQueryPosition pad = + alloca $ \formatPtr -> + alloca $ \curPtr -> + do success <- {# call pad_query_position #} (toPad pad) formatPtr curPtr + if toBool success + then do format <- peek formatPtr + cur <- peek curPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral cur) + else return Nothing + +padQueryDuration :: PadClass pad + => pad + -> IO (Maybe (Format, Int64)) +padQueryDuration pad = + alloca $ \formatPtr -> + alloca $ \durationPtr -> + do success <- {# call pad_query_duration #} (toPad pad) formatPtr durationPtr + if toBool success + then do format <- peek formatPtr + duration <- peek durationPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral duration) + else return Nothing + +padQueryConvert :: PadClass pad + => pad + -> Format + -> Int64 + -> IO (Maybe (Format, Int64)) +padQueryConvert pad srcFormat srcVal = + alloca $ \destFormatPtr -> + alloca $ \destValPtr -> + do success <- {# call pad_query_convert #} (toPad pad) + (fromIntegral $ fromFormat srcFormat) + (fromIntegral srcVal) + destFormatPtr + destValPtr + if toBool success + then do destFormat <- peek destFormatPtr + destVal <- peek destValPtr + return $ Just (toFormat $ fromIntegral destFormat, + fromIntegral destVal) + else return Nothing + +padQueryPeerPosition :: PadClass pad + => pad + -> IO (Maybe (Format, Int64)) +padQueryPeerPosition pad = + alloca $ \formatPtr -> + alloca $ \curPtr -> + do success <- {# call pad_query_peer_position #} (toPad pad) formatPtr curPtr + if toBool success + then do format <- peek formatPtr + cur <- peek curPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral cur) + else return Nothing + +padQueryPeerDuration :: PadClass pad + => pad + -> IO (Maybe (Format, Int64)) +padQueryPeerDuration pad = + alloca $ \formatPtr -> + alloca $ \durationPtr -> + do success <- {# call pad_query_peer_duration #} (toPad pad) formatPtr durationPtr + if toBool success + then do format <- peek formatPtr + duration <- peek durationPtr + return $ Just (toFormat $ fromIntegral format, + fromIntegral duration) + else return Nothing + +padQueryPeerConvert :: PadClass pad + => pad + -> Format + -> Int64 + -> IO (Maybe (Format, Int64)) +padQueryPeerConvert pad srcFormat srcVal = + alloca $ \destFormatPtr -> + alloca $ \destValPtr -> + do success <- {# call pad_query_peer_convert #} (toPad pad) + (fromIntegral $ fromFormat srcFormat) + (fromIntegral srcVal) + destFormatPtr + destValPtr + if toBool success + then do destFormat <- peek destFormatPtr + destVal <- peek destValPtr + return $ Just (toFormat $ fromIntegral destFormat, + fromIntegral destVal) + else return Nothing + +padGetQueryTypes :: PadClass pad + => pad + -> IO [QueryType] +padGetQueryTypes pad = + liftM (map (toEnum . fromIntegral)) $ + {# call pad_get_query_types #} (toPad pad) >>= + peekArray0 0 + +onPadLinked, afterPadLinked :: (PadClass pad) + => pad + -> (Pad -> IO ()) + -> IO (ConnectId pad) +onPadLinked = + connect_OBJECT__NONE "linked" False +afterPadLinked = + connect_OBJECT__NONE "linked" True + +onPadRequestLink, afterPadRequestLink :: (PadClass pad) + => pad + -> IO () + -> IO (ConnectId pad) +onPadRequestLink = + connect_NONE__NONE "request-link" False +afterPadRequestLink = + connect_NONE__NONE "request-link" True + +onPadUnlinked, afterPadUnlinked :: (PadClass pad) + => pad + -> (Pad -> IO ()) + -> IO (ConnectId pad) +onPadUnlinked = + connect_OBJECT__NONE "unlinked" False +afterPadUnlinked = + connect_OBJECT__NONE "unlinked" True + +padCaps :: PadClass pad + => ReadAttr pad Caps +padCaps = readAttr + padGetCaps + +padDirection :: PadClass pad + => ReadAttr pad PadDirection +padDirection = readAttr + padGetDirection + +padTemplate :: PadClass pad + => ReadAttr pad PadTemplate +padTemplate = readAttr $ + objectGetPropertyGObject {# call fun gst_pad_template_get_type #} + "template" + +padParentElement :: PadClass pad + => ReadAttr pad Element +padParentElement = readAttr + padGetParentElement + +padQueryTypes :: PadClass pad + => ReadAttr pad [QueryType] +padQueryTypes = readAttr + padGetQueryTypes diff --git a/Media/Streaming/GStreamer/Core/PadTemplate.chs b/Media/Streaming/GStreamer/Core/PadTemplate.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/PadTemplate.chs @@ -0,0 +1,108 @@ +{-# 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 +-- . +-- +-- 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.PadTemplate ( + + PadTemplate, + PadTemplateClass, + castToPadTemplate, + gTypePadTemplate, + + PadPresence(..), + + padTemplateNew, + padTemplateGetCaps, + padTemplateGetNameTemplate, + padTemplateGetDirection, + padTemplateGetPresence, + + onPadTemplatePadCreated, + afterPadTemplatePadCreated + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Signals + +{# context lib = "gstreamer" prefix = "gst" #} + +padTemplateNew :: String + -> PadDirection + -> PadPresence + -> Caps + -> IO PadTemplate +padTemplateNew nameTemplate direction presence caps = + withUTFString nameTemplate $ \cNameTemplate -> + giveCaps caps $ \caps' -> + {# call pad_template_new #} cNameTemplate + (fromIntegral $ fromEnum direction) + (fromIntegral $ fromEnum presence) + caps' >>= + takeObject + +padTemplateGetCaps :: PadTemplateClass padTemplate + => padTemplate + -> IO Caps +padTemplateGetCaps padTemplate = + {# call pad_template_get_caps #} (toPadTemplate padTemplate) >>= + peekCaps + +padTemplateGetNameTemplate :: PadTemplateClass padTemplate + => padTemplate + -> IO String +padTemplateGetNameTemplate padTemplate = + withObject (toPadTemplate padTemplate) {# get PadTemplate->name_template #} >>= + peekUTFString + +padTemplateGetDirection :: PadTemplateClass padTemplate + => padTemplate + -> IO PadDirection +padTemplateGetDirection padTemplate = + liftM (toEnum . fromIntegral) $ + withObject (toPadTemplate padTemplate) {# get PadTemplate->direction #} + +padTemplateGetPresence :: PadTemplateClass padTemplate + => padTemplate + -> IO PadPresence +padTemplateGetPresence padTemplate = + liftM (toEnum . fromIntegral) $ + withObject (toPadTemplate padTemplate) {# get PadTemplate->presence #} + +onPadTemplatePadCreated, afterPadTemplatePadCreated :: PadTemplateClass padTemplateT + => padTemplateT + -> (Pad -> IO ()) + -> IO (ConnectId padTemplateT) +onPadTemplatePadCreated = + connect_OBJECT__NONE "pad-created" False +afterPadTemplatePadCreated = + connect_OBJECT__NONE "pad-created" True diff --git a/Media/Streaming/GStreamer/Core/Parse.chs b/Media/Streaming/GStreamer/Core/Parse.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Parse.chs @@ -0,0 +1,73 @@ +-- 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 +-- . +-- +-- 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.Parse ( + parseLaunch, + parseLaunchFromArgs, + parseBinFromDescription + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.GError +import System.Glib.UTFString +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +parseLaunch :: String + -> IO (Maybe Element, Maybe GError) +parseLaunch pipelineDescription = + withUTFString pipelineDescription $ \cPipelineDescription -> + alloca $ \gErrorPtr -> + do element <- {# call parse_launch #} cPipelineDescription (castPtr gErrorPtr) >>= + maybePeek takeObject + gError <- peek gErrorPtr >>= maybePeek peek + return (element, gError) + +parseLaunchFromArgs :: [String] + -> IO (Maybe Element, Maybe GError) +parseLaunchFromArgs args = + withUTFStringArray0 args $ \cArgs -> + alloca $ \gErrorPtr -> + do element <- {# call parse_launchv #} (castPtr cArgs) (castPtr gErrorPtr) >>= + maybePeek takeObject + gError <- peek gErrorPtr >>= maybePeek peek + return (element, gError) + +parseBinFromDescription :: String + -> Bool + -> IO (Maybe Element, Maybe GError) +parseBinFromDescription binDescription ghostUnconnectedPads = + withUTFString binDescription $ \cBinDescription -> + alloca $ \gErrorPtr -> + do element <- {# call parse_bin_from_description #} cBinDescription + (fromBool ghostUnconnectedPads) + (castPtr gErrorPtr) >>= + maybePeek takeObject + gError <- peek gErrorPtr >>= maybePeek peek + return (element, gError) diff --git a/Media/Streaming/GStreamer/Core/Pipeline.chs b/Media/Streaming/GStreamer/Core/Pipeline.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Pipeline.chs @@ -0,0 +1,140 @@ +-- 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 +-- . +-- +-- 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.Pipeline ( + Pipeline, + PipelineClass, + castToPipeline, + gTypePipeline, + + pipelineNew, + pipelineGetBus, + pipelineSetClock, + pipelineUseClock, + pipelineSetNewStreamTime, + pipelineGetLastStreamTime, + pipelineSetAutoFlushBus, + pipelineGetAutoFlushBus, + pipelineSetDelay, + pipelineGetDelay, + + pipelineAutoFlushBus, + pipelineDelay + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.UTFString +import System.Glib.FFI +import System.Glib.Attributes ( Attr + , newAttr ) + +{# context lib = "gstreamer" prefix = "gst" #} + +pipelineNew :: String + -> IO Element +pipelineNew name = + withUTFString name {# call pipeline_new #} >>= + takeObject + +pipelineGetBus :: PipelineClass pipeline + => pipeline + -> IO Bus +pipelineGetBus pipeline = + {# call pipeline_get_bus #} (toPipeline pipeline) >>= takeObject + +pipelineSetClock :: (PipelineClass pipeline, ClockClass clock) + => pipeline + -> clock + -> IO Bool +pipelineSetClock pipeline clock = + liftM toBool $ + {# call pipeline_set_clock #} (toPipeline pipeline) (toClock clock) + +pipelineUseClock :: (PipelineClass pipeline, ClockClass clock) + => pipeline + -> clock + -> IO () +pipelineUseClock pipeline clock = + {# call pipeline_use_clock #} (toPipeline pipeline) (toClock clock) + +pipelineSetNewStreamTime :: PipelineClass pipeline + => pipeline + -> ClockTime + -> IO () +pipelineSetNewStreamTime pipeline time = + {# call pipeline_set_new_stream_time #} (toPipeline pipeline) + (fromIntegral time) + +pipelineGetLastStreamTime :: PipelineClass pipeline + => pipeline + -> IO ClockTime +pipelineGetLastStreamTime pipeline = + liftM fromIntegral $ + {# call pipeline_get_last_stream_time #} (toPipeline pipeline) + +pipelineSetAutoFlushBus :: PipelineClass pipeline + => pipeline + -> Bool + -> IO () +pipelineSetAutoFlushBus pipeline autoFlush = + {# call pipeline_set_auto_flush_bus #} (toPipeline pipeline) $ fromBool autoFlush + +pipelineGetAutoFlushBus :: PipelineClass pipeline + => pipeline + -> IO Bool +pipelineGetAutoFlushBus pipeline = + liftM toBool $ + {# call pipeline_get_auto_flush_bus #} (toPipeline pipeline) + +pipelineSetDelay :: PipelineClass pipeline + => pipeline + -> ClockTime + -> IO () +pipelineSetDelay pipeline delay = + {# call pipeline_set_delay #} (toPipeline pipeline) + (fromIntegral delay) + +pipelineGetDelay :: PipelineClass pipeline + => pipeline + -> IO ClockTime +pipelineGetDelay pipeline = + liftM fromIntegral $ + {# call pipeline_get_delay #} (toPipeline pipeline) + +pipelineAutoFlushBus :: PipelineClass pipelineT + => Attr pipelineT Bool +pipelineAutoFlushBus = newAttr + pipelineGetAutoFlushBus + pipelineSetAutoFlushBus + +pipelineDelay :: PipelineClass pipelineT + => Attr pipelineT ClockTime +pipelineDelay = newAttr + pipelineGetDelay + pipelineSetDelay diff --git a/Media/Streaming/GStreamer/Core/Plugin.chs b/Media/Streaming/GStreamer/Core/Plugin.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Plugin.chs @@ -0,0 +1,166 @@ +-- 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 +-- . +-- +-- 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.Plugin ( + Plugin, + PluginClass, + castToPlugin, + gTypePlugin, + + pluginGetName, + pluginGetDescription, + pluginGetFilename, + pluginGetLicense, + pluginGetPackage, + pluginGetOrigin, + pluginGetSource, + pluginGetVersion, + pluginIsLoaded, + pluginLoadByName, + pluginLoad, + + pluginName, + pluginDescription, + pluginFilename, + pluginLicense, + pluginPackage, + pluginOrigin, + pluginSource, + pluginVersion + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.GObject +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Attributes ( ReadAttr + , readAttr ) + +{# context lib = "gstreamer" prefix = "gst" #} + +pluginGetName :: PluginClass plugin + => plugin + -> IO String +pluginGetName plugin = + {# call plugin_get_name #} (toPlugin plugin) >>= peekUTFString + +pluginGetDescription :: PluginClass plugin + => plugin + -> IO String +pluginGetDescription plugin = + {# call plugin_get_description #} (toPlugin plugin) >>= peekUTFString + +pluginGetFilename :: PluginClass plugin + => plugin + -> IO FilePath +pluginGetFilename plugin = + {# call plugin_get_filename #} (toPlugin plugin) >>= peekUTFString + +pluginGetLicense :: PluginClass plugin + => plugin + -> IO String +pluginGetLicense plugin = + {# call plugin_get_license #} (toPlugin plugin) >>= peekUTFString + +pluginGetPackage :: PluginClass plugin + => plugin + -> IO String +pluginGetPackage plugin = + {# call plugin_get_package #} (toPlugin plugin) >>= peekUTFString + +pluginGetOrigin :: PluginClass plugin + => plugin + -> IO String +pluginGetOrigin plugin = + {# call plugin_get_origin #} (toPlugin plugin) >>= peekUTFString + +pluginGetSource :: PluginClass plugin + => plugin + -> IO String +pluginGetSource plugin = + {# call plugin_get_source #} (toPlugin plugin) >>= peekUTFString + +pluginGetVersion :: PluginClass plugin + => plugin + -> IO String +pluginGetVersion plugin = + {# call plugin_get_version #} (toPlugin plugin) >>= peekUTFString + +pluginIsLoaded :: PluginClass plugin + => plugin + -> IO Bool +pluginIsLoaded = + (liftM toBool) . {# call plugin_is_loaded #} . toPlugin + +pluginName :: PluginClass plugin + => ReadAttr plugin String +pluginName = readAttr pluginGetName + +pluginDescription :: PluginClass plugin + => ReadAttr plugin String +pluginDescription = readAttr pluginGetDescription + +pluginFilename :: PluginClass plugin + => ReadAttr plugin FilePath +pluginFilename = readAttr pluginGetFilename + +pluginLicense :: PluginClass plugin + => ReadAttr plugin String +pluginLicense = readAttr pluginGetLicense + +pluginPackage :: PluginClass plugin + => ReadAttr plugin String +pluginPackage = readAttr pluginGetPackage + +pluginOrigin :: PluginClass plugin + => ReadAttr plugin String +pluginOrigin = readAttr pluginGetOrigin + +pluginSource :: PluginClass plugin + => ReadAttr plugin String +pluginSource = readAttr pluginGetSource + +pluginVersion :: PluginClass plugin + => ReadAttr plugin String +pluginVersion = readAttr pluginGetVersion + +pluginLoad :: PluginClass plugin + => plugin + -> IO plugin +pluginLoad plugin = + liftM (unsafeCastGObject . toGObject) $ + {# call plugin_load #} (toPlugin plugin) >>= + takeObject + +pluginLoadByName :: String + -> IO Plugin +pluginLoadByName name = + withUTFString name {# call plugin_load_by_name #} >>= + takeObject diff --git a/Media/Streaming/GStreamer/Core/PluginFeature.chs b/Media/Streaming/GStreamer/Core/PluginFeature.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/PluginFeature.chs @@ -0,0 +1,67 @@ +-- 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 +-- . +-- +-- 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.PluginFeature ( + + PluginFeature, + PluginFeatureClass, + castToPluginFeature, + gTypePluginFeature, + + pluginFeatureLoad, + pluginFeatureCheckVersion + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +import System.Glib.GObject + +{# context lib = "gstreamer" prefix = "gst" #} + +pluginFeatureLoad :: PluginFeatureClass pluginFeature + => pluginFeature + -> IO pluginFeature +pluginFeatureLoad pluginFeature = + liftM (unsafeCastGObject . toGObject) $ + {# call plugin_feature_load #} (toPluginFeature pluginFeature) >>= + takeObject + +pluginFeatureCheckVersion :: PluginFeatureClass pluginFeature + => pluginFeature + -> Word + -> Word + -> Word + -> IO Bool +pluginFeatureCheckVersion pluginFeature minMajor minMinor minMicro = + liftM toBool $ + {# call plugin_feature_check_version #} (toPluginFeature pluginFeature) + (fromIntegral minMajor) + (fromIntegral minMinor) + (fromIntegral minMicro) diff --git a/Media/Streaming/GStreamer/Core/Query.chs b/Media/Streaming/GStreamer/Core/Query.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Query.chs @@ -0,0 +1,116 @@ +-- 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 +-- . +-- +-- 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.Query ( + + Query, + QueryClass, + toQuery, + castToQuery, + gTypeQuery, + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +{#import System.Glib.GObject#} +import System.Glib.UTFString + +{# context lib = "gstreamer" prefix = "gst" #} + +queryNone, queryPosition, queryDuration, + queryLatency, queryJitter, + queryRate, querySeeking, + querySegment, queryConvert, + queryFormats :: QueryType +queryNone = 0 +queryPosition = 1 +queryDuration = 2 +queryLatency = 3 +queryJitter = 4 +queryRate = 5 +querySeeking = 6 +querySegment = 7 +queryConvert = 8 +queryFormats = 9 + +queryTypeGetName :: QueryType + -> IO String +queryTypeGetName queryType = + {# call query_type_get_name #} (fromIntegral queryType) >>= + peekUTFString + +queryType :: Query + -> QueryType +queryType query = + unsafePerformIO $ withMiniObject query cQueryType +foreign import ccall unsafe "_hs_gst_query_type" + cQueryType :: Ptr Query + -> IO {# type GstQueryType #} + +queryTypeName :: Query + -> IO String +queryTypeName = + queryTypeGetName . queryType + +queryTypeToQuark :: QueryType + -> IO Quark +queryTypeToQuark = {# call query_type_to_quark #} + +queryTypeRegister :: String + -> String + -> IO QueryType +queryTypeRegister nick description = + withUTFString nick $ \cNick -> + withUTFString description $ + {# call query_type_register #} cNick + +queryTypeGetByNick :: String + -> IO QueryType +queryTypeGetByNick nick = + withUTFString nick {# call query_type_get_by_nick #} + +queryTypeGetDetails :: QueryType + -> IO (Maybe QueryTypeDefinition) +queryTypeGetDetails queryType = + {# call query_type_get_details #} queryType >>= + maybePeek (peek . castPtr) + +queryTypeIterateDefinitions :: IO (Iterator QueryTypeDefinition) +queryTypeIterateDefinitions = + {# call query_type_iterate_definitions #} >>= takeIterator + +queryNewConvert :: Format + -> Word64 + -> Format + -> IO Query +queryNewConvert srcFormat value destFormat = + {# call query_new_convert #} (fromIntegral $ fromFormat srcFormat) + (fromIntegral value) + (fromIntegral $ fromFormat destFormat) >>= + takeMiniObject diff --git a/Media/Streaming/GStreamer/Core/Registry.chs b/Media/Streaming/GStreamer/Core/Registry.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Registry.chs @@ -0,0 +1,323 @@ +-- 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 +-- . +-- +-- 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.Registry ( + + Registry, + RegistryClass, + castToRegistry, + gTypeRegistry, + + defaultRegistry, + registryGetFeatureList, + registryGetFeatureListByPlugin, + registryGetPathList, + registryGetPluginList, + registryAddPlugin, + registryRemovePlugin, + registryPluginFilter, + registryFeatureFilter, + registryFindPlugin, + registryFindFeature, + registryLookupFeature, + registryScanPath, + registryXMLReadCache, + registryXMLWriteCache, + registryLookup, + registryRemoveFeature, + registryAddFeature, + defaultRegistryCheckFeatureVersion, + defaultRegistryGetPathList, + defaultRegistryAddPlugin, + defaultRegistryScanPath, + defaultRegistryFindPlugin, + defaultRegistryFindFeature, + defaultRegistryFeatureFilter, + onRegistryFeatureAdded, + afterRegistryFeatureAdded, + onRegistryPluginAdded, + afterRegistryPluginAdded + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +{#import Media.Streaming.GStreamer.Core.Signals#} +{#import System.Glib.GType#} +import System.Glib.FFI +import System.Glib.UTFString +import System.Glib.Signals +{#import System.Glib.GList#} + +{# context lib = "gstreamer" prefix = "gst" #} + +defaultRegistry :: Registry +defaultRegistry = + unsafePerformIO $ {# call registry_get_default #} >>= peekObject + +registryGetFeatureList :: RegistryClass registry + => registry + -> GType + -> IO [PluginFeature] +registryGetFeatureList registry gType = + {# call registry_get_feature_list #} (toRegistry registry) gType >>= + fromGList >>= mapM takeObject + +registryGetFeatureListByPlugin :: RegistryClass registry + => registry + -> String + -> IO [PluginFeature] +registryGetFeatureListByPlugin registry name = + withUTFString name $ \cName -> + {# call registry_get_feature_list_by_plugin #} (toRegistry registry) cName >>= + fromGList >>= mapM takeObject + +registryGetPathList :: RegistryClass registry + => registry + -> IO [FilePath] +registryGetPathList registry = + {# call registry_get_path_list #} (toRegistry registry) >>= + fromGList >>= mapM peekUTFString + +registryGetPluginList :: RegistryClass registry + => registry + -> IO [Plugin] +registryGetPluginList registry = + {# call registry_get_plugin_list #} (toRegistry registry) >>= + fromGList >>= mapM takeObject + +registryAddPlugin :: (RegistryClass registry, PluginClass plugin) + => registry + -> plugin + -> IO Bool +registryAddPlugin registry plugin = + liftM toBool $ {# call registry_add_plugin #} (toRegistry registry) (toPlugin plugin) + +registryRemovePlugin :: (RegistryClass registry, PluginClass plugin) + => registry + -> plugin + -> IO () +registryRemovePlugin registry plugin = + {# call registry_remove_plugin #} (toRegistry registry) (toPlugin plugin) + +type CPluginFilter = Ptr Plugin + -> {# type gpointer #} + -> IO {# type gboolean #} +marshalPluginFilter :: PluginFilter + -> IO {# type GstPluginFilter #} +marshalPluginFilter pluginFilter = + makePluginFilter cPluginFilter + where cPluginFilter :: CPluginFilter + cPluginFilter pluginPtr _ = + liftM fromBool $ peekObject pluginPtr >>= pluginFilter +foreign import ccall "wrapper" + makePluginFilter :: CPluginFilter + -> IO {# type GstPluginFilter #} + +registryPluginFilter :: RegistryClass registry + => registry + -> PluginFilter + -> Bool + -> IO [Plugin] +registryPluginFilter registry pluginFilter first = + do cPluginFilter <- marshalPluginFilter pluginFilter + {# call registry_plugin_filter #} (toRegistry registry) + cPluginFilter + (fromBool first) + nullPtr >>= + fromGList >>= mapM takeObject + + +type CPluginFeatureFilter = Ptr PluginFeature + -> {# type gpointer #} + -> IO {# type gboolean #} +marshalPluginFeatureFilter :: PluginFeatureFilter + -> IO {# type GstPluginFeatureFilter #} +marshalPluginFeatureFilter pluginFeatureFilter = + makePluginFeatureFilter cPluginFeatureFilter + where cPluginFeatureFilter :: CPluginFeatureFilter + cPluginFeatureFilter pluginFeaturePtr _ = + liftM fromBool $ peekObject pluginFeaturePtr >>= pluginFeatureFilter +foreign import ccall "wrapper" + makePluginFeatureFilter :: CPluginFeatureFilter + -> IO {# type GstPluginFeatureFilter #} + +registryFeatureFilter :: RegistryClass registry + => registry + -> PluginFeatureFilter + -> Bool + -> IO [PluginFeature] +registryFeatureFilter registry featureFilter first = + do cPluginFeatureFilter <- marshalPluginFeatureFilter featureFilter + {# call registry_feature_filter #} (toRegistry registry) + cPluginFeatureFilter + (fromBool first) + nullPtr >>= + fromGList >>= mapM takeObject + + +registryFindPlugin :: RegistryClass registry + => registry + -> String + -> IO (Maybe Plugin) +registryFindPlugin registry name = + (withUTFString name $ {# call registry_find_plugin #} (toRegistry registry)) >>= + maybePeek takeObject + +registryFindFeature :: RegistryClass registry + => registry + -> String + -> GType + -> IO (Maybe PluginFeature) +registryFindFeature registry name gType = + withUTFString name $ \cName -> + {# call registry_find_feature #} (toRegistry registry) + cName + gType >>= + maybePeek takeObject + +registryLookupFeature :: RegistryClass registry + => registry + -> String + -> IO (Maybe PluginFeature) +registryLookupFeature registry name = + (withUTFString name $ {# call registry_lookup_feature #} (toRegistry registry)) >>= + maybePeek takeObject + +registryScanPath :: RegistryClass registry + => registry + -> FilePath + -> IO Bool +registryScanPath registry path = + liftM toBool $ + withUTFString path $ + {# call registry_scan_path #} (toRegistry registry) + +registryXMLReadCache :: RegistryClass registry + => registry + -> FilePath + -> IO Bool +registryXMLReadCache registry location = + liftM toBool $ + withUTFString location $ + {# call registry_xml_read_cache #} (toRegistry registry) + +registryXMLWriteCache :: RegistryClass registry + => registry + -> FilePath + -> IO Bool +registryXMLWriteCache registry location = + liftM toBool $ + withUTFString location $ + {# call registry_xml_write_cache #} (toRegistry registry) + +registryLookup :: RegistryClass registry + => registry + -> FilePath + -> IO Plugin +registryLookup registry filename = + (withUTFString filename $ + {# call registry_lookup #} (toRegistry registry)) >>= + takeObject + +registryRemoveFeature :: (RegistryClass registry, PluginFeatureClass pluginFeature) + => registry + -> pluginFeature + -> IO () +registryRemoveFeature registry pluginFeature = + {# call registry_remove_feature #} (toRegistry registry) (toPluginFeature pluginFeature) + +registryAddFeature :: (RegistryClass registry, PluginFeatureClass pluginFeature) + => registry + -> pluginFeature + -> IO Bool +registryAddFeature registry pluginFeature = + liftM toBool $ + {# call registry_add_feature #} (toRegistry registry) (toPluginFeature pluginFeature) + +defaultRegistryCheckFeatureVersion :: String + -> Word + -> Word + -> Word + -> IO Bool +defaultRegistryCheckFeatureVersion feature minMajor minMinor minMicro = + liftM toBool $ withUTFString feature $ \cFeature -> + {# call default_registry_check_feature_version #} cFeature + (fromIntegral minMajor) + (fromIntegral minMinor) + (fromIntegral minMicro) + +defaultRegistryGetPathList :: IO [FilePath] +defaultRegistryGetPathList = + registryGetPathList defaultRegistry + +defaultRegistryAddPlugin :: PluginClass plugin + => plugin + -> IO Bool +defaultRegistryAddPlugin = + registryAddPlugin defaultRegistry + +defaultRegistryScanPath :: String + -> IO Bool +defaultRegistryScanPath = + registryScanPath defaultRegistry + +defaultRegistryFindPlugin :: String + -> IO (Maybe Plugin) +defaultRegistryFindPlugin = + registryFindPlugin defaultRegistry + +defaultRegistryFindFeature :: String + -> GType + -> IO (Maybe PluginFeature) +defaultRegistryFindFeature = + registryFindFeature defaultRegistry + +defaultRegistryFeatureFilter :: PluginFeatureFilter + -> Bool + -> IO [PluginFeature] +defaultRegistryFeatureFilter = + registryFeatureFilter defaultRegistry + +onRegistryFeatureAdded, afterRegistryFeatureAdded :: RegistryClass registry + => registry + -> (PluginFeature -> IO ()) + -> IO (ConnectId registry) +onRegistryFeatureAdded = + connect_OBJECT__NONE "feature-added" False +afterRegistryFeatureAdded = + connect_OBJECT__NONE "feature-added" False + +onRegistryPluginAdded, afterRegistryPluginAdded :: RegistryClass registry + => registry + -> (Plugin -> IO ()) + -> IO (ConnectId registry) +onRegistryPluginAdded = + connect_OBJECT__NONE "plugin-added" False +afterRegistryPluginAdded = + connect_OBJECT__NONE "plugin-added" False diff --git a/Media/Streaming/GStreamer/Core/Segment.chs b/Media/Streaming/GStreamer/Core/Segment.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Segment.chs @@ -0,0 +1,155 @@ +-- 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 +-- . +-- +-- 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.Segment ( + + Segment(..), + + segmentClip, + segmentSetDuration, + segmentSetLastStop, + segmentSetNewsegment, + segmentSetSeek, + segmentToRunningTime, + segmentToStreamTime + + ) where + +{# context lib = "gstreamer" prefix = "gst" #} + +import Control.Monad (liftM) +import System.Glib.FFI +import System.Glib.Flags +{#import Media.Streaming.GStreamer.Core.Types#} + +segmentClip :: Segment + -> Format + -> Int64 + -> Int64 + -> (Segment, Bool, Int64, Int64) +segmentClip segment format start stop = + unsafePerformIO $ alloca $ \clipStartPtr -> + alloca $ \clipStopPtr -> + with segment $ \segmentPtr -> + do result <- liftM toBool $ + {# call segment_clip #} (castPtr segmentPtr) + (fromIntegral $ fromFormat format) + (fromIntegral start) + (fromIntegral stop) + clipStartPtr + clipStopPtr + segment' <- peek segmentPtr + clipStart <- liftM fromIntegral $ peek clipStartPtr + clipStop <- liftM fromIntegral $ peek clipStopPtr + return (segment', result, clipStart, clipStop) + +segmentSetDuration :: Segment + -> Format + -> Int64 + -> Segment +segmentSetDuration segment format duration = + unsafePerformIO $ with segment $ \segmentPtr -> + do {# call segment_set_duration #} (castPtr segmentPtr) + (fromIntegral $ fromFormat format) + (fromIntegral duration) + peek segmentPtr + +segmentSetLastStop :: Segment + -> Format + -> Int64 + -> Segment +segmentSetLastStop segment format position = + unsafePerformIO $ with segment $ \segmentPtr -> + do {# call segment_set_last_stop #} (castPtr segmentPtr) + (fromIntegral $ fromFormat format) + (fromIntegral position) + peek segmentPtr + +segmentSetNewsegment :: Segment + -> Bool + -> Double + -> Format + -> Int64 + -> Int64 + -> Int64 + -> Segment +segmentSetNewsegment segment update rate format start stop time = + unsafePerformIO $ with segment $ \segmentPtr -> + do {# call segment_set_newsegment #} (castPtr segmentPtr) + (fromBool update) + (realToFrac rate) + (fromIntegral $ fromFormat format) + (fromIntegral start) + (fromIntegral stop) + (fromIntegral time) + peek segmentPtr + +segmentSetSeek :: Segment + -> Double + -> Format + -> [SeekFlags] + -> SeekType + -> Int64 + -> SeekType + -> Int64 + -> (Segment, Bool) +segmentSetSeek segment rate format flags startType start stopType stop = + unsafePerformIO $ with segment $ \segmentPtr -> + alloca $ \updatePtr -> + do {# call segment_set_seek #} (castPtr segmentPtr) + (realToFrac rate) + (fromIntegral $ fromFormat format) + (fromIntegral $ fromFlags flags) + (cFromEnum startType) + (fromIntegral start) + (cFromEnum stopType) + (fromIntegral stop) + updatePtr + update <- liftM toBool $ peek updatePtr + segment' <- peek segmentPtr + return (segment', update) + +segmentToRunningTime :: Segment + -> Format + -> Int64 + -> Int64 +segmentToRunningTime segment format position = + fromIntegral $ unsafePerformIO $ with segment $ \segmentPtr -> + {# call segment_to_running_time #} (castPtr segmentPtr) + (fromIntegral $ fromFormat format) + (fromIntegral position) + +segmentToStreamTime :: Segment + -> Format + -> Int64 + -> Int64 +segmentToStreamTime segment format position = + fromIntegral $ unsafePerformIO $ with segment $ \segmentPtr -> + {# call segment_to_stream_time #} (castPtr segmentPtr) + (fromIntegral $ fromFormat format) + (fromIntegral position) diff --git a/Media/Streaming/GStreamer/Core/Signals.chs b/Media/Streaming/GStreamer/Core/Signals.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Signals.chs @@ -0,0 +1,104 @@ +{-# OPTIONS_HADDOCK hide #-} +-- -*-haskell-*- +-- -------------------- automatically generated file - do not edit ------------ +-- Callback installers for the GIMP Toolkit (GTK) Binding for Haskell +-- +-- Author : Axel Simon +-- +-- Created: 1 July 2000 +-- +-- Copyright (C) 2000-2005 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. +-- +-- #hide + +-- These functions are used to connect signals to widgets. They are auto- +-- matically created through HookGenerator.hs which takes a list of possible +-- function signatures that are included in the GTK sources (gtkmarshal.list). +-- +-- The object system in the second version of GTK is based on GObject from +-- GLIB. This base class is rather primitive in that it only implements +-- ref and unref methods (and others that are not interesting to us). If +-- the marshall list mentions OBJECT it refers to an instance of this +-- GObject which is automatically wrapped with a ref and unref call. +-- Structures which are not derived from GObject have to be passed as +-- BOXED which gives the signal connect function a possibility to do the +-- conversion into a proper ForeignPtr type. In special cases the signal +-- connect function use a PTR type which will then be mangled in the +-- user function directly. The latter is needed if a signal delivers a +-- pointer to a string and its length in a separate integer. +-- +module Media.Streaming.GStreamer.Core.Signals ( + module System.Glib.Signals, + + connect_NONE__NONE, + connect_OBJECT__NONE, + connect_BOXED__NONE, + + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import System.Glib.UTFString (peekUTFString) +import System.Glib.GError (failOnGError) +{#import System.Glib.Signals#} +{#import System.Glib.GObject#} + + +{#context lib="gtk" prefix="gtk" #} + + +-- Here are the generators that turn a Haskell function into +-- a C function pointer. The fist Argument is always the widget, +-- the last one is the user g_pointer. Both are ignored. + + +connect_NONE__NONE :: + GObjectClass obj => SignalName -> + ConnectAfter -> obj -> + (IO ()) -> + IO (ConnectId obj) +connect_NONE__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> IO () + action _ = + failOnGError $ + user + +connect_OBJECT__NONE :: + (GObjectClass a', GObjectClass obj) => SignalName -> + ConnectAfter -> obj -> + (a' -> IO ()) -> + IO (ConnectId obj) +connect_OBJECT__NONE signal after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr GObject -> IO () + action _ obj1 = + failOnGError $ + makeNewGObject (GObject, objectUnref) (return obj1) >>= \obj1' -> + user (unsafeCastGObject obj1') + +connect_BOXED__NONE :: + GObjectClass obj => SignalName -> + (Ptr a' -> IO a) -> + ConnectAfter -> obj -> + (a -> IO ()) -> + IO (ConnectId obj) +connect_BOXED__NONE signal boxedPre1 after obj user = + connectGeneric signal after obj action + where action :: Ptr GObject -> Ptr () -> IO () + action _ box1 = + failOnGError $ + boxedPre1 (castPtr box1) >>= \box1' -> + user box1' + diff --git a/Media/Streaming/GStreamer/Core/Structure.chs b/Media/Streaming/GStreamer/Core/Structure.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Structure.chs @@ -0,0 +1,359 @@ +-- 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 +-- . +-- +-- 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.Structure ( + Structure, + structureEmpty, + structureToString, + structureFromString, + structureName, + structureHasName, + structureGetBool, + structureGetInt, + structureGetFourCC, + structureGetDouble, + structureGetString, + structureGetDate, + structureGetClockTime, + structureGetFraction, + + StructureM, + structureCreate, + structureModify, + structureSetNameM, + structureRemoveFieldM, + structureSetBoolM, + structureSetIntM, + structureSetFourCCM, + structureSetDoubleM, + structureSetStringM, + structureSetDateM, + structureSetClockTimeM, + structureSetFractionM, + structureFixateFieldNearestIntM, + structureFixateFieldNearestDoubleM, + structureFixateFieldNearestFractionM, + structureFixateFieldBoolM + ) where + +import Data.Ratio ( (%) + , numerator + , denominator ) +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.UTFString +import System.Glib.FFI +import System.Glib.GTypeConstants +{#import System.Glib.GDateTime#} +{#import System.Glib.GType#} +{#import System.Glib.GValue#} +{#import System.Glib.GValueTypes#} + +{# context lib = "gstreamer" prefix = "gst" #} + +structureEmpty :: String + -> Structure +structureEmpty name = + unsafePerformIO $ + withUTFString name {# call structure_empty_new #} >>= + takeStructure + +structureToString :: Structure + -> String +structureToString structure = + unsafePerformIO $ + {# call structure_to_string #} structure >>= + readUTFString + +structureFromString :: String + -> (Maybe Structure, Int) +structureFromString string = + unsafePerformIO $ + withUTFString string $ \cString -> + alloca $ \endPtr -> + do structure <- {# call structure_from_string #} cString endPtr >>= + maybePeek takeStructure + end <- peek endPtr + offset <- {# call g_utf8_pointer_to_offset #} cString end + return (structure, fromIntegral offset) + +structureName :: Structure + -> String +structureName structure = + unsafePerformIO $ + {# call structure_get_name #} structure >>= + peekUTFString + +structureHasName :: Structure + -> String + -> Bool +structureHasName structure name = + toBool $ unsafePerformIO $ + withUTFString name $ + {# call structure_has_name #} structure + +marshalStructureGet :: Storable a + => (Structure -> CString -> Ptr a -> IO {# type gboolean #}) + -> (a -> IO b) + -> Structure + -> String + -> Maybe b +marshalStructureGet getAction convert structure fieldname = + unsafePerformIO $ + alloca $ \ptr -> + withUTFString fieldname $ \cFieldname -> + do result <- getAction structure cFieldname ptr + if toBool result + then liftM Just $ peek (castPtr ptr) >>= convert + else return Nothing + +structureGetBool :: Structure + -> String + -> Maybe Bool +structureGetBool = + marshalStructureGet {# call structure_get_boolean #} $ + return . toBool + +structureGetInt :: Structure + -> String + -> Maybe Int +structureGetInt = + marshalStructureGet {# call structure_get_int #} $ + return . fromIntegral + +structureGetFourCC :: Structure + -> String + -> Maybe FourCC +structureGetFourCC = + marshalStructureGet {# call structure_get_fourcc #} $ + return . fromIntegral + +structureGetDouble :: Structure + -> String + -> Maybe Double +structureGetDouble = + marshalStructureGet {# call structure_get_double #} $ + return . realToFrac + +structureGetString :: Structure + -> String + -> Maybe String +structureGetString structure fieldname = + unsafePerformIO $ + (withUTFString fieldname $ {# call structure_get_string #} structure) >>= + maybePeek peekUTFString + +structureGetDate :: Structure + -> String + -> Maybe GDate +structureGetDate = + marshalStructureGet {# call structure_get_date #} $ + peek . castPtr + +structureGetClockTime :: Structure + -> String + -> Maybe ClockTime +structureGetClockTime = + marshalStructureGet {# call structure_get_clock_time #} $ + return . fromIntegral + +structureGetFraction :: Structure + -> String + -> Maybe Fraction +structureGetFraction structure fieldname = + unsafePerformIO $ + alloca $ \numPtr -> alloca $ \denPtr -> + withUTFString fieldname $ \cFieldname -> + do result <- {# call structure_get_fraction #} structure cFieldname numPtr denPtr + if toBool result + then do num <- peek numPtr + den <- peek denPtr + return $ Just $ (fromIntegral num) % (fromIntegral den) + else return Nothing + +marshalStructureModify :: IO (Ptr Structure) + -> StructureM a + -> (Structure, a) +marshalStructureModify mkStructure (StructureM action) = + unsafePerformIO $ + do ptr <- mkStructure + structure <- liftM Structure $ newForeignPtr_ ptr + result <- action structure + structure' <- takeStructure ptr + return (structure', result) + +structureCreate :: String + -> StructureM a + -> (Structure, a) +structureCreate name action = + marshalStructureModify + (withUTFString name {# call structure_empty_new #}) + action + +structureModify :: Structure + -> StructureM a + -> (Structure, a) +structureModify structure action = + marshalStructureModify + ({# call structure_copy #} structure) + action + +structureSetNameM :: String + -> StructureM () +structureSetNameM name = + StructureM $ \structure -> + withUTFString name $ {# call structure_set_name #} structure + +structureRemoveFieldM :: String + -> StructureM () +structureRemoveFieldM name = + StructureM $ \structure -> + withUTFString name $ {# call structure_remove_field #} structure + +marshalStructureSetM :: GType + -> (GValue -> a -> IO ()) + -> String + -> a + -> StructureM () +marshalStructureSetM valueType setGValue fieldname value = + StructureM $ \structure -> + withUTFString fieldname $ \cFieldname -> + allocaGValue $ \gValue -> + do valueInit gValue valueType + setGValue gValue value + {# call structure_set_value #} structure cFieldname gValue + +structureSetBoolM :: String + -> Bool + -> StructureM () +structureSetBoolM = + marshalStructureSetM bool valueSetBool + +structureSetIntM :: String + -> Int + -> StructureM () +structureSetIntM = + marshalStructureSetM int valueSetInt + +structureSetFourCCM :: String + -> FourCC + -> StructureM () +structureSetFourCCM = + marshalStructureSetM fourcc $ \gValue fourcc -> + {# call value_set_fourcc #} gValue $ fromIntegral fourcc + +structureSetDoubleM :: String + -> Double + -> StructureM () +structureSetDoubleM = + marshalStructureSetM double valueSetDouble + +structureSetStringM :: String + -> String + -> StructureM () +structureSetStringM = + marshalStructureSetM string valueSetString + +structureSetDateM :: String + -> GDate + -> StructureM () +structureSetDateM = + marshalStructureSetM date $ \gValue date -> + with date $ ({# call value_set_date #} gValue) . castPtr + +structureSetClockTimeM :: String + -> ClockTime + -> StructureM () +structureSetClockTimeM = + marshalStructureSetM uint64 $ \gValue clockTime -> + {# call g_value_set_uint64 #} gValue $ fromIntegral clockTime + +structureSetFractionM :: String + -> Fraction + -> StructureM () +structureSetFractionM = + marshalStructureSetM fraction $ \gValue fraction -> + {# call value_set_fraction #} gValue + (fromIntegral $ numerator fraction) + (fromIntegral $ denominator fraction) + +marshalStructureFixateM :: (Structure -> CString -> a -> IO {# type gboolean #}) + -> String + -> a + -> StructureM Bool +marshalStructureFixateM fixate fieldname target = + StructureM $ \structure -> + withUTFString fieldname $ \cFieldname -> + liftM toBool $ + fixate structure cFieldname target + +structureFixateFieldNearestIntM :: String + -> Int + -> StructureM Bool +structureFixateFieldNearestIntM = + marshalStructureFixateM $ \structure cFieldname target -> + {# call structure_fixate_field_nearest_int #} + structure + cFieldname + (fromIntegral target) + +structureFixateFieldNearestDoubleM :: String + -> Double + -> StructureM Bool +structureFixateFieldNearestDoubleM = + marshalStructureFixateM $ \structure cFieldname target -> + {# call structure_fixate_field_nearest_double #} + structure + cFieldname + (realToFrac target) + +structureFixateFieldNearestFractionM :: String + -> Fraction + -> StructureM Bool +structureFixateFieldNearestFractionM = + marshalStructureFixateM $ \structure cFieldname target -> + {# call structure_fixate_field_nearest_fraction #} + structure + cFieldname + (fromIntegral $ numerator target) + (fromIntegral $ denominator target) + +structureFixateFieldBoolM :: String + -> Bool + -> StructureM Bool +structureFixateFieldBoolM = + marshalStructureFixateM $ \structure cFieldname target -> + {# call structure_fixate_field_boolean #} + structure + cFieldname + (fromBool target) + + +fourcc = {# call fun fourcc_get_type #} +date = {# call fun date_get_type #} +fraction = {# call fun fraction_get_type #} diff --git a/Media/Streaming/GStreamer/Core/SystemClock.chs b/Media/Streaming/GStreamer/Core/SystemClock.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/SystemClock.chs @@ -0,0 +1,47 @@ +-- 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 +-- . +-- +-- 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.SystemClock ( + + SystemClock, + SystemClockClass, + castToSystemClock, + gTypeSystemClock, + + systemClockObtain + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +systemClockObtain :: IO Clock +systemClockObtain = + {# call system_clock_obtain #} >>= takeObject diff --git a/Media/Streaming/GStreamer/Core/TagList.chs b/Media/Streaming/GStreamer/Core/TagList.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/TagList.chs @@ -0,0 +1,474 @@ +{-# 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 +-- . +-- +-- 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.TagList ( + + StandardTag(..), + standardTagToString, + tagNick, + tagDescription, + tagGetFlag, + tagIsFixed, + tagListEmpty, +#if GST_CHECK_VERSION(0,10,11) + tagListIsEmpty, +#endif + tagListMerge, + tagListGetTagSize, + tagListCreate, + tagListModify, + tagListInsert, + tagListRemoveTag, + tagListGetChar, + tagListGetCharIndex, + tagListGetUChar, + tagListGetUCharIndex, + tagListGetBool, + tagListGetBoolIndex, + tagListGetInt, + tagListGetIntIndex, + tagListGetUInt, + tagListGetUIntIndex, + tagListGetLong, + tagListGetLongIndex, + tagListGetULong, + tagListGetULongIndex, + tagListGetInt64, + tagListGetInt64Index, + tagListGetUInt64, + tagListGetUInt64Index, + tagListGetFloat, + tagListGetFloatIndex, + tagListGetDouble, + tagListGetDoubleIndex, + tagListGetString, + tagListGetStringIndex, + tagListGetDate, + tagListGetDateIndex + + ) where + +import Control.Monad (liftM) +{#import Media.Streaming.GStreamer.Core.Types#} +import System.Glib.FFI +import System.Glib.UTFString +{#import System.Glib.GDateTime#} +import Data.Char ( ord + , chr ) + +{# context lib = "gstreamer" prefix = "gst" #} + +data StandardTag = StandardTagTitle + | StandardTagArtist + | StandardTagAlbum + | StandardTagDate + | StandardTagGenre + | StandardTagComment + | StandardTagExtendedComment + | StandardTagTrackNumber + | StandardTagTrackCount + | StandardTagAlbumVolumeNumber + | StandardTagVolumeCount + | StandardTagLocation + | StandardTagDescription + | StandardTagVersion + | StandardTagISRC + | StandardTagOrganization + | StandardTagCopyright + | StandardTagContact + | StandardTagLicense + | StandardTagPerformer + | StandardTagDuration + | StandardTagCodec + | StandardTagVideoCodec + | StandardTagAudioCodec + | StandardTagBitrate + | StandardTagNominalBitrate + | StandardTagMinimumBitrate + | StandardTagMaximumBitrate + | StandardTagSerial + | StandardTagEncoder + | StandardTagEncoderVersion + | StandardTagTrackGain + | StandardTagTrackPeak + | StandardTagAlbumGain + | StandardTagAlbumPeak + | StandardTagReferenceLevel + | StandardTagLanguageCode + | StandardTagImage + | StandardTagPreviewImage + | StandardTagBeatsPerMinute + deriving (Eq, Enum, Bounded, Show) + +standardTagToString :: StandardTag + -> Tag +standardTagToString StandardTagTitle = "title" +standardTagToString StandardTagArtist = "artist" +standardTagToString StandardTagAlbum = "album" +standardTagToString StandardTagDate = "date" +standardTagToString StandardTagGenre = "genre" +standardTagToString StandardTagComment = "comment" +standardTagToString StandardTagExtendedComment = "extended-comment" +standardTagToString StandardTagTrackNumber = "track-number" +standardTagToString StandardTagTrackCount = "track-count" +standardTagToString StandardTagAlbumVolumeNumber = "album-volume-number" +standardTagToString StandardTagVolumeCount = "album-volume-count" +standardTagToString StandardTagLocation = "location" +standardTagToString StandardTagDescription = "description" +standardTagToString StandardTagVersion = "version" +standardTagToString StandardTagISRC = "isrc" +standardTagToString StandardTagOrganization = "organization" +standardTagToString StandardTagCopyright = "copyright" +standardTagToString StandardTagContact = "contact" +standardTagToString StandardTagLicense = "license" +standardTagToString StandardTagPerformer = "performer" +standardTagToString StandardTagDuration = "duration" +standardTagToString StandardTagCodec = "codec" +standardTagToString StandardTagVideoCodec = "video-codec" +standardTagToString StandardTagAudioCodec = "audio-codec" +standardTagToString StandardTagBitrate = "bitrate" +standardTagToString StandardTagNominalBitrate = "nominal-bitrate" +standardTagToString StandardTagMinimumBitrate = "minimum-bitrate" +standardTagToString StandardTagMaximumBitrate = "maximum-bitrate" +standardTagToString StandardTagSerial = "serial" +standardTagToString StandardTagEncoder = "encoder" +standardTagToString StandardTagEncoderVersion = "encoder-version" +standardTagToString StandardTagTrackGain = "track-gain" +standardTagToString StandardTagTrackPeak = "track-peak" +standardTagToString StandardTagAlbumGain = "album-gain" +standardTagToString StandardTagAlbumPeak = "album-peak" +standardTagToString StandardTagReferenceLevel = "reference-level" +standardTagToString StandardTagLanguageCode = "language-code" +standardTagToString StandardTagImage = "image" +standardTagToString StandardTagPreviewImage = "preview-image" +standardTagToString StandardTagBeatsPerMinute = "beats-per-minute" + +tagNick :: Tag + -> String +tagNick tag = + unsafePerformIO $ + withUTFString tag {# call tag_get_nick #} >>= peekUTFString + +tagDescription :: Tag + -> String +tagDescription tag = + unsafePerformIO $ + withUTFString tag {# call tag_get_description #} >>= peekUTFString + +tagGetFlag :: Tag + -> TagFlag +tagGetFlag tag = + cToEnum $ unsafePerformIO $ + withUTFString tag {# call tag_get_flag #} + +tagIsFixed :: Tag + -> Bool +tagIsFixed tag = + toBool $ unsafePerformIO $ + withUTFString tag {# call tag_is_fixed #} + +tagListEmpty :: TagList +tagListEmpty = + unsafePerformIO $ {# call tag_list_new #} >>= takeTagList . castPtr + +#if GST_CHECK_VERSION(0,10,11) +tagListIsEmpty :: TagList + -> Bool +tagListIsEmpty tagList = + toBool $ unsafePerformIO $ withTagList tagList $ {# call tag_list_is_empty #} . castPtr +#endif + +tagListMerge :: TagList + -> TagList + -> TagMergeMode + -> TagList +tagListMerge list1 list2 mode = + unsafePerformIO $ withTagList list1 $ \listPtr1 -> + withTagList list2 $ \listPtr2 -> + {# call tag_list_merge #} (castPtr listPtr1) + (castPtr listPtr2) + (cFromEnum mode) >>= + takeTagList . castPtr + +tagListGetTagSize :: TagList + -> Tag + -> Word +tagListGetTagSize tagList tag = + fromIntegral $ unsafePerformIO $ + withUTFString tag $ \cTag -> + withTagList tagList $ \tagListPtr -> + {# call tag_list_get_tag_size #} (castPtr tagListPtr) cTag + +tagListCreate :: StructureM a + -> (TagList, a) +tagListCreate (StructureM action) = + unsafePerformIO $ + do tagListPtr <- liftM castPtr {# call tag_list_new #} + tagList <- liftM Structure $ newForeignPtr_ tagListPtr + result <- action tagList + tagList' <- takeTagList tagListPtr + return (tagList', result) + +tagListModify :: TagList + -> StructureM a + -> (TagList, a) +tagListModify tagList (StructureM action) = + unsafePerformIO $ + do tagListPtr <- withTagList tagList $ {# call tag_list_copy #} . castPtr + tagList' <- liftM Structure $ newForeignPtr_ $ castPtr tagListPtr + result <- action tagList' + tagList'' <- takeTagList $ castPtr tagListPtr + return $ (tagList'', result) + +tagListInsert :: TagList + -> TagMergeMode + -> StructureM () +tagListInsert tagList1 mode = + StructureM $ \tagList2 -> + withTagList tagList1 $ \tagListPtr1 -> + withTagList tagList2 $ \tagListPtr2 -> + {# call tag_list_insert #} (castPtr tagListPtr1) + (castPtr tagListPtr2) + (cFromEnum mode) + +tagListRemoveTag :: Tag + -> StructureM () +tagListRemoveTag tag = + StructureM $ \tagList -> + withUTFString tag $ \cTag -> + withTagList tagList $ \tagListPtr -> + {# call tag_list_remove_tag #} (castPtr tagListPtr) + cTag + +marshalTagListGet :: Storable a + => (Ptr () -> CString -> Ptr a -> IO {# type gboolean #}) + -> (a -> IO b) + -> TagList + -> Tag + -> Maybe b +marshalTagListGet getAction convert tagList tag = + unsafePerformIO $ alloca $ \valuePtr -> + withTagList tagList $ \tagListPtr -> + withUTFString tag $ \cTag -> + do success <- getAction (castPtr tagListPtr) + cTag + valuePtr + if toBool success + then liftM Just $ peek valuePtr >>= convert + else return Nothing + +marshalTagListGetIndex :: Storable a + => (Ptr () -> CString -> {# type guint #} -> Ptr a -> IO {# type gboolean #}) + -> (a -> IO b) + -> TagList + -> Tag + -> Word + -> Maybe b +marshalTagListGetIndex getAction convert tagList tag index = + unsafePerformIO $ alloca $ \valuePtr -> + withTagList tagList $ \tagListPtr -> + withUTFString tag $ \cTag -> + do success <- getAction (castPtr tagListPtr) + cTag + (fromIntegral index) + valuePtr + if toBool success + then liftM Just $ peek valuePtr >>= convert + else return Nothing + +tagListGetChar :: TagList + -> Tag + -> Maybe Char +tagListGetChar = + marshalTagListGet {# call tag_list_get_char #} $ return . chr . fromIntegral + +tagListGetCharIndex :: TagList + -> Tag + -> Word + -> Maybe Char +tagListGetCharIndex = + marshalTagListGetIndex {# call tag_list_get_char_index #} $ return . chr . fromIntegral + +tagListGetUChar :: TagList + -> Tag + -> Maybe Word8 +tagListGetUChar = + marshalTagListGet {# call tag_list_get_uchar #} $ return . fromIntegral + +tagListGetUCharIndex :: TagList + -> Tag + -> Word + -> Maybe Word8 +tagListGetUCharIndex = + marshalTagListGetIndex {# call tag_list_get_uchar_index #} $ return . fromIntegral + +tagListGetBool :: TagList + -> Tag + -> Maybe Bool +tagListGetBool = + marshalTagListGet {# call tag_list_get_boolean #} $ return . toBool + +tagListGetBoolIndex :: TagList + -> Tag + -> Word + -> Maybe Bool +tagListGetBoolIndex = + marshalTagListGetIndex {# call tag_list_get_boolean_index #} $ return . toBool + +tagListGetInt :: TagList + -> Tag + -> Maybe Int +tagListGetInt = + marshalTagListGet {# call tag_list_get_int #} $ return . fromIntegral + +tagListGetIntIndex :: TagList + -> Tag + -> Word + -> Maybe Int +tagListGetIntIndex = + marshalTagListGetIndex {# call tag_list_get_int_index #} $ return . fromIntegral + +tagListGetUInt :: TagList + -> Tag + -> Maybe Word +tagListGetUInt = + marshalTagListGet {# call tag_list_get_uint #} $ return . fromIntegral + +tagListGetUIntIndex :: TagList + -> Tag + -> Word + -> Maybe Word +tagListGetUIntIndex = + marshalTagListGetIndex {# call tag_list_get_uint_index #} $ return . fromIntegral + +tagListGetLong :: TagList + -> Tag + -> Maybe Int64 +tagListGetLong = + marshalTagListGet {# call tag_list_get_long #} $ return . fromIntegral + +tagListGetLongIndex :: TagList + -> Tag + -> Word + -> Maybe Int64 +tagListGetLongIndex = + marshalTagListGetIndex {# call tag_list_get_long_index #} $ return . fromIntegral + +tagListGetULong :: TagList + -> Tag + -> Maybe Word64 +tagListGetULong = + marshalTagListGet {# call tag_list_get_ulong #} $ return . fromIntegral + +tagListGetULongIndex :: TagList + -> Tag + -> Word + -> Maybe Word64 +tagListGetULongIndex = + marshalTagListGetIndex {# call tag_list_get_ulong_index #} $ return . fromIntegral + + +tagListGetInt64 :: TagList + -> Tag + -> Maybe Int64 +tagListGetInt64 = + marshalTagListGet {# call tag_list_get_int64 #} $ return . fromIntegral + +tagListGetInt64Index :: TagList + -> Tag + -> Word + -> Maybe Int64 +tagListGetInt64Index = + marshalTagListGetIndex {# call tag_list_get_int64_index #} $ return . fromIntegral + +tagListGetUInt64 :: TagList + -> Tag + -> Maybe Word64 +tagListGetUInt64 = + marshalTagListGet {# call tag_list_get_uint64 #} $ return . fromIntegral + +tagListGetUInt64Index :: TagList + -> Tag + -> Word + -> Maybe Word64 +tagListGetUInt64Index = + marshalTagListGetIndex {# call tag_list_get_uint64_index #} $ return . fromIntegral + +tagListGetFloat :: TagList + -> Tag + -> Maybe Float +tagListGetFloat = + marshalTagListGet {# call tag_list_get_float #} $ return . realToFrac + +tagListGetFloatIndex :: TagList + -> Tag + -> Word + -> Maybe Float +tagListGetFloatIndex = + marshalTagListGetIndex {# call tag_list_get_float_index #} $ return . realToFrac + +tagListGetDouble :: TagList + -> Tag + -> Maybe Double +tagListGetDouble = + marshalTagListGet {# call tag_list_get_double #} $ return . realToFrac + +tagListGetDoubleIndex :: TagList + -> Tag + -> Word + -> Maybe Double +tagListGetDoubleIndex = + marshalTagListGetIndex {# call tag_list_get_double_index #} $ return . realToFrac + +tagListGetString :: TagList + -> Tag + -> Maybe String +tagListGetString = + marshalTagListGet {# call tag_list_get_string #} readUTFString + +tagListGetStringIndex :: TagList + -> Tag + -> Word + -> Maybe String +tagListGetStringIndex = + marshalTagListGetIndex {# call tag_list_get_string_index #} readUTFString + +tagListGetDate :: TagList + -> Tag + -> Maybe GDate +tagListGetDate = + marshalTagListGet {# call tag_list_get_date #} $ peek . castPtr + +tagListGetDateIndex :: TagList + -> Tag + -> Word + -> Maybe GDate +tagListGetDateIndex = + marshalTagListGetIndex {# call tag_list_get_date_index #} $ peek . castPtr + diff --git a/Media/Streaming/GStreamer/Core/Types.chs b/Media/Streaming/GStreamer/Core/Types.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Core/Types.chs @@ -0,0 +1,772 @@ +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel\@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Core.Types ( + + module Media.Streaming.GStreamer.Core.Constants, + module Media.Streaming.GStreamer.Core.Hierarchy, + module Media.Streaming.GStreamer.Core.HierarchyBase, + module Media.Streaming.GStreamer.Core.MiniHierarchy, + module Media.Streaming.GStreamer.Core.MiniHierarchyBase, + + cToFlags, + cFromFlags, + cToEnum, + cFromEnum, + + FourCC, + Fraction, + + FormatDefinition(..), + + mkObjectGetFlags, + mkObjectSetFlags, + mkObjectUnsetFlags, + + withObject, + peekObject, + takeObject, + giveObject, + + PadDirection(..), + PadPresence(..), + PadLinkReturn(..), + FlowReturn(..), + ActivateMode(..), + StaticPadTemplate {-(..)-}, + staticPadTemplateGet, + + State(..), + StateChangeReturn(..), + SeekFlags(..), + SeekType(..), + + PluginFilter, + PluginFeatureFilter, + + BusFunc, + BusSyncHandler, + BusSyncReply(..), + + ClockTimeDiff, + ClockReturn(..), + ClockID(..), + withClockID, + takeClockID, + peekClockID, + + IndexCertainty(..), + IndexEntry(..), + takeIndexEntry, + peekIndexEntry, + IndexEntryType(..), + + IndexLookupMethod(..), + IndexFilter, + IndexAssociation(..), + AssocFlags(..), + + withMiniObject, + peekMiniObject, + takeMiniObject, + giveMiniObject, + MiniObjectT(..), + askMiniObjectPtr, + runMiniObjectT, + marshalMiniObjectModify, + mkMiniObjectGetFlags, + mkMiniObjectGetFlagsM, + mkMiniObjectSetFlagsM, + mkMiniObjectUnsetFlagsM, + + QueryType, + QueryTypeDefinition(..), + + EventTypeFlags(..), + + PtrIterator(..), + Iterator(..), + IteratorItem(..), + IteratorResult(..), + Iterable(..), + IteratorFilter, + IteratorFoldFunction, + withIterator, + takeIterator, + peekIterator, + -- giveIterator - not defined - iterators don't have a refcount and + -- are not copyable + + Caps(..), + mkCaps, + unCaps, + withCaps, + takeCaps, + peekCaps, + giveCaps, + + Structure(..), + StructureForeachFunc, + withStructure, + takeStructure, + peekStructure, + giveStructure, + StructureM(..), + StructureMRep, + + TagList, + withTagList, + takeTagList, + peekTagList, + giveTagList, + Tag, + TagFlag, + TagMergeMode, + + Segment(..), + + ) where + +import Control.Monad ( liftM ) +import Control.Monad.Reader +import Control.Monad.Trans +import Data.Ratio ( Ratio ) +import System.Glib.FFI +import System.Glib.Flags +{#import System.Glib.GType#} +{#import System.Glib.GObject#} +{#import System.Glib.GValue#} +import System.Glib.UTFString +import Media.Streaming.GStreamer.Core.Constants +import Media.Streaming.GStreamer.Core.HierarchyBase +{#import Media.Streaming.GStreamer.Core.MiniHierarchyBase#} +{#import Media.Streaming.GStreamer.Core.Hierarchy#} +{#import Media.Streaming.GStreamer.Core.MiniHierarchy#} + +{# context lib = "gstreamer" prefix = "gst" #} + +type FourCC = Word32 +type Fraction = Ratio Int + +{# enum GstParseError as ParseError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +cToFlags :: (Integral int, Flags flags) + => int + -> [flags] +cToFlags = toFlags . fromIntegral +cFromFlags :: (Integral int, Flags flags) + => [flags] + -> int +cFromFlags = fromIntegral . fromFlags + +cToEnum :: (Integral int, Enum enum) + => int + -> enum +cToEnum = toEnum . fromIntegral +cFromEnum :: (Integral int, Enum enum) + => enum + -> int +cFromEnum = fromIntegral . fromEnum + +-------------------------------------------------------------------- + +-- | A format definition. +data FormatDefinition = FormatDefinition { formatValue :: FormatId -- ^ the unique id of this format + , formatNick :: String -- ^ a short nickname for the format + , formatDescription :: String -- ^ a longer description of the format + , formatQuark :: Quark -- ^ a quark for the nickname + } deriving (Eq, Show) +instance Storable FormatDefinition where + sizeOf = undefined + alignment = undefined + peek ptr = + do value <- liftM (FormatId . fromIntegral) $ {# get GstFormatDefinition->value #} ptr + nick <- {# get GstFormatDefinition->nick #} ptr >>= peekUTFString + description <- {# get GstFormatDefinition->description #} ptr >>= peekUTFString + quark <- {# get GstFormatDefinition->quark #} ptr + return $ FormatDefinition value nick description quark + poke _ _ = undefined +instance Iterable FormatDefinition where + peekIterable = peek . castPtr + withIterable = with + +-------------------------------------------------------------------- + +withObject :: ObjectClass objectT + => objectT + -> (Ptr objectT -> IO a) + -> IO a +withObject object action = + let objectFPtr = unObject $ toObject object + in withForeignPtr (castForeignPtr objectFPtr) action + +peekObject, takeObject :: ObjectClass obj + => Ptr obj + -> IO obj +peekObject cObject = do + liftM (unsafeCastGObject . GObject . castForeignPtr) $ + do cObjectRef $ castPtr cObject + newForeignPtr (castPtr cObject) objectFinalizer +foreign import ccall unsafe "&gst_object_unref" + objectFinalizer :: FunPtr (Ptr () -> IO ()) +foreign import ccall unsafe "gst_object_ref" + cObjectRef :: Ptr () + -> IO (Ptr ()) + +takeObject cObject = + liftM (unsafeCastGObject . GObject . castForeignPtr) $ + do cObjectUnfloat $ castPtr cObject + newForeignPtr (castPtr cObject) objectFinalizer +foreign import ccall unsafe "_hs_gst_object_unfloat" + cObjectUnfloat :: Ptr () + -> IO () + +mkObjectGetFlags :: (ObjectClass objectT, Flags flagsT) + => objectT + -> IO [flagsT] +mkObjectGetFlags object = + liftM cToFlags $ + withObject (toObject object) cObjectGetFlags +foreign import ccall unsafe "_hs_gst_object_flags" + cObjectGetFlags :: Ptr Object + -> IO CUInt + +mkObjectSetFlags :: (ObjectClass objectT, Flags flagsT) + => objectT + -> [flagsT] + -> IO () +mkObjectSetFlags object flags = + withObject (toObject object) $ \cObject -> + cObjectSetFlags cObject (fromIntegral $ fromFlags flags) +foreign import ccall unsafe "_hs_gst_object_flag_set" + cObjectSetFlags :: Ptr Object + -> CUInt + -> IO () + +mkObjectUnsetFlags :: (ObjectClass objectT, Flags flagsT) + => objectT + -> [flagsT] + -> IO () +mkObjectUnsetFlags object flags = + withObject (toObject object) $ \cObject -> + cObjectUnsetFlags cObject (fromIntegral $ fromFlags flags) +foreign import ccall unsafe "_hs_gst_object_flag_unset" + cObjectUnsetFlags :: Ptr Object + -> CUInt + -> IO () + +-- | Use 'giveObject' to pass an object to a function that takes +-- ownership of it. +giveObject :: (ObjectClass obj, MonadIO m) + => obj + -> (obj -> m a) + -> m a +giveObject obj action = + do liftIO $ withObject (toObject obj) $ {# call gst_object_ref #} . castPtr + action obj + +-------------------------------------------------------------------- + +{# enum GstPadDirection as PadDirection {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstPadPresence as PadPresence {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstPadLinkReturn as PadLinkReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstFlowReturn as FlowReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstActivateMode as ActivateMode {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +instance Iterable Pad where + peekIterable = peekObject . castPtr + withIterable = withObject + +{# pointer *GstStaticPadTemplate as StaticPadTemplate #} +staticPadTemplateGet :: StaticPadTemplate + -> IO PadTemplate +staticPadTemplateGet staticPadTemplate = + {# call static_pad_template_get #} staticPadTemplate >>= takeObject + +-------------------------------------------------------------------- + +{# enum GstPluginError as PluginError {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +-------------------------------------------------------------------- + +{# enum GstSeekFlags as SeekFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #} +instance Flags SeekFlags +{# enum GstSeekType as SeekType {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstState as State {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +{# enum GstStateChangeReturn as StateChangeReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +instance Iterable Element where + peekIterable = peekObject . castPtr + withIterable = withObject + +-------------------------------------------------------------------- + +type PluginFilter = Plugin -> IO Bool +type PluginFeatureFilter = PluginFeature -> IO Bool + +-------------------------------------------------------------------- + +{# enum GstBusSyncReply as BusSyncReply {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +type BusFunc = Bus + -> Message + -> IO Bool +type BusSyncHandler = Bus + -> Message + -> IO BusSyncReply + +-------------------------------------------------------------------- + +type ClockTimeDiff = Int64 + +{# enum GstClockReturn as ClockReturn {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +{# pointer *GstClockID as ClockID foreign newtype #} +withClockID :: ClockID + -> (Ptr ClockID -> IO a) + -> IO a +withClockID (ClockID clockID) = withForeignPtr clockID +takeClockID, peekClockID :: Ptr ClockID + -> IO ClockID +takeClockID clockIDPtr = + liftM ClockID $ newForeignPtr clockIDPtr clockIDFinalizer +peekClockID clockIDPtr = + do {# call clock_id_ref #} $ castPtr clockIDPtr + takeClockID clockIDPtr + +foreign import ccall unsafe "&gst_clock_id_unref" + clockIDFinalizer :: FunPtr (Ptr ClockID -> IO ()) + +-------------------------------------------------------------------- + +{# enum GstIndexCertainty as IndexCertainty {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstIndexEntryType as IndexEntryType {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstIndexLookupMethod as IndexLookupMethod {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +{# pointer *GstIndexEntry as IndexEntry foreign newtype #} + +takeIndexEntry :: Ptr IndexEntry + -> IO IndexEntry +takeIndexEntry ptr = + liftM IndexEntry $ newForeignPtr ptr indexEntryFinalizer +foreign import ccall unsafe "&gst_index_entry_free" + indexEntryFinalizer :: FunPtr (Ptr IndexEntry -> IO ()) +peekIndexEntry :: Ptr IndexEntry + -> IO IndexEntry +peekIndexEntry ptr = + (liftM IndexEntry $ newForeignPtr_ ptr) >>= + {# call index_entry_copy #} >>= + takeIndexEntry + +type IndexFilter = Index + -> IndexEntry + -> IO Bool + +data IndexAssociation = IndexAssociation Format Int64 + deriving (Eq, Show) +instance Storable IndexAssociation where + sizeOf _ = {# sizeof GstIndexAssociation #} + alignment _ = alignment (undefined :: CString) + peek ptr = + do format <- {# get GstIndexAssociation->format #} ptr + value <- {# get GstIndexAssociation->value #} ptr + return $ IndexAssociation (toFormat $ fromIntegral format) (fromIntegral value) + poke ptr (IndexAssociation format value) = + do {# set GstIndexAssociation->format #} ptr $ fromIntegral (fromFormat format) + {# set GstIndexAssociation->value #} ptr $ fromIntegral value + +{# enum GstAssocFlags as AssocFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #} +instance Flags AssocFlags + +-------------------------------------------------------------------- + +withMiniObject :: MiniObjectClass miniObjectT + => miniObjectT + -> (Ptr miniObjectT -> IO a) + -> IO a +withMiniObject miniObject action = + let miniObjectFPtr = unMiniObject $ toMiniObject miniObject + in withForeignPtr (castForeignPtr miniObjectFPtr) action + +takeMiniObject, peekMiniObject :: (MiniObjectClass obj) + => Ptr obj + -> IO obj +peekMiniObject cMiniObject = + do cMiniObjectRef $ castPtr cMiniObject + takeMiniObject cMiniObject +foreign import ccall unsafe "gst_mini_object_ref" + cMiniObjectRef :: Ptr () + -> IO (Ptr ()) + +takeMiniObject cMiniObject = + do cMiniObjectMakeReadOnly $ castPtr cMiniObject + object <- newForeignPtr (castPtr cMiniObject) miniObjectFinalizer + return $ unsafeCastMiniObject $ MiniObject $ castForeignPtr object +foreign import ccall unsafe "&gst_mini_object_unref" + miniObjectFinalizer :: FunPtr (Ptr () -> IO ()) +foreign import ccall unsafe "_hs_gst_mini_object_make_read_only" + cMiniObjectMakeReadOnly :: Ptr MiniObject + -> IO () + +-- | Use 'giveMiniObject' to pass an miniObject to a function that takes +-- ownership of it. +giveMiniObject :: (MiniObjectClass obj, MonadIO m) + => obj + -> (obj -> m a) + -> m a +giveMiniObject obj action = + do liftIO $ {# call gst_mini_object_ref #} (toMiniObject obj) + action obj + +-- | A 'Monad' for sequencing modifications to a 'MiniObject'. +newtype (MiniObjectClass miniObjectT, Monad m) => + MiniObjectT miniObjectT m a = + MiniObjectT (ReaderT (Ptr miniObjectT) m a) + deriving (Functor, Monad, MonadTrans) +instance (MiniObjectClass miniObjectT, Monad m, MonadIO m) => + MonadIO (MiniObjectT miniObjectT m) where + liftIO = MiniObjectT . liftIO + +askMiniObjectPtr :: (MiniObjectClass miniObjectT, Monad m) + => MiniObjectT miniObjectT m (Ptr miniObjectT) +askMiniObjectPtr = MiniObjectT $ ask + +runMiniObjectT :: (MiniObjectClass miniObjectT, Monad m) + => MiniObjectT miniObjectT m a + -> (Ptr miniObjectT) + -> m a +runMiniObjectT (MiniObjectT action) = runReaderT action + +marshalMiniObjectModify :: (MiniObjectClass miniObjectT, MonadIO m) + => m (Ptr miniObjectT) + -> MiniObjectT miniObjectT m a + -> m (miniObjectT, a) +marshalMiniObjectModify mkMiniObject action = + do ptr' <- mkMiniObject + ptr <- liftIO $ liftM castPtr $ gst_mini_object_make_writable $ castPtr ptr' + result <- runMiniObjectT action ptr + object <- liftIO $ takeMiniObject ptr + return (object, result) + where _ = {# call mini_object_make_writable #} + +mkMiniObjectGetFlags :: (MiniObjectClass miniObjectT, Flags flagsT) + => miniObjectT + -> [flagsT] +mkMiniObjectGetFlags miniObject = + cToFlags $ unsafePerformIO $ + withMiniObject (toMiniObject miniObject) cMiniObjectGetFlags +foreign import ccall unsafe "_hs_gst_mini_object_flags" + cMiniObjectGetFlags :: Ptr MiniObject + -> IO CUInt + +mkMiniObjectGetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m) + => MiniObjectT miniObjectT m [flagsT] +mkMiniObjectGetFlagsM = do + ptr <- askMiniObjectPtr + liftIO $ liftM cToFlags $ cMiniObjectGetFlags $ castPtr ptr + +mkMiniObjectSetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m) + => [flagsT] + -> MiniObjectT miniObjectT m () +mkMiniObjectSetFlagsM flags = do + ptr <- askMiniObjectPtr + liftIO $ cMiniObjectSetFlags (castPtr ptr) $ cFromFlags flags +foreign import ccall unsafe "_hs_gst_mini_object_flag_set" + cMiniObjectSetFlags :: Ptr MiniObject + -> CUInt + -> IO () + +mkMiniObjectUnsetFlagsM :: (MiniObjectClass miniObjectT, Flags flagsT, MonadIO m) + => [flagsT] + -> MiniObjectT miniObjectT m () +mkMiniObjectUnsetFlagsM flags = do + ptr <- askMiniObjectPtr + liftIO $ cMiniObjectUnsetFlags (castPtr ptr) $ cFromFlags flags +foreign import ccall unsafe "_hs_gst_mini_object_flag_unset" + cMiniObjectUnsetFlags :: Ptr MiniObject + -> CUInt + -> IO () + +-------------------------------------------------------------------- + +type QueryType = {# type GstQueryType #} +data QueryTypeDefinition = QueryTypeDefinition { + queryTypeDefinitionValue :: QueryType, + queryTypeDefinitionNick :: String, + queryTypeDefinitionDescription :: String, + queryTypeDefinitionQuark :: Quark + } deriving (Eq, Show) +instance Storable QueryTypeDefinition where + sizeOf _ = {# sizeof GstQuery #} + alignment _ = alignment (undefined :: CString) + peek ptr = + do value <- {# get GstQueryTypeDefinition->value #} ptr + nick <- {# get GstQueryTypeDefinition->nick #} ptr >>= peekUTFString + description <- {# get GstQueryTypeDefinition->description #} ptr >>= peekUTFString + quark <- {# get GstQueryTypeDefinition->quark #} ptr + return $ QueryTypeDefinition value + nick + description + quark + poke _ _ = undefined +instance Iterable QueryTypeDefinition where + peekIterable = peek . castPtr + withIterable = with + +-------------------------------------------------------------------- + +{# enum GstEventTypeFlags as EventTypeFlags {underscoreToCase} with prefix = "GST" deriving (Eq, Bounded, Show) #} +instance Flags EventTypeFlags + +-------------------------------------------------------------------- + +{# pointer *GstIterator as PtrIterator foreign newtype #} + +withPtrIterator :: PtrIterator + -> (Ptr PtrIterator -> IO a) + -> IO a +withPtrIterator (PtrIterator cPtrIterator) = withForeignPtr cPtrIterator + +takePtrIterator, peekPtrIterator :: Ptr PtrIterator + -> IO PtrIterator +takePtrIterator ptrIteratorPtr = + liftM PtrIterator $ newForeignPtr ptrIteratorPtr ptrIteratorFinalizer +peekPtrIterator ptrIteratorPtr = + liftM PtrIterator $ newForeignPtr_ ptrIteratorPtr + +foreign import ccall unsafe "&gst_iterator_free" + ptrIteratorFinalizer :: FunPtr (Ptr PtrIterator -> IO ()) + +{# enum GstIteratorItem as IteratorItem {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstIteratorResult as IteratorResult {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +mkIterator newPtrIterator cPtrIterator = + do ptrIterator <- newPtrIterator cPtrIterator + return $ Iterator ptrIterator + +newtype Iterable a => Iterator a = Iterator PtrIterator + +withIterator :: Iterator a + -> (Ptr PtrIterator -> IO a) + -> IO a +withIterator (Iterator ptrIterator) = withPtrIterator ptrIterator + +takeIterator, peekIterator :: Ptr PtrIterator + -> IO (Iterator a) +takeIterator cPtrIterator = mkIterator takePtrIterator cPtrIterator +peekIterator cPtrIterator = mkIterator peekPtrIterator cPtrIterator + +class Iterable a where + peekIterable :: Ptr () + -> IO a + withIterable :: a + -> (Ptr a -> IO b) + -> IO b + +type IteratorFilter itemT = itemT + -> IO Bool +type IteratorFoldFunction itemT accumT = itemT + -> accumT + -> IO (Bool, accumT) + +-------------------------------------------------------------------- + +{# pointer *GstCaps as Caps foreign newtype #} +mkCaps :: ForeignPtr Caps -> Caps +mkCaps = Caps +unCaps :: Caps -> ForeignPtr Caps +unCaps (Caps caps) = caps + +withCaps :: Caps -> (Ptr Caps -> IO a) -> IO a +withCaps = withForeignPtr . unCaps + +takeCaps, peekCaps :: Ptr Caps + -> IO Caps +takeCaps capsPtr = + liftM Caps $ newForeignPtr capsPtr capsFinalizer +peekCaps capsPtr = + cCapsRef capsPtr >>= takeCaps +foreign import ccall unsafe "gst_caps_ref" + cCapsRef :: Ptr Caps + -> IO (Ptr Caps) + +giveCaps :: MonadIO m + => Caps + -> (Caps -> m a) + -> m a +giveCaps caps action = + do liftIO $ {# call caps_ref #} caps + action caps + +foreign import ccall unsafe "&gst_caps_unref" + capsFinalizer :: FunPtr (Ptr Caps -> IO ()) + +-------------------------------------------------------------------- + +{# pointer *GstStructure as Structure foreign newtype #} +mkStructure :: ForeignPtr Structure -> Structure +mkStructure = Structure +unStructure :: Structure -> ForeignPtr Structure +unStructure (Structure structure) = structure + +withStructure :: Structure -> (Ptr Structure -> IO a) -> IO a +withStructure = withForeignPtr . unStructure + +mkNewStructure :: (Ptr Structure -> IO (ForeignPtr Structure)) + -> Ptr Structure + -> IO Structure +mkNewStructure mkFP structurePtr = + do cStructureMakeImmutable structurePtr + liftM Structure $ mkFP structurePtr +foreign import ccall unsafe "_hs_gst_structure_make_immutable" + cStructureMakeImmutable :: Ptr Structure + -> IO () + +takeStructure, peekStructure :: Ptr Structure + -> IO Structure +takeStructure = + mkNewStructure $ flip newForeignPtr structureFinalizer +peekStructure ptr = do + copy <- gst_structure_copy ptr + takeStructure copy + where _ = {#call structure_copy#} + +giveStructure :: MonadIO m + => Structure + -> (Structure -> m a) + -> m a +giveStructure structure action = + do structure <- liftIO $ liftM Structure $ + {# call structure_copy #} structure >>= newForeignPtr_ + action structure + +foreign import ccall unsafe "&gst_structure_free" + structureFinalizer :: FunPtr (Ptr Structure -> IO ()) + +type StructureForeachFunc = Quark + -> GValue + -> IO Bool + +newtype StructureM a = StructureM (StructureMRep a) +type StructureMRep a = (Structure -> IO a) + +instance Monad StructureM where + (StructureM aM) >>= fbM = + StructureM $ \structure -> + do a <- aM structure + let StructureM bM = fbM a + bM structure + return a = StructureM $ const $ return a + +-------------------------------------------------------------------- + +type TagList = Structure +mkTagList = mkStructure +unTagList = unStructure +withTagList = withStructure +takeTagList = takeStructure +peekTagList = takeStructure +giveTagList :: MonadIO m + => TagList + -> (TagList -> m a) + -> m a +giveTagList = giveStructure + +type Tag = String + +{# enum GstTagFlag as TagFlag {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} +{# enum GstTagMergeMode as TagMergeMode {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} + +-------------------------------------------------------------------- + +data Segment = Segment { segmentRate :: Double + , segmentAbsRate :: Double + , segmentFormat :: Format + , segmentFlags :: [SeekFlags] + , segmentStart :: Int64 + , segmentStop :: Int64 + , segmentTime :: Int64 + , segmentAccum :: Int64 + , segmentLastStop :: Int64 + , segmentDuration :: Int64 } + deriving (Eq, Show) +instance Storable Segment where + sizeOf _ = fromIntegral cSegmentSizeof + alignment _ = alignment (undefined :: CString) + peek ptr = + do rate <- {# get GstSegment->rate #} ptr + absRate <- {# get GstSegment->abs_rate #} ptr + format <- {# get GstSegment->format #} ptr + flags <- {# get GstSegment->flags #} ptr + start <- {# get GstSegment->start #} ptr + stop <- {# get GstSegment->stop #} ptr + time <- {# get GstSegment->time #} ptr + accum <- {# get GstSegment->accum #} ptr + lastStop <- {# get GstSegment->last_stop #} ptr + duration <- {# get GstSegment->duration #} ptr + return $ Segment (realToFrac rate) + (realToFrac absRate) + (toFormat $ fromIntegral format) + (cToFlags flags) + (fromIntegral start) + (fromIntegral stop) + (fromIntegral time) + (fromIntegral accum) + (fromIntegral lastStop) + (fromIntegral duration) + poke ptr (Segment rate + absRate + format + flags + start + stop + time + accum + lastStop + duration) = + do {# call segment_init #} (castPtr ptr) + (fromIntegral $ fromFormat format) + {# set GstSegment->rate #} ptr $ realToFrac rate + {# set GstSegment->abs_rate #} ptr $ realToFrac absRate + {# set GstSegment->format #} ptr $ fromIntegral (fromFormat format) + {# set GstSegment->flags #} ptr $ fromIntegral $ fromFlags flags + {# set GstSegment->start #} ptr $ fromIntegral start + {# set GstSegment->stop #} ptr $ fromIntegral stop + {# set GstSegment->time #} ptr $ fromIntegral time + {# set GstSegment->accum #} ptr $ fromIntegral accum + {# set GstSegment->last_stop #} ptr $ fromIntegral lastStop + {# set GstSegment->duration #} ptr $ fromIntegral duration +foreign import ccall unsafe "_hs_gst_segment_sizeof" + cSegmentSizeof :: {# type gsize #} + +-------------------------------------------------------------------- diff --git a/Media/Streaming/GStreamer/DataProtocol/Constants.hsc b/Media/Streaming/GStreamer/DataProtocol/Constants.hsc new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/DataProtocol/Constants.hsc @@ -0,0 +1,47 @@ +-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*- + +#include "hsgstreamer.h" +#include "template-hsc-gtk2hs.h" + +-- +-- 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 +-- . +-- +-- 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.DataProtocol.Constants ( + DPHeaderFlag(..) + ) where + +data DPHeaderFlag = DPHeaderCRCHeader + | DPHeaderCRCPayload + | DPHeaderCRC + deriving (Eq, Bounded, Show) +instance Enum DPHeaderFlag where + toEnum n | n == #{const GST_DP_HEADER_FLAG_CRC_HEADER} = DPHeaderCRCHeader + | n == #{const GST_DP_HEADER_FLAG_CRC_PAYLOAD} = DPHeaderCRCPayload + | n == #{const GST_DP_HEADER_FLAG_CRC} = DPHeaderCRC + fromEnum DPHeaderCRCHeader = #{const GST_DP_HEADER_FLAG_CRC_HEADER} + fromEnum DPHeaderCRCPayload = #{const GST_DP_HEADER_FLAG_CRC_PAYLOAD} + fromEnum DPHeaderCRC = #{const GST_DP_HEADER_FLAG_CRC} diff --git a/Media/Streaming/GStreamer/DataProtocol/DataProtocol.chs b/Media/Streaming/GStreamer/DataProtocol/DataProtocol.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/DataProtocol/DataProtocol.chs @@ -0,0 +1,47 @@ +{-# 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 +-- . +-- +-- 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.DataProtocol.DataProtocol ( + ) where + +{# import Media.Streaming.GStreamer.Core.Types #} +import Media.Streaming.GStreamer.DataProtocol.Constants +import System.Glib.FFI + +{# context lib = "gstreamer" prefix = "gst" #} + +{# enum GstDPPayloadType as DPPayloadType {underscoreToCase} with prefix = "GST" #} +#if GST_CHECK_VERSION(0,10,7) +{# enum GstDPVersion as DPVersion {underscoreToCase} with prefix = "GST" #} + +{# pointer *GstDPPacketizer as DPPacketizer #} +#endif + +dpInit :: IO () +dpInit = {# call dp_init #} diff --git a/Media/Streaming/GStreamer/Net/NetClientClock.chs b/Media/Streaming/GStreamer/Net/NetClientClock.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Net/NetClientClock.chs @@ -0,0 +1,50 @@ +-- 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 +-- . +-- +-- 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.Net.NetClientClock ( + ) where + +{#import Media.Streaming.GStreamer.Net.Types#} +import System.Glib.FFI +import System.Glib.UTFString + +{# context lib = "gstreamer" prefix = "gst" #} + +netClientClockNew :: String + -> String + -> Int + -> ClockTime + -> IO Clock +netClientClockNew name remoteAddress remotePort baseTime = + withUTFString name $ \cName -> + withUTFString remoteAddress $ \cRemoteAddress -> + {# call net_client_clock_new #} cName + cRemoteAddress + (fromIntegral remotePort) + (fromIntegral baseTime) >>= + takeObject diff --git a/Media/Streaming/GStreamer/Net/Types.chs b/Media/Streaming/GStreamer/Net/Types.chs new file mode 100644 --- /dev/null +++ b/Media/Streaming/GStreamer/Net/Types.chs @@ -0,0 +1,38 @@ +{-# OPTIONS_HADDOCK hide #-} +-- 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 +-- . +-- +-- 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. + +-- #hide + +-- | Maintainer : gtk2hs-devel@lists.sourceforge.net +-- Stability : alpha +-- Portability : portable (depends on GHC) +module Media.Streaming.GStreamer.Net.Types ( + + module Media.Streaming.GStreamer.Core.Types, + + ) where + +{#import Media.Streaming.GStreamer.Core.Types#} diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +-- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module, +-- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept +-- identical across all modules. +import Gtk2HsSetup ( gtk2hsUserHooks ) +import Distribution.Simple ( defaultMainWithHooks ) + +main = defaultMainWithHooks gtk2hsUserHooks diff --git a/gstreamer.cabal b/gstreamer.cabal new file mode 100644 --- /dev/null +++ b/gstreamer.cabal @@ -0,0 +1,131 @@ +Name: gstreamer +Version: 0.11.0 +License: LGPL-2.1 +License-file: COPYING +Copyright: (c) 2001-2010 The Gtk2Hs Team +Author: Peter Gavin, Axel Simon +Maintainer: gtk2hs-users@sourceforge.net +Build-Type: Custom +Cabal-Version: >= 1.6 +Stability: stable +homepage: http://www.haskell.org/gtk2hs/ +bug-reports: http://hackage.haskell.org/trac/gtk2hs/ +Synopsis: Binding to the GStreamer open source multimedia framework. +Description: This package provides a wrapper around the GStreamer C library. GStreamer is a library + for constructing graphs of media-handling components. The applications it supports + range from simple Ogg/Vorbis playback, audio/video streaming to complex audio + (mixing) and video (non-linear editing) processing. +Category: Media +Tested-With: GHC == 6.10.4 +extra-source-files: template-hsc-gtk2hs.h + hsgstreamer.h + hsgstreamer.c + mini-hierarchy.list + hierarchy.list + marshal.list + Gtk2HsSetup.hs + +x-Types-Main-File: Media/Streaming/GStreamer/Core/Hierarchy.chs +x-Types-Main-ModName: Media.Streaming.GStreamer.Core.Hierarchy +x-Types-Main-Forward: *System.Glib.GObject +x-Types-Main-Hierarchy: hierarchy.list +x-Types-Main-Lib: gstreamer + +-- GStreamer has a second object hierarchy called "Mini". (The name "Mini" in +-- the tags is arbitrary; any other name would.) +x-Types-Mini-File: Media/Streaming/GStreamer/Core/MiniHierarchy.chs +x-Types-Mini-ModName: Media.Streaming.GStreamer.Core.MiniHierarchy +x-Types-Mini-Forward: *Media.Streaming.GStreamer.Core.MiniHierarchyBase +x-Types-Mini-Root: MiniObject +x-Types-Mini-Prefix: gst +x-Types-Mini-Hierarchy: mini-hierarchy.list +x-Types-Mini-Tag: default +x-Types-Mini-Destructor: miniObjectUnref +x-Types-Mini-Lib: gstreamer + +Source-Repository head + type: darcs + location: http://code.haskell.org/gtk2hs/gstreamer + +Library + build-depends: base >= 3 && < 5, + directory, array, haskell98, bytestring, mtl, + glib >= 0.11 && < 0.12 + + build-tools: gtk2hsC2hs, gtk2hsTypeGen, gtk2hsHookGenerator + + exposed-modules: + Media.Streaming.GStreamer.Core.Signals + Media.Streaming.GStreamer.Core.Hierarchy + Media.Streaming.GStreamer.Core.MiniHierarchy + Media.Streaming.GStreamer.Core.Types + Media.Streaming.GStreamer.Core.Constants + Media.Streaming.GStreamer.Core.Init + Media.Streaming.GStreamer.Core.Object + Media.Streaming.GStreamer.Core.HierarchyBase + Media.Streaming.GStreamer.Core.MiniObject + Media.Streaming.GStreamer.Core.MiniHierarchyBase + Media.Streaming.GStreamer.Core.Element + Media.Streaming.GStreamer.Core.Pad + Media.Streaming.GStreamer.Core.GhostPad + Media.Streaming.GStreamer.Core.Bin + Media.Streaming.GStreamer.Core.Format + Media.Streaming.GStreamer.Core.ElementFactory + Media.Streaming.GStreamer.Core.Caps + Media.Streaming.GStreamer.Core.Structure + Media.Streaming.GStreamer.Core.Message + Media.Streaming.GStreamer.Core.Buffer + Media.Streaming.GStreamer.Core.Event + Media.Streaming.GStreamer.Core.Query + Media.Streaming.GStreamer.Core.Bus + Media.Streaming.GStreamer.Core.Clock + Media.Streaming.GStreamer.Core.PadTemplate + Media.Streaming.GStreamer.Core.ImplementsInterface + Media.Streaming.GStreamer.Core.Index + Media.Streaming.GStreamer.Core.IndexFactory + Media.Streaming.GStreamer.Core.Iterator + Media.Streaming.GStreamer.Core.Parse + Media.Streaming.GStreamer.Core.Pipeline + Media.Streaming.GStreamer.Core.Plugin + Media.Streaming.GStreamer.Core.PluginFeature + Media.Streaming.GStreamer.Core.Registry + Media.Streaming.GStreamer.Core.Segment + Media.Streaming.GStreamer.Core.SystemClock + Media.Streaming.GStreamer.Core.TagList + Media.Streaming.GStreamer.Core + Media.Streaming.GStreamer.Base.Constants + Media.Streaming.GStreamer.Base.Types + Media.Streaming.GStreamer.Base.BaseSrc + Media.Streaming.GStreamer.Base.BaseSink + Media.Streaming.GStreamer.Base.BaseTransform + Media.Streaming.GStreamer.Base.PushSrc + Media.Streaming.GStreamer.Base.Adapter + Media.Streaming.GStreamer.Base.CollectPads + Media.Streaming.GStreamer.Base + Media.Streaming.GStreamer.Controller.Types + Media.Streaming.GStreamer.Controller.Controller + Media.Streaming.GStreamer.Net.Types + Media.Streaming.GStreamer.Net.NetClientClock + Media.Streaming.GStreamer.DataProtocol.Constants + Media.Streaming.GStreamer.DataProtocol.DataProtocol + Media.Streaming.GStreamer.Audio.Constants + Media.Streaming.GStreamer.Audio.Types + Media.Streaming.GStreamer.Audio.Audio + Media.Streaming.GStreamer.Audio.AudioClock + Media.Streaming.GStreamer + x-Signals-File: Media/Streaming/GStreamer/Core/Signals.chs + x-Signals-Modname: Media.Streaming.GStreamer.Core.Signals + x-Signals-Types: marshal.list + extensions: ForeignFunctionInterface + x-c2hs-Header: hsgstreamer.h + includes: hsgstreamer.h + include-dirs: . + c-sources: hsgstreamer.c + pkgconfig-depends: gstreamer-0.10 >= 0.10, + gstreamer-audio-0.10 >= 0.10, + gstreamer-base-0.10 >= 0.10, + gstreamer-controller-0.10 >= 0.10, + gstreamer-dataprotocol-0.10 >= 0.10, + gstreamer-net-0.10 >= 0.10, + gstreamer-plugins-base-0.10 + diff --git a/hierarchy.list b/hierarchy.list new file mode 100644 --- /dev/null +++ b/hierarchy.list @@ -0,0 +1,54 @@ +# This list is the result of a copy-and-paste from the GtkObject hierarchy +# html documentation. Deprecated widgets are uncommented. Some additional +# object have been defined at the end of the copied list. + +# The Gtk prefix of every object is removed, the other prefixes are +# kept. The indentation implies the object hierarchy. In case the +# type query function cannot be derived from the name or the type name +# is different, an alternative name and type query function can be +# specified by appending 'as typename, '. In case this +# function is not specified, the is converted to +# gtk__get_type where is where each upperscore +# letter is converted to an underscore and lowerletter. The underscore +# is omitted if an upperscore letter preceeded: GtkHButtonBox -> +# gtk_hbutton_box_get_type. The generation of a type can be +# conditional by appending 'if '. Such types are only produces if +# --tag= is given on the command line of TypeGenerator. + + + GObject + +## GStreamer classes + GstObject as Object, gst_object_get_type if gstreamer + GstPad as Pad, gst_pad_get_type if gstreamer + GstGhostPad as GhostPad, gst_ghost_pad_get_type if gstreamer + GstPluginFeature as PluginFeature, gst_plugin_feature_get_type if gstreamer + GstElementFactory as ElementFactory, gst_element_factory_get_type if gstreamer + GstTypeFindFactory as TypeFindFactory, gst_type_find_factory_get_type if gstreamer + GstIndexFactory as IndexFactory, gst_index_factory_get_type if gstreamer + GstElement as Element, gst_element_get_type if gstreamer + GstBin as Bin, gst_bin_get_type if gstreamer + GstPipeline as Pipeline, gst_pipeline_get_type if gstreamer + GstImplementsInterface as ImplementsInterface, gst_implements_interface_get_type if gstreamer + GstTagSetter as TagSetter, gst_tag_setter_get_type if gstreamer + GstBaseSrc as BaseSrc, gst_base_src_get_type if gstreamer + GstPushSrc as PushSrc, gst_push_src_get_type if gstreamer + GstBaseSink as BaseSink, gst_base_sink_get_type if gstreamer + GstBaseTransform as BaseTransform, gst_base_transform_get_type if gstreamer + GstPlugin as Plugin, gst_plugin_get_type if gstreamer + GstRegistry as Registry, gst_registry_get_type if gstreamer + GstBus as Bus, gst_bus_get_type if gstreamer + GstClock as Clock, gst_clock_get_type if gstreamer + GstAudioClock as AudioClock, gst_audio_clock_get_type if gstreamer + GstSystemClock as SystemClock, gst_system_clock_get_type if gstreamer + GstNetClientClock as NetClientClock, gst_net_client_clock_get_type if gstreamer + GstIndex as Index, gst_index_get_type if gstreamer + GstPadTemplate as PadTemplate, gst_pad_template_get_type if gstreamer + GstTask as Task, gst_task_get_type if gstreamer + GstXML as XML, gst_xml_get_type if gstreamer + GstChildProxy as ChildProxy, gst_child_proxy_get_type if gstreamer + GstCollectPads as CollectPads, gst_collect_pads_get_type if gstreamer +## these are actually GInterfaces + GstURIHandler as URIHandler, gst_uri_handler_get_type if gstreamer + GstAdapter as Adapter, gst_adapter_get_type if gstreamer + GstController as Controller, gst_controller_get_type if gstreamer diff --git a/hsgstreamer.c b/hsgstreamer.c new file mode 100644 --- /dev/null +++ b/hsgstreamer.c @@ -0,0 +1,90 @@ +/* GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer + * + * 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 + * . + * + * 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. + */ +#include "hsgstreamer.h" + +guint _hs_gst_object_flags (GstObject* obj) +{ return GST_OBJECT_FLAGS (obj); } +void _hs_gst_object_flag_set (GstObject* obj, guint flags) +{ GST_OBJECT_FLAG_SET (obj, flags); } +void _hs_gst_object_flag_unset (GstObject* obj, guint flags) +{ GST_OBJECT_FLAG_UNSET (obj, flags); } + +void _hs_gst_object_lock (GstObject* obj) +{ GST_OBJECT_LOCK (obj); } +gboolean _hs_gst_object_trylock (GstObject* obj) +{ return GST_OBJECT_TRYLOCK (obj); } +void _hs_gst_object_unlock (GstObject* obj) +{ return GST_OBJECT_UNLOCK (obj); } + +void _hs_gst_object_unfloat (gpointer obj) +{ + GST_OBJECT_LOCK (obj); + + GST_OBJECT_FLAG_UNSET (obj, GST_OBJECT_FLOATING); + + GST_OBJECT_UNLOCK (obj); +} + +GstMessageType _hs_gst_message_get_message_type (GstMessage *message) +{ return GST_MESSAGE_TYPE (message); } + +void _hs_gst_structure_make_immutable (GstStructure *structure) +{ + static gint refcount = 2; + gst_structure_set_parent_refcount (structure, &refcount); +} + +gsize _hs_gst_segment_sizeof (void) +{ return sizeof (GstSegment); } + +GstPad *_hs_gst_base_src_get_pad (GstBaseSrc *base_src) +{ return GST_BASE_SRC_PAD (base_src); } +GstPad *_hs_gst_base_sink_get_pad (GstBaseSink *base_sink) +{ return GST_BASE_SINK_PAD (base_sink); } + +GstPad *_hs_gst_base_transform_get_sink_pad (GstBaseTransform *base_transform) +{ return GST_BASE_TRANSFORM_SINK_PAD (base_transform); } +GstPad *_hs_gst_base_transform_get_src_pad (GstBaseTransform *base_transform) +{ return GST_BASE_TRANSFORM_SRC_PAD (base_transform); } + +guint _hs_gst_mini_object_flags (GstMiniObject* obj) +{ return GST_MINI_OBJECT_FLAGS (obj); } +void _hs_gst_mini_object_flag_set (GstMiniObject* obj, guint flags) +{ GST_MINI_OBJECT_FLAG_SET (obj, flags); } +void _hs_gst_mini_object_flag_unset (GstMiniObject* obj, guint flags) +{ GST_MINI_OBJECT_FLAG_UNSET (obj, flags); } +void _hs_gst_mini_object_make_read_only (GstMiniObject *obj) +{ GST_MINI_OBJECT_FLAG_SET (obj, GST_MINI_OBJECT_FLAG_READONLY); } + +GstQueryType _hs_gst_query_type (GstQuery *query) +{ return GST_QUERY_TYPE (query); } +GstEventType _hs_gst_event_type (GstEvent *event) +{ return GST_EVENT_TYPE (event); } + +GstClockTime _hs_gst_frames_to_clock_time (gint64 frames, double rate) +{ return GST_FRAMES_TO_CLOCK_TIME (frames, rate); } +gint64 _hs_gst_clock_time_to_frames (GstClockTime clock_time, double rate) +{ return GST_CLOCK_TIME_TO_FRAMES (clock_time, rate); } diff --git a/hsgstreamer.h b/hsgstreamer.h new file mode 100644 --- /dev/null +++ b/hsgstreamer.h @@ -0,0 +1,84 @@ +/* GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer + * + * 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 + * . + * + * 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. + */ +#ifndef __HSGSTREAMER_H__ +#define __HSGSTREAMER_H__ + +#include + +#if !((GST_VERSION_MAJOR > 0) || \ + (GST_VERSION_MAJOR == 0 && GST_VERSION_MINOR > 10) || \ + (GST_VERSION_MAJOR == 0 && GST_VERSION_MINOR == 10 && GST_VERSION_MICRO >= 18)) +#define GST_CHECK_VERSION(major,minor,micro) \ + (GST_VERSION_MAJOR > (major) || \ + (GST_VERSION_MAJOR == (major) && GST_VERSION_MINOR > (minor)) || \ + (GST_VERSION_MAJOR == (major) && GST_VERSION_MINOR == (minor) && \ + GST_VERSION_MICRO >= (micro))) +#endif + +#include +#include +#include +#include +#include +#if GST_CHECK_VERSION(0,10,10) +#include +#endif +#include +#include +#include +#include +#include +#include +#include + +guint _hs_gst_object_flags (GstObject* obj); +void _hs_gst_object_flag_set (GstObject* obj, guint flags); +void _hs_gst_object_flag_unset (GstObject* obj, guint flags); +void _hs_gst_object_lock (GstObject* obj); +gboolean _hs_gst_object_trylock (GstObject* obj); +void _hs_gst_object_unlock (GstObject* obj); +void _hs_gst_object_unfloat (gpointer obj); +GstMessageType _hs_gst_message_get_message_type (GstMessage *message); +void _hs_gst_structure_make_immutable (GstStructure *structure); +gsize _hs_gst_segment_sizeof (void) G_GNUC_CONST; + +GstPad *_hs_gst_base_src_get_pad (GstBaseSrc *base_src); +GstPad *_hs_gst_base_sink_get_pad (GstBaseSink *base_sink); +GstPad *_hs_gst_base_transform_get_sink_pad (GstBaseTransform *base_transform); +GstPad *_hs_gst_base_transform_get_src_pad (GstBaseTransform *base_transform); + +guint _hs_gst_mini_object_flags (GstMiniObject* obj); +void _hs_gst_mini_object_flag_set (GstMiniObject* obj, guint flags); +void _hs_gst_mini_object_flag_unset (GstMiniObject* obj, guint flags); +void _hs_gst_mini_object_make_read_only (GstMiniObject *obj); + +GstQueryType _hs_gst_query_type (GstQuery *query); +GstEventType _hs_gst_event_type (GstEvent *event); + +GstClockTime _hs_gst_frames_to_clock_time (gint64 frames, double rate); +gint64 _hs_gst_clock_time_to_frames (GstClockTime clock_time, double rate); + +#endif diff --git a/marshal.list b/marshal.list new file mode 100644 --- /dev/null +++ b/marshal.list @@ -0,0 +1,47 @@ +# see glib-genmarshal(1) for a detailed description of the file format, +# possible parameter types are: +# VOID indicates no return type, or no extra +# parameters. if VOID is used as the parameter +# list, no additional parameters may be present. +# BOOLEAN for boolean types (gboolean) +# CHAR for signed char types (gchar) +# UCHAR for unsigned char types (guchar) +# INT for signed integer types (gint) +# UINT for unsigned integer types (guint) +# LONG for signed long integer types (glong) +# ULONG for unsigned long integer types (gulong) +# ENUM for enumeration types (gint) +# FLAGS for flag enumeration types (guint) +# FLOAT for single-precision float types (gfloat) +# DOUBLE for double-precision float types (gdouble) +# STRING for string types (gchar*) +# BOXED for boxed (anonymous but reference counted) types (GBoxed*) +# POINTER for anonymous pointer types (gpointer) +# NONE deprecated alias for VOID +# BOOL deprecated alias for BOOLEAN + +# +# One discrepancy from Gtk+ is that for signals that may pass NULL for an object +# reference, the Haskell signal should be passed a 'Maybe GObject'. +# We therefore have two variants that are marshalled as a maybe type: +# +# OBJECT for GObject or derived types (GObject*) +# MOBJECT for GObject or derived types (GObject*) that may be NULL + +# Furthermore, some objects needs to be destroyed synchronously from the main loop of +# Gtk rather than during GC. These objects need to be marshalled using TOBJECT (for thread-safe +# object). It doesn't hurt to use TOBJECT for an object that doesn't need it, except for +# some performance. As a rule of thumb, use TOBJECT for all libraries that build on package +# 'gtk' and use OBJECT for all packages that only need packages 'glib', 'pango', 'cairo', +# 'gio'. Again both variants exist. Note that the same names will be generated for OBJECT and +# TOBJECT, so you have to remove the OBJECT handler if you need both. +# +# TOBJECT for GObject or derived types (GObject*) +# MTOBJECT for GObject or derived types (GObject*) that may be NULL + +# If you add a new signal type, please check that it actually works! +# If it is a Boxed type check that the reference counting is right. + +VOID:VOID +VOID:OBJECT +VOID:BOXED diff --git a/mini-hierarchy.list b/mini-hierarchy.list new file mode 100644 --- /dev/null +++ b/mini-hierarchy.list @@ -0,0 +1,6 @@ + GstMiniObject as MiniObject +## GStreamer classes + GstBuffer as Buffer, gst_buffer_get_type + GstEvent as Event, gst_event_get_type + GstMessage as Message, gst_message_get_type + GstQuery as Query, gst_query_get_type diff --git a/template-hsc-gtk2hs.h b/template-hsc-gtk2hs.h new file mode 100644 --- /dev/null +++ b/template-hsc-gtk2hs.h @@ -0,0 +1,17 @@ +#ifndef _TEMPLATE_HSC_GTK2HS_H_ +#define _TEMPLATE_HSC_GTK2HS_H_ + +#include + +#define hsc_gtk2hs_type(t) \ + if ((t)(int)(t)1.4 == (t)1.4) \ + printf ("%s%" G_GSIZE_FORMAT, \ + (t)(-1) < (t)0 ? "Int" : "Word", \ + sizeof (t) * 8); \ + else \ + printf ("%s", \ + sizeof (t) > sizeof (double) ? "LDouble" : \ + sizeof (t) == sizeof (double) ? "Double" : \ + "Float"); + +#endif