repa-v4l2 (empty) → 0.1.0.0

raw patch · 7 files changed

+737/−0 lines, 7 filesdep +basedep +bmpdep +bytestringsetup-changed

Dependencies added: base, bmp, bytestring, containers, deepseq, gloss, mtl, repa, repa-v4l2, transformers, v4l2, vector

Files

LICENSE +165/−0
README +21/−0
Setup.hs +4/−0
example.hs +33/−0
repa-v4l2.cabal +94/−0
src/Graphics/Webcam/Linux.hs +41/−0
src/Graphics/Webcam/Linux/Internal.hs +379/−0

+ LICENSE view

@@ -0,0 +1,165 @@+                   GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.

+ README view

@@ -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!

+ Setup.hs view

@@ -0,0 +1,4 @@+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

+ example.hs view

@@ -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

+ repa-v4l2.cabal view

@@ -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 <github@goschs.de>+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

+ src/Graphics/Webcam/Linux.hs view

@@ -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

+ src/Graphics/Webcam/Linux/Internal.hs view

@@ -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+