diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ 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 that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU 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 as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,21 @@
+Provides high-level access to webcams for Haskell programs.
+
+The current state is that the library provides a monad for
+grabbing images from a webcam under Linux. In the future, more functionality like
+image processing functions and other input devices may be added.
+
+Last time I checked, the v4l2 package was not on hackage,
+but it can be retrieved from here:
+ https://gitorious.org/hsv4l2
+
+For images, repa arrays are used. Therefore, all the repa goodness
+can be used with the data. It should also be possible without too much hassle
+to write a function which gets the data into a different type of array,
+if that is necessary.
+
+Getting an image with a v4l webcam works like this:
+
+> import Graphics.Webcam.Linux
+> main = runCam (grab >>= saveBmp "my_image.bmp") (Webcam 0)
+
+If anyone wants to help, please contact me!
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/example.hs b/example.hs
new file mode 100644
--- /dev/null
+++ b/example.hs
@@ -0,0 +1,33 @@
+module Main where
+
+import Graphics.Webcam.Linux
+import Control.Monad (forM)
+import Data.Array.Repa
+import Data.Array.Repa.Repr.ForeignPtr
+-- import Control.Monad.IO.Class
+import Graphics.Gloss
+import Graphics.Gloss.Interface.IO.Animate
+
+
+produceFrame :: CamState -> Float -> IO Picture
+produceFrame s t = do
+ e <- runCamWith s
+ (getSize >>= \(w,h) ->
+ grabF rgbaToAbgr >>= \fimg ->
+ let bm = bitmapOfForeignPtr w h fp False
+ fp = toForeignPtr fimg
+ in return bm)
+ either (const $ error "ERROR!") (return) e
+
+
+-- main = runCam (forM [1..100] (const grab) >> grab >>= saveBmp "test.bmp") (Webcam 0)
+main = do
+ a <- runCam (Webcam 0) $
+ setSize (300,300) >>
+ grab >>= saveBmp "1.bmp" >>
+ grab >>= saveBmp "2.bmp" >>
+ grab >>= saveBmp "3.bmp" >>
+ getSize >>= \(w,h) ->
+ getState >>= \st ->
+ liftIO (animateIO (InWindow "Hello, World!" (w,h) (10,10)) (makeColor 1 1 1 1) (produceFrame st))
+ putStrLn $ show a
diff --git a/repa-v4l2.cabal b/repa-v4l2.cabal
new file mode 100644
--- /dev/null
+++ b/repa-v4l2.cabal
@@ -0,0 +1,94 @@
+-- repa-v4l2.cabal auto-generated by cabal init. For additional options,
+-- see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name: repa-v4l2
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+Synopsis: Provides high-level access to webcams.
+
+-- A longer description of the package.
+Description: The current state is that the library provides a monad for
+ grabbing images from a webcam under Linux. In the future, more functionality like
+ image processing functions and other input devices may be added.
+ If anyone wants to help, please contact me!
+
+ It has been pointed out on haskell-cafe that the v4l2 package that
+ is needed by this package is not (yet?) on hackage. Therefore
+ this library is not building on hackage.
+
+-- The license under which the package is released.
+License: LGPL
+
+-- The file containing the license text.
+License-file: LICENSE
+
+-- The package author(s).
+Author: Christian Gosch
+
+-- An email address to which users can send suggestions, bug reports,
+-- and patches.
+Maintainer: github@goschs.de
+
+-- A copyright notice.
+-- Copyright:
+
+Category: Graphics
+
+Build-type: Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+Extra-source-files: README
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version: >=1.8
+
+
+copyright: 2011-2012, Christian Gosch
+maintainer: Christian Gosch
+stability: Experimental
+homepage: https://github.com/cgo/hsimage
+
+-- extra-source-files: README
+
+source-repository head
+ type: git
+ location: git://github.com/cgo/hsimage.git
+
+Library
+ hs-source-dirs: src
+ -- Modules exported by the library.
+ Exposed-modules: Graphics.Webcam.Linux
+ Other-modules: Graphics.Webcam.Linux.Internal
+ ghc-options: -fllvm
+
+ -- Packages needed in order to build this package.
+ Build-depends: base == 4.*,
+ repa >= 3.0,
+ --repa-devil >= 0.1.2,
+ transformers >= 0.2.2,
+ containers >= 0.2,
+ deepseq >= 1.3,
+ v4l2 >= 0.1,
+ mtl >= 2.0.1.0,
+ vector >= 0.9.1,
+ bmp >= 1.2.1,
+ bytestring >= 0.9.2
+
+
+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+ -- Build-tools:
+
+Executable example
+ main-is: example.hs
+ ghc-options: -fllvm -threaded
+ build-depends: gloss >= 1.7.2.1,
+ repa-v4l2 >= 0.1,
+ base == 4.*,
+ repa >= 3.1.0.1
diff --git a/src/Graphics/Webcam/Linux.hs b/src/Graphics/Webcam/Linux.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Webcam/Linux.hs
@@ -0,0 +1,41 @@
+{-| The Linux interface for accessing webcams via video4linux.
+This module uses the lower-level bindings to v4l to provide for a simple
+way to access a web camera from Haskell code using repa.
+The module is meant to be used like shown in the file /example.hs/
+in the root of the package.
+For example:
+
+> main = runCam (Webcam 0) $
+> grab >>= saveBmp "1.bmp" >>
+> grab >>= saveBmp "2.bmp" >>
+> grab >>= saveBmp "3.bmp"
+
+This example would take three pictures from the first webcam and
+store them in three files.
+-}
+
+module Graphics.Webcam.Linux
+ (
+ -- * Data Types
+ Webcam (..)
+ , Image
+ , V4lCamT
+ , CamState
+ , liftIO
+ -- * Camera Actions
+ , runCam
+ , runCamWith
+ , grab
+ , grabF
+ , setSize
+ , getSize
+ , getState
+ , saveBmp
+ , getImageFormat
+ , findImageFormat
+ -- * Utility Functions
+ , rgbaToAbgr
+ , flipY
+ ) where
+
+import Graphics.Webcam.Linux.Internal
diff --git a/src/Graphics/Webcam/Linux/Internal.hs b/src/Graphics/Webcam/Linux/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Webcam/Linux/Internal.hs
@@ -0,0 +1,379 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving,
+ TypeSynonymInstances,
+ FlexibleInstances,
+ FlexibleContexts,
+ MultiParamTypeClasses,
+ ExistentialQuantification #-}
+
+module Graphics.Webcam.Linux.Internal
+ (
+ -- * Data Types
+ Image
+ , Webcam (..)
+ -- * V4L Monad
+ , V4lCamT (..)
+ , InnerMonad (..)
+ , Control.Monad.Trans.liftIO
+ -- ** Running the Monad
+ , runCam
+ , runCamWith
+ -- ** Functions in the V4L Monad
+ , getState
+ , setState
+ , openCam
+ , closeCam
+ , getImageFormat
+ , setSize
+ , getSize
+ , grab
+ , grabF
+ , getDev
+ , saveBmp
+ , findImageFormat
+ -- * Other useful functions
+ , camToName
+ , rgbaToAbgr
+ , flipY
+ , chooseSize
+ , frameToRGBA
+ , frameToRGBAF
+ , CamState (..)
+ ) where
+
+import Graphics.V4L2
+import qualified Data.Set as S (toList)
+import Data.List (sortBy,minimumBy)
+import Data.Word
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Error
+import Control.Monad.Trans
+import Control.Exception
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.ForeignPtr
+import Foreign.Marshal.Array
+
+import Data.Array.Repa hiding ((++))
+import Data.Array.Repa.Eval
+import Data.Array.Repa.Repr.ForeignPtr
+import Data.Array.Repa.Repr.ByteString
+import Data.Vector.Unboxed.Base
+import Data.ByteString (pack)
+
+import qualified Codec.BMP as BMP
+
+
+{-| An image data type. This uses the Array type Data.Array.Repa.Array. -}
+type Image r a = Array r DIM3 a
+
+
+data Webcam = Webcam Int
+
+
+data CamState = CamState {
+ camstateCam :: Webcam,
+ camstateDev :: Maybe Device,
+ camstateFormat :: Maybe ImageFormat
+ }
+
+
+data V4lCamT m a = V4lCamT { unV4lCam :: InnerMonad m a }
+
+
+type InnerMonad m a = ErrorT String (StateT CamState m) a
+
+
+instance MonadTrans V4lCamT where
+ lift = V4lCamT . lift . lift
+
+
+instance MonadIO m => MonadIO (V4lCamT m) where
+ liftIO = lift . liftIO
+
+
+instance Monad m => Monad (V4lCamT m) where
+ f >>= g = V4lCamT $ unV4lCam f >>= (unV4lCam . g)
+ return = V4lCamT . return
+
+
+instance Monad m => Functor (V4lCamT m) where
+ fmap f act = act >>= return . f
+
+
+instance Monad m => MonadPlus (V4lCamT m) where
+ mzero = V4lCamT $ mzero
+ mplus (V4lCamT a) (V4lCamT b) = V4lCamT $ mplus a b
+
+
+-- instance MonadIO m => MonadIO (V4lCamT m) where
+-- liftIO = V4lCamT . lift . lift . liftIO
+
+
+instance Monad m => MonadError String (V4lCamT m) where
+ throwError = V4lCamT . throwError
+ catchError (V4lCamT act) errf = V4lCamT $ catchError act (unV4lCam . errf)
+
+
+{-| Get the state data. Internal. -}
+getState :: Monad m => V4lCamT m CamState
+getState = V4lCamT $ lift get
+
+
+{-| Set the state data. Internal. -}
+setState :: Monad m => CamState -> V4lCamT m ()
+setState = V4lCamT . lift . put
+
+
+{-| Get the device. Internal. -}
+getDev :: Monad m => V4lCamT m Device
+getDev = camstateDev `fmap` getState >>= maybe (throwError "Device not open.") return
+
+
+{-| Save the given 'Image' as BMP in the file with the given name.
+This function currently takes a detour via lists when converting the image to a 'ByteString',
+and is therefore probably slower than necessary (FIXME). -}
+saveBmp :: (MonadIO m, Repr r Word8) => FilePath -> Image r Word8 -> V4lCamT m ()
+saveBmp name i = do
+ -- This does not compile; why not? Fill instances missing in Repa?
+ -- a <- liftIO $ ((copyP i :: IO (Image B Word8)) >>=
+ -- return . toByteString >>=
+ -- return . BMP.packRGBA32ToBMP w h >>=
+ -- BMP.writeBMP name >> return True) `onException` return False
+
+ a <- liftIO $ (let bs = pack (toList i); bsa = BMP.packRGBA32ToBMP w h bs
+ in
+ BMP.writeBMP name bsa >> return True) `onException` return False
+ if not a
+ then throwError ("Could not save image " ++ name)
+ else return ()
+ where (Z :. h :. w :. k) = extent i
+
+
+{-| Convert the given 'Webcam' to a name (of a device that can be opened). -}
+camToName :: Webcam -> String
+camToName (Webcam n) = "/dev/video" ++ show n
+
+
+{-| Open the given 'Webcam'. -}
+openCam :: MonadIO m => Webcam -> V4lCamT m ()
+openCam w = do
+ let name = camToName w
+ mdev <- liftIO $ Just `fmap` openDevice name `onException` return Nothing
+ case mdev of
+ Just dev -> V4lCamT $ lift $ modify $ \s -> s { camstateDev = Just dev }
+ _ -> throwError $ "Could not open device " ++ name
+
+
+{-| Closes the currently open 'Webcam'. -}
+closeCam :: MonadIO m => V4lCamT m ()
+closeCam = getDev >>= liftIO . closeDevice
+
+
+{-| Given a 'Webcam', runs a 'V4lCamT' action with it.
+All actions may 'throwError', which can be caught with 'catchError'.
+In case of an error, 'runCam' returns 'Left' with an errormessage.
+Otherwise, it returns a 'Right' with the result.
+
+This function sets a "reasonable" image format using 'findImageFormat'
+after opening the webcam. Then, the supplied action is run and the camera
+is closed again.
+
+You may want to set a different image size or image format,
+when that is supported.
+-}
+runCam :: MonadIO m => Webcam -> V4lCamT m a -> m (Either String a)
+runCam cam act = r
+ where
+ uact = unV4lCam ((openCam cam >> findImageFormat >> act >>= \a -> closeCam >> return a)
+ `catchError`
+ (\e -> liftIO (putStrLn "final close!") >> closeCam >> throwError e))
+ eact = runErrorT uact
+ r = evalStateT eact s
+ s = CamState cam Nothing Nothing
+
+
+{-| Like 'runCam', but runs with a given state. -}
+runCamWith :: MonadIO m => CamState -> V4lCamT m a -> m (Either String a)
+runCamWith s act = r
+ where
+ uact = unV4lCam (act
+ `catchError`
+ (\e -> liftIO (putStrLn "final close!") >> closeCam >> throwError e))
+ eact = runErrorT uact
+ r = evalStateT eact s
+
+
+{-| Grab a new image from the currently open camera.
+May 'throwError' if something goes wrong. -}
+grab :: MonadIO m => V4lCamT m (Image U Word8)
+grab = do
+ dev <- getDev
+ format <- getImageFormat
+ liftIO $ withFrame dev format (\p i -> frameToRGBA format p >>= computeP)
+ -- runIL (writeImage "testimage.jpg" img)
+
+
+{-| Like 'grab', but applies the given function to the captured image. -}
+grabF :: MonadIO m => (Image D Word8 -> Image D Word8) -> V4lCamT m (Image F Word8)
+grabF conv = do
+ dev <- getDev
+ format <- getImageFormat
+ (w,h) <- getSize
+ liftIO $ withFrame dev format $ \p i -> do
+ f <- frameToRGBAF format p conv
+ let n = w * h * 4
+ fa <- mallocForeignPtrArray n
+ computeIntoP fa f -- (conv f)
+ return $ fromForeignPtr (Z :. h :. w :. 4) fa
+ -- runIL (writeImage "testimage.jpg" img)
+{- INLINE grabF -}
+
+
+{-| Get the currently used image format.
+May 'throwError' if the format has not been set. -}
+getImageFormat :: Monad m => V4lCamT m ImageFormat
+getImageFormat = camstateFormat `fmap` getState >>= maybe (throwError "Format is not set.") return
+
+
+{-| This function sets the size to the next fitting size the
+connected web camera supports. You can query the actual size with 'getSize'. -}
+setSize :: MonadIO m => (Int, Int) -> V4lCamT m ()
+setSize (w,h) = do
+ szs <- getPossibleSizes
+ let (w',h') = chooseClosestSize (w,h) szs
+ fmt <- getImageFormat
+ let fmt' = fmt { imageWidth = w',
+ imageHeight = h' }
+ dev <- getDev
+ liftIO $ setFormat dev Capture fmt'
+ format <- liftIO $ getFormat dev Capture
+ getState >>= \s -> setState (s { camstateFormat = Just format } )
+ return ()
+
+{-| Returns the image with and height of the images captured by
+the currently open web cam. -}
+getSize :: Monad m => V4lCamT m (Int, Int)
+getSize = getImageFormat >>= \f -> return (imageWidth f, imageHeight f)
+
+
+
+--------------------------------------------------------------------------------
+
+{-| Choose a "suitable" size from a bunch of frame sizes. -}
+chooseSize :: FrameSizes -> Maybe FrameSize
+chooseSize (DiscreteSizes s) = let l = reverse $ sortBy (\a b -> compare (frameWidth a) (frameWidth b)) $ S.toList s
+ in maybeMedian l
+chooseSize (StepwiseSizes minW maxW stepW minH maxH stepH) = Just $ FrameSize maxW maxH
+
+
+
+chooseClosestSize :: (Int, Int) -> FrameSizes -> (Int, Int)
+chooseClosestSize (w,h) (DiscreteSizes s) = (w',h')
+ where l = Prelude.map (\a -> (frameWidth a, frameHeight a)) $ S.toList s
+ l' = Prelude.map (\(x,y) -> (x,y,(w-x)^2 + (h-y)^2)) l
+ (w',h',_) = minimumBy (\(_,_,a) (_,_,b) -> compare a b) l'
+
+chooseClosestSize (w,h) (StepwiseSizes minW maxW stepW minH maxH stepH) = (w', h')
+ where w' = min minW $ max ((w `div` stepW) * stepW) minW
+ h' = min minH $ max ((h `div` stepH) * stepH) minH
+
+
+maybeHead :: [a] -> Maybe a
+maybeHead [] = Nothing
+maybeHead (a:_) = Just a
+
+maybeMedian :: [a] -> Maybe a
+maybeMedian [] = Nothing
+maybeMedian l = Just $ l !! n
+ where n = m - 1 - m `div` 4
+ m = length l
+
+
+getPossibleSizes :: MonadIO m => V4lCamT m FrameSizes
+getPossibleSizes = do
+ dev <- getDev
+ format' <- getImageFormat
+ liftIO $ queryFrameSizes dev (imagePixelFormat format')
+
+
+{-| Finds an image format, sets the current device to it and sets it so it can be
+retrieved with 'getImageFormat'.
+Currently this function will set a 'PixelRGB24' format.
+Add more intelligence to this if needed. -}
+findImageFormat :: MonadIO m => V4lCamT m ()
+findImageFormat = do
+ dev <- getDev
+ (info,cap) <- liftIO $ deviceInfoCapabilities dev
+ -- liftIO $ putStrLn $ show cap
+ liftIO $ setVideoInput dev (fromIntegral 0)
+
+ sizes <- liftIO $ queryFrameSizes dev PixelRGB24
+ format' <- liftIO $ getFormat dev Capture
+ (FrameSize sx sy) <- let mf = chooseSize sizes
+ in case mf of
+ Just s -> return s
+ _ -> throwError "No suitable size found!"
+ let format = format' { imageWidth = sx,
+ imageHeight = sy,
+ imagePixelFormat = PixelRGB24 }
+ -- liftIO $ putStrLn ("Size: " ++ show sx ++ " , " ++ show sy)
+ liftIO $ setFormat dev Capture format
+ format <- liftIO $ getFormat dev Capture
+ liftIO $ putStrLn $ show format
+ getState >>= \s -> setState (s { camstateFormat = Just format } )
+
+
+{-| Flips the Y axis of a given image. -}
+flipY :: Repr r a => Image r a -> Image D a
+flipY i = backpermute sh (\(Z :. y :. x :. j) -> Z :. h - 1 - y :. x :. j) i
+ where sh@(Z :. h :. w :. k) = extent i
+
+
+rgbaToAbgr :: Repr r a => Image r a -> Image D a
+rgbaToAbgr i = backpermute sh (\(Z :. y :. x :. j) -> Z :. y :. x :. (k - 1 - j)) i
+ where sh@(Z :. h :. w :. k) = extent i
+{-# INLINE rgbaToAbgr #-}
+
+{- FIXME: To make things faster, put swapping RGBA directly in here. -}
+{-| Converts a RGB image from the camera to an RGBA image that can e.g. be
+stored as BMP with 'saveBMP'. -}
+rgbToRgba :: Num a => Repr r a => Image r a -> Image D a
+rgbToRgba src | k == 3 = flipY $ traverse src shf f
+ | k == 4 = delay src
+ | otherwise = error "Could not convert image to rgba"
+ where shf _ = (Z :. h :. w :. 4)
+ (Z :. h :. w :. k) = extent src
+ f g p@(Z :. y :. x :. j) | j == 3 = 255
+ | otherwise = g p
+
+
+{-| Copy the image stored at the given pointer in the given format into a 4-channel RGBA image.
+This currently works only for 3-channel source images which are stored contiguously.
+There may be no line padding. -}
+frameToRGBA :: (Data.Vector.Unboxed.Base.Unbox a, Num a, Elt a, Storable a) => ImageFormat -> Ptr a -> IO (Image D a)
+frameToRGBA i p = do
+ fp <- newForeignPtr_ p
+ let src = fromForeignPtr sh fp
+ sh = Z :. h :. w :. 3
+ w = imageWidth i
+ h = imageHeight i
+ return $ rgbToRgba src
+
+{-| Like 'frameToRGBA', but applies
+ > f . rgbToRgba
+ to the image. -}
+frameToRGBAF :: (Data.Vector.Unboxed.Base.Unbox a, Num a, Elt a, Storable a) =>
+ ImageFormat -- ^ The image format
+ -> Ptr a -- ^ The image data
+ -> (Image D a -> Image D a) -- ^ The function /f/ that is applied to the data
+ -> IO (Image D a) -- ^ Returns the image.
+frameToRGBAF i p f = do
+ fp <- newForeignPtr_ p
+ let src = fromForeignPtr sh fp
+ sh = Z :. h :. w :. 3
+ w = imageWidth i
+ h = imageHeight i
+ return $ (f . rgbToRgba) src
+