packages feed

friday 0.2.1.2 → 0.2.2.0

raw patch · 4 files changed

+117/−3 lines, 4 filesdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: primitive

API changes (from Hackage documentation)

+ Vision.Image.Parallel: computeP :: (Monad m, Image i, Storable (ImagePixel i)) => i -> m (Manifest (ImagePixel i))

Files

+ changelog view
@@ -0,0 +1,42 @@+-*-change-log-*-++v0.2.2.0 June 2015+ * New 'computeP' function to compute an image in parallel.++v0.2.1.2 May 2015+ * Add test modules under `other-modules`.++v0.2.1.1 April 2015+ * Removes an orphan dependency to bytetring.+ * Fixes some warning when compiled with GHC 7.10.++v0.2.1.0 March 2015+ * Grey to HSV conversion.++v0.2.0.2 February 2015+ * Minor documentation improvements.++v0.2.0.1 January 2015+ * Setup.hs script.++v0.2 January 2015+ BREAKING CHANGES:+   * Origin is on the upper left corner of the image (was bottom left).+   * New simplified filters interface. The old interface is still used+     internally to create filters and is available in+     Vision.Image.Filter.Internal.+   * DevIL bindings (Vision.Image.Storage) are now in a separate package+     (friday-devil) and with an improved interface.+   * Benchmarks are now in a separate package (friday-bench).+   * Examples are now in a separate package (friday-examples).+   * Pixel instance is no more required for MaskedImage and Image instances.++ * SCW thresholding.+ * New types aliases for filters.+ * New (!) and (!?) operators for image and histogram indexing.+ * Classes and image types are in two different files (Vision.Image.Class and+   Vision.Image.Type).+ * NFData instance for Manifest images.++v0.1 August 2014+ * Initial release
friday.cabal view
@@ -2,7 +2,7 @@ --                      +-+------- breaking API changes --                      | | +----- non-breaking API additions --                      | | | +--- code changes with no API change-version:                0.2.1.2+version:                0.2.2.0 synopsis:               A functional image processing library for Haskell. homepage:               https://github.com/RaphaelJ/friday license:                LGPL-3@@ -38,6 +38,8 @@ build-type:             Simple cabal-version:          >= 1.10 +extra-source-files:     changelog+ source-repository       head     type:               git     location:           https://github.com/RaphaelJ/friday@@ -58,10 +60,11 @@                         Vision.Image.HSV.Type                         Vision.Image.Interpolate                         Vision.Image.Mutable+                        Vision.Image.Parallel                         Vision.Image.RGBA                         Vision.Image.RGBA.Specialize                         Vision.Image.RGBA.Type-                        Vision.Image.RGB+                        Vision.Image.RGB                          Vision.Image.RGB.Specialize                         Vision.Image.RGB.Type                         Vision.Image.Threshold@@ -77,7 +80,7 @@     build-depends:      base                    >= 4            && < 5                       , convertible             >= 1            && < 2                       , deepseq                 >= 1.3          && < 2-                      , primitive               >= 0.5.2.1      && < 0.6+                      , primitive               >= 0.5.2.1      && < 0.7                       , ratio-int               >= 0.1.2        && < 0.2                       , vector                  >= 0.10.0.1     && < 1                       , transformers            >= 0.3          && < 0.5
src/Vision/Image.hs view
@@ -20,6 +20,7 @@     , module Vision.Image.HSV     , module Vision.Image.Interpolate     , module Vision.Image.Mutable+    , module Vision.Image.Parallel     , module Vision.Image.RGB     , module Vision.Image.RGBA     , module Vision.Image.Threshold@@ -34,6 +35,7 @@ import Vision.Image.HSV import Vision.Image.Interpolate import Vision.Image.Mutable+import Vision.Image.Parallel import Vision.Image.RGB import Vision.Image.RGBA import Vision.Image.Threshold
+ src/Vision/Image/Parallel.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE BangPatterns+           , FlexibleContexts #-}++module Vision.Image.Parallel (computeP) where++import Control.Concurrent (+    forkIO, getNumCapabilities, newEmptyMVar, putMVar, takeMVar)+import Control.Monad.ST (ST, stToIO)+import Data.Vector (enumFromN, forM, forM_)+import Foreign.Storable (Storable)+import System.IO.Unsafe (unsafePerformIO)++import Vision.Image.Class (MaskedImage (..), Image (..), (!))+import Vision.Image.Type (Manifest (..))+import Vision.Image.Mutable (MutableManifest, linearWrite, new, unsafeFreeze)+import Vision.Primitive (Z (..), (:.) (..), ix2)+++-- | Parallel version of 'compute'.+--+-- Computes the value of an image into a manifest representation in parallel.+--+-- The monad ensures that the image is fully evaluated before continuing.+computeP :: (Monad m, Image i, Storable (ImagePixel i))+        => i -> m (Manifest (ImagePixel i))+computeP !src =+    return $! unsafePerformIO $ do+        dst <- stToIO newManifest++        -- Forks 'nCapabilities' threads.+        childs <- forM (enumFromN 0 nCapabilities) $ \c -> do+            child <- newEmptyMVar++            _ <- forkIO $ do+                let nLines | c == 0    = nLinesPerThread + remain+                           | otherwise = nLinesPerThread++                stToIO $ fillFromN dst (c * nLinesPerThread) nLines++                -- Sends a signal to the main thread.+                putMVar child ()++            return child++        -- Waits for all threads to finish.+        forM_ childs takeMVar++        stToIO $ unsafeFreeze dst+  where+    !size@(Z :. h :. w) = shape src++    !nCapabilities = unsafePerformIO getNumCapabilities++    !(nLinesPerThread, remain) = h `quotRem` nCapabilities++    -- Computes 'n' lines starting at 'from' of the image.+    fillFromN !dst !from !n =+        forM_ (enumFromN from n) $ \y -> do+            let !lineOffset = y * w+            forM_ (enumFromN 0 w) $ \x -> do+                let !offset = lineOffset + x+                    !val    = src ! (ix2 y x)+                linearWrite dst offset val++    newManifest :: Storable p => ST s (MutableManifest p s)+    newManifest = new size+{-# INLINE computeP #-}