packages feed

propane (empty) → 0.1

raw patch · 17 files changed

+587/−0 lines, 17 filesdep +basedep +colourdep +containerssetup-changed

Dependencies added: base, colour, containers, directory, filepath, repa, repa-devil, spawn

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) Keegan McAllister 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Propane.hs view
@@ -0,0 +1,16 @@+-- | The whole Propane system, in one convenient import.+module Propane+    ( module Propane.Types+    , module Propane.Helpers+    , module Propane.Raster+    , module Propane.IO+    , module Propane.Colour+    , module Propane.Transform+    ) where++import Propane.Types+import Propane.Helpers+import Propane.Raster+import Propane.IO+import Propane.Colour+import Propane.Transform
+ Propane/Colour.hs view
@@ -0,0 +1,99 @@+-- | Constructing and manipulating colours.+--+-- This module exports a subset of the @colour@ package at simplified,+-- restricted types.  You can also use the full @colour@ package with+-- these values.+module Propane.Colour+    ( -- * Constructing opaque colours+      cRGB,  cHSV , cGray++      -- * Constructing colours with transparency+    , cRGBA, cHSVA, cGrayA++      -- * Constructing colours from names+    , BaseColour+    , opaque, withOpacity+    , transparent++      -- * Manipulating colours+    , blend, over, darken, dissolve++    ) where++import qualified Data.Colour              as C+import qualified Data.Colour.SRGB         as C+import qualified Data.Colour.RGBSpace     as C+import qualified Data.Colour.RGBSpace.HSV as C++import Propane.Types++-- | Represents a colour without alpha channel.+--+-- The module @Data.Colour.Names@ defines many colours of this+-- type.+--+-- The right-hand side refers to the type @'C.Colour'@ defined+-- in the @colour@ package.  Every other instance of @'Colour'@+-- in this page refers to the type defined in "Propane.Types".+--+-- This would be less confusing if Haddock displayed qualified+-- names, but at least the hyperlinks go to the right place.+type BaseColour = C.Colour R++-- | Creates an opaque @'Colour'@ from a @'BaseColour'@.+opaque :: BaseColour -> Colour+opaque = C.opaque++-- | Creates a @'Colour'@ from a @'BaseColour'@ with a given opacity.+withOpacity :: BaseColour -> R -> Colour+withOpacity = C.withOpacity++-- | A fully-transparent @'Colour'@.+transparent :: Colour+transparent = C.transparent++-- | Compute the weighted average of two @'Colour'@s. e.g.+--+-- >blend 0.4 a b = 0.4*a + 0.6*b+blend :: R -> Colour -> Colour -> Colour+blend = C.blend++-- | @c1 \`over\` c2@ returns the @'Colour'@ created by compositing+-- 'c1' over 'c2'.+over :: Colour -> Colour -> Colour+over = C.over++-- | Blends a @'Colour'@ with black, without changing its opacity.+darken :: R -> Colour -> Colour+darken = C.darken++-- | @'dissolve' k@ returns a @'Colour'@ more transparent by a+-- factor of @k@.+dissolve :: R -> Colour -> Colour+dissolve = C.darken++-- | Construct an opaque colour from red, green, blue in [0,1].+cRGB :: R -> R -> R -> Colour+cRGB r g b = cRGBA r g b 1.0++-- | Construct an opaque colour from hue in [0,360) and saturation,+-- value in [0,1].+cHSV :: R -> R -> R -> Colour+cHSV h s v = cHSVA h s v 1.0++-- | Construct an opaque colour from a gray level in [0,1].+cGray :: R -> Colour+cGray g = cGrayA g 1.0++-- | Construct a colour from red, green, blue, alpha in [0,1].+cRGBA :: R -> R -> R -> R -> Colour+cRGBA r g b a = withOpacity (C.sRGB r g b) a++-- | Construct a colour from hue in [0,360) and saturation,+-- value, alpha in [0,1].+cHSVA :: R -> R -> R -> R -> Colour+cHSVA h s v a = withOpacity (C.uncurryRGB C.sRGB (C.hsv h s v)) a++-- | Construct a colour from gray level and alpha in [0,1].+cGrayA :: R -> R -> Colour+cGrayA g a = cRGBA g g g a
+ Propane/Helpers.hs view
@@ -0,0 +1,17 @@+-- | Helpfully combines functionality from other modules.+module Propane.Helpers+    ( saveImage+    , saveAnimation+    ) where++import Propane.Types+import Propane.Raster+import Propane.IO++-- | Save an image.  Invokes @'rasterize'@ and @'saveRaster'@.+saveImage :: FilePath -> Size -> Image Colour -> IO ()+saveImage name sz = saveRaster name . rasterize sz++-- | Save an animation.  Invakes @'rastimate'@ and @'saveRastimation'@.+saveAnimation :: FilePath -> Count -> Size -> Animation Colour -> IO ()+saveAnimation name nFrames sz = saveRastimation name . rastimate nFrames sz
+ Propane/IO.hs view
@@ -0,0 +1,66 @@+-- | Input and output.+--+-- TODO: input.+module Propane.IO+    ( saveRaster+    , saveRastimation+    ) where++import qualified Data.Array.Repa          as R+import qualified Data.Array.Repa.IO.DevIL as D++import qualified Data.Foldable as F++import Control.Monad+import Control.Concurrent.Spawn+import Control.Exception+import System.FilePath+import System.Directory+import Text.Printf++import Propane.Types+import Propane.IO.Lock ( lock )+++errStr :: String -> String+errStr = ("Propane.IO: " ++)++-- | Save the @'Raster'@ to a given file.+--+-- The file format is specified by the filename, and can+-- be any of the formats supported by the DevIL library.+--+-- Note that DevIL silently refuses to overwrite an existing+-- file.+saveRaster :: FilePath -> Raster -> IO ()+saveRaster name (Raster img) = do+    evaluate (R.deepSeqArray img ())+    lock $ D.runIL (D.writeImage name img)++-- | Save the @'Rastimation'@ to a sequence of frames in+-- the given directory.+--+-- The frames will be PNG files with names like+--+-- >00000000.png+-- >00000001.png+--+-- etc, in frame order.+--+-- Files are written concurrently, and there is no guarantee+-- about which files exist, until the IO action completes.+--+-- Note that DevIL silently refuses to overwrite an existing+-- file.+saveRastimation :: FilePath -> Rastimation -> IO ()+saveRastimation dir (Rastimation frames) = do+    createDirectoryIfMissing True dir+    -- Check existence, to give better error messages+    e <- doesDirectoryExist dir+    when (not e)+        (throwIO . ErrorCall $ errStr ("directory does not exist: " ++ dir))++    let go :: Int -> Raster -> IO (IO ())+        go i img = spawn $ saveRaster (dir </> printf "%08d.png" i) img++    zipWithM go [0..] (F.toList frames) >>= sequence_
+ Propane/IO/Lock.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE+    ForeignFunctionInterface #-}+-- | Protect calls into DevIL with a global lock.+module Propane.IO.Lock+    ( lock+    ) where++import Foreign+import Foreign.C+import Control.Monad+import Control.Concurrent.MVar+++foreign import ccall "hs_propane_get_global"+    c_get_global :: IO (Ptr ())++foreign import ccall "hs_propane_set_global"+    c_set_global :: Ptr () -> IO CInt+++set :: IO ()+set = do+    mv  <- newMVar ()+    ptr <- newStablePtr mv+    ret <- c_set_global (castStablePtrToPtr ptr)+    when (ret == 0) $+        freeStablePtr ptr++get :: IO (MVar ())+get = do+    p <- c_get_global+    if p == nullPtr+        then set >> get+        else deRefStablePtr (castPtrToStablePtr p)++lock :: IO a -> IO a+lock act = get >>= flip withMVar (const act)
+ Propane/Raster.hs view
@@ -0,0 +1,52 @@+-- | Conversion to raster forms.+--+-- TODO: the reverse.+module Propane.Raster+    ( rasterize+    , rastimate+    ) where++import qualified Data.Sequence    as S+import qualified Data.Colour      as C+import qualified Data.Colour.SRGB as C+import qualified Data.Array.Repa  as R+import Data.Array.Repa ( Z(..), (:.)(..) )++import Propane.Types+import Propane.Transform ( spaced )++type W8888 = (Word8, Word8, Word8, Word8)++-- | Convert the @'Image'@ region [-1, 1] x [-1, 1] to a @'Raster'@ with+-- the specified number of pixels.+rasterize :: Size -> Image Colour -> Raster+rasterize (Size w h) im = Raster . chans $ R.fromFunction dim f where+    f = quant . im . point++    dw = fromIntegral w - 1+    dh = fromIntegral h - 1+    dim = Z :. w :. h++    point :: R.DIM2 -> R2+    point (Z :. y :. x) = (adj dw x, adj dh y) where+        adj d n = (2 * fromIntegral n / d) - 1++    quant :: Colour -> W8888+    quant c = (r, g, b, a) where+        C.RGB r g b = C.toSRGB24 (c `C.over` C.black)+        a = round (C.alphaChannel c * 255.0)++    chans :: R.Array R.DIM2 W8888 -> R.Array R.DIM3 Word8+    chans arr = R.traverse arr (:. 4) chan where+        chan a (Z :. y :. x :. c) = ix c (a (Z :. y :. x))+        ix 0 (r,_,_,_) = r+        ix 1 (_,g,_,_) = g+        ix 2 (_,_,b,_) = b+        ix 3 (_,_,_,a) = a+        ix _ _ = error "Propane.Quantize: internal error (bad ix)"++-- | Convert the animation, for times in [0,1), to a @'Rastimation'@ with+-- the specified numbers of frames and pixels.+rastimate :: Count -> Size -> Animation Colour -> Rastimation+rastimate n sz ani = Rastimation (S.fromList frames) where+    frames = map (rasterize sz . ani) (spaced n 0 1)
+ Propane/Transform.hs view
@@ -0,0 +1,59 @@+-- | Transformations on images, animations, etc.+module Propane.Transform+    ( -- * Transforming scalars+      unbal, balun++      -- * Manipulating space+    , scale, scale2, translate, rotate++      -- * Manipulating time+    , speed, shift++      -- * Miscellaneous+    , spaced+    ) where++import Propane.Types++-- | Scale an @'Image'@ by the given factor.+scale :: R -> Image a -> Image a+scale s im (x,y) = im (x/s, y/s)++-- | Scale an @'Image'@ by the given factors+-- in /x/ and /y/ dimensions, respectively.+scale2 :: (R,R) -> Image a -> Image a+scale2 (sx,sy) im (x,y) = im (x/sx, y/sy)++-- | Translate an @'Image'@ by some displacement.+translate :: R2 -> Image a -> Image a+translate (dx,dy) im (x,y) = im (x-dx, y-dy)++-- | Rotate an @'Image'@ by some angle, in radians.+rotate :: Angle -> Image a -> Image a+rotate th im = \(x,y) -> im (x*cth + y*sth, y*cth + x*sth) where+    cth = cos (-th)+    sth = sin (-th)++-- | Multiply @'Animation'@ speed by the given factor.+speed :: Time -> Animation a -> Animation a+speed r ani t = ani (r*t)++-- | Shift an @'Animation'@ in time.  Positive offsets will+-- cause things to happen later.+shift :: Time -> Animation a -> Animation a+shift dt ani t = ani (t-dt)++-- | Squish the interval [-1, 1] into [0, 1].+unbal :: R -> R+unbal n = (n + 1) / 2++-- | Stretch the interval [0, 1] into [-1, 1].+balun :: R -> R+balun n = (n * 2) - 1++-- | @'spaced' n a b@ is a list of @n@ values, evenly spaced+-- from @a@ (included) to @b@ (not included), such that the next+-- evenly-spaced value would be @b@.+spaced :: (Fractional a) => Count -> a -> a -> [a]+spaced n a b = take n (iterate (+i) a) where+    i = (b - a) / fromIntegral n
+ Propane/Types.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE+    DeriveDataTypeable #-}+-- | Types for functional image synthesis.+module Propane.Types+    ( -- * Basic type synonyms+      --+      -- | These exist to improve type signatures+      -- as documentation.+      R, R2, Time, Angle, Count++      -- * Images and animations+    , Colour, Image, Animation++      -- * Rasterization+      --+      -- | Images and animations can be converted to+      -- discrete objects, e.g. for output to files.+    , Size(..), Raster(..), Rastimation(..), Word8+    ) where++import qualified Data.Colour     as C+import qualified Data.Array.Repa as R+import qualified Data.Sequence   as S++import Data.Word+import Data.Data ( Typeable, Data )++-- | The (fake) real numbers.+--+-- This is the only place where we choose between @'Float'@ and @'Double'@.+-- Switching to @'Double'@ would increase demands on memory bandwidth and+-- cache space, decreasing performance (by 30% in one vaguely relevant+-- test).+type R = Float++-- | Cartesian coordinates (/x/,/y/), representing points in the plane.+type R2 = (R, R)++-- | Time, in no particular unit.+type Time = R++-- | An angle, in radians.+type Angle = R++-- | A count, e.g. number of repetitions of something.+type Count = Int++-- | A colour with alpha channel.+--+-- @'C.AlphaColour'@ is defined in the @colour@ package, which also provides+-- many functions for working with this type.+type Colour = C.AlphaColour R++-- | An image provides a value (such as colour) for every point of the+-- real plane.+type Image a = R2 -> a++-- | An animation is a time-varying image.+type Animation a = Time -> Image a++-- | The number of pixels in a raster image.+data Size = Size+    { sWidth  :: Count+    , sHeight :: Count }+    deriving (Eq, Ord, Read, Show, Typeable, Data)++-- | A @'Raster'@ is a finite rectangle of an @'Image'@, with space and colour+-- reduced to discrete quantities.+--+-- It is represented by a Repa @'R.Array'@ with indices of the form+-- (@Z :. y :. x :. c@) where:+--+-- * (@x@, @y@) are pixel counts in the Cartesian /x/ and /y/ directions respectively.+--+-- * @c@ is a colour channel index: 0, 1, 2, 3 for red, green, blue, alpha respectively.+newtype Raster = Raster (R.Array R.DIM3 Word8)+    deriving (Eq, Show, Typeable)++-- | A @'Rastimation'@ is an animation of @'Raster'@ frames, where time has+-- also been reduced to a discrete quantity.+--+-- It is represented as a sequence of @'Raster'@s.+newtype Rastimation = Rastimation (S.Seq Raster)+    deriving (Eq, Show, Typeable)
+ README view
@@ -0,0 +1,9 @@+Propane is a system for functional synthesis of images and animations.++Documentation is hosted at http://hackage.haskell.org/package/propane++To build the documentation yourself, run++  $ cabal configure && cabal haddock --hyperlink-source++This will produce HTML documentation under dist/doc/html/propane
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/runhaskell++import Distribution.Simple+main = defaultMain
+ cbits/global-lock.c view
@@ -0,0 +1,19 @@+// Based on the global-lock package.++// Atomic builtins were added in GCC 4.1.+#if  !defined(__GNUC__) \+  || (__GNUC__ < 4) \+  || (__GNUC__ == 4 && __GNUC_MINOR__ < 1)+#error global-lock requires GCC 4.1 or later.+#endif++static void* global = 0;++void* hs_propane_get_global(void) {+    return global;+}++int hs_propane_set_global(void* new_global) {+    void* old = __sync_val_compare_and_swap(&global, 0, new_global);+    return (old == 0);+}
+ examples/gradient.hs view
@@ -0,0 +1,4 @@+import Propane++main = saveImage "out.png" (Size 400 400) im where+    im (x,y) = cRGB (unbal x) (unbal y) 0
+ examples/green.hs view
@@ -0,0 +1,4 @@+import Propane+import Data.Colour.Names++main = saveImage "out.png" (Size 400 400) (const (opaque green))
+ examples/quasicrystal.hs view
@@ -0,0 +1,12 @@+import Propane+import Data.Fixed ( divMod' )++wave th = rotate th (unbal . cos . fst)++combine xs = wrap . sum . sequence xs where+    wrap n = case divMod' n 1 of+        (k, v) -> if odd k then 1-v else v++im = fmap cGray . scale (1/64) . combine $ map wave (spaced 7 0 pi)++main = saveImage "out.png" (Size 400 400) im
+ examples/quasicrystal_animated.hs view
@@ -0,0 +1,12 @@+import Propane+import Data.Fixed ( divMod' )++wave t th = rotate th (unbal . cos . (+t) . fst)++combine xs = wrap . sum . sequence xs where+    wrap n = case divMod' n 1 of+        (k, v) -> if odd k then 1-v else v++ani t = fmap cGray . scale (1/64) . combine $ map (wave t) (spaced 7 0 pi)++main = saveAnimation "out.ani" 32 (Size 400 400) (speed (2*pi) ani)
+ propane.cabal view
@@ -0,0 +1,67 @@+name:                propane+version:             0.1+license:             BSD3+license-file:        LICENSE+synopsis:            Functional synthesis of images and animations+category:            Graphics+author:              Keegan McAllister <mcallister.keegan@gmail.com>+maintainer:          Keegan McAllister <mcallister.keegan@gmail.com>+build-type:          Simple+cabal-version:       >=1.6+description:+    Propane is a system for synthesizing images and animations, in the spirit+    of Pan (<http://conal.net/Pan/>) and many other projects.  The core idea is+    that an image is a function assigning a colour to each point in the plane.+    Similarly, an animation assigns an image to each point in time.  Haskell's+    tools for functional and declarative programming can be used directly on+    images and animations.+    .+    Several examples are provided, in the @examples/@ directory.+    .+    Propane uses the Repa array library.  This means that Propane automatically+    uses multiple CPU cores for rendering, provided the program is compiled and+    run with threads enabled.  That said, the implementation has not yet been+    optimized for speed.+    .+    Propane is a modest toy right now, but there are vague plans to make it+    do fancy things.  Please contact the author with suggestions or code!++extra-source-files:+    README+  , examples/gradient.hs+  , examples/green.hs+  , examples/quasicrystal.hs+  , examples/quasicrystal_animated.hs++library+  exposed-modules:+      Propane+    , Propane.Types+    , Propane.Helpers+    , Propane.Raster+    , Propane.IO+    , Propane.Colour+    , Propane.Transform+  other-modules:+      Propane.IO.Lock+  c-sources:+      cbits/global-lock.c++  ghc-options:      -Wall+  build-depends:+      base         >= 3 && < 5+    , containers   >= 0.4+    , repa         >= 2.0+    , repa-devil   >= 0.1+    , colour       >= 2.3+    , directory    >= 1.1+    , filepath     >= 1.0+    , spawn        >= 0.3++  other-extensions:+      DeriveDataTypeable+    , ForeignFunctionInterface++source-repository head+    type:     git+    location: git://github.com/kmcallister/propane