packages feed

repa-io (empty) → 1.1.0.0

raw patch · 8 files changed

+483/−0 lines, 8 filesdep +basedep +bmpdep +dph-prim-parsetup-changed

Dependencies added: base, bmp, dph-prim-par, repa, repa-bytestring

Files

+ Data/Array/Repa/IO/BMP.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE PackageImports #-} ++-- | Reading and writing arrays as uncompressed 24 and 32 bit Windows BMP files.+module Data.Array.Repa.IO.BMP+	( readImageFromBMP+	, readComponentsFromBMP+	, readMatrixFromGreyscaleBMP+	, writeImageToBMP+	, writeComponentsToBMP+	, writeMatrixToGreyscaleBMP)+where+import qualified  Data.Array.Parallel.Unlifted 	as U+import Data.Array.Repa				as A+import Data.Array.Repa.ByteString               as A+import Prelude					as P+import Codec.BMP+import Data.Word++-- Read -------------------------------------------------------------------------------------------+-- | Read a matrix from a `BMP` file.+--	Each pixel is converted to greyscale, normalised to [0..1] and used+--	as the corresponding array element. If anything goes wrong when loading the file then `Error`.+readMatrixFromGreyscaleBMP+	:: FilePath+	-> IO (Either Error (Array DIM2 Double))++readMatrixFromGreyscaleBMP filePath+ = do	eComps	<- readComponentsFromBMP filePath+	case eComps of +	 Left err	-> return $ Left err+  	 Right (arrRed, arrGreen, arrBlue)+ 	  -> let arr	= force +			$ A.fromFunction (extent arrRed)+			   (\ix -> sqrt ( (fromIntegral (arrRed   !: ix) / 255) ^ (2 :: Int)+					+ (fromIntegral (arrGreen !: ix) / 255) ^ (2 :: Int)+					+ (fromIntegral (arrBlue  !: ix) / 255) ^ (2 :: Int)))+	     in	arr `deepSeqArray` return (Right arr)+		++-- | Read RGB components from a BMP file.+--	Returns arrays of red, green and blue components, all with the same extent.+--	If anything goes wrong when loading the file then then `Error`.+readComponentsFromBMP+	:: FilePath+	-> IO (Either Error (Array DIM2 Word8, Array DIM2 Word8, Array DIM2 Word8))++{-# INLINE readComponentsFromBMP #-}+readComponentsFromBMP filePath+ = do	ebmp	<- readBMP filePath+	case ebmp of+	 Left err	-> return $ Left err+	 Right bmp	-> return $ Right (readComponentsFromBMP' bmp)++readComponentsFromBMP' bmp+ = let	(width, height) = bmpDimensions bmp++	arr		= A.fromByteString (Z :. height :. width * 4)+			$ unpackBMPToRGBA32 bmp++	shapeFn _ 	= Z :. height :. width++	arrRed	+	 = traverse arr shapeFn+		(\get (sh :. x) -> get (sh :. (x * 4)))++	arrGreen+	 = traverse arr shapeFn+		(\get (sh :. x) -> get (sh :. (x * 4 + 1)))++	arrBlue+	 = traverse arr shapeFn+		(\get (sh :. x) -> get (sh :. (x * 4 + 2)))+	+   in	(arrRed, arrGreen, arrBlue)+++-- | Read a RGBA image from a BMP file.+--	In the result, the higher two dimensions are the height and width,+--	and the lower indexes the RGBA component of each pixel. +--      If the BMP read has no alpha channel then alpha of the resulting pixels is set to 255.+--	If anything goes wrong when loading the file then `Error`.+readImageFromBMP +	:: FilePath+	-> IO (Either Error (Array DIM3 Word8))++readImageFromBMP filePath+ = do	ebmp	<- readBMP filePath+	case ebmp of+	 Left err	-> return $ Left err+	 Right bmp	-> return $ Right (readImageFromBMP' bmp)+	+readImageFromBMP' bmp+ = let	(width, height)	= bmpDimensions bmp+	arr		= fromByteString (Z :. height :. width :. 4)+			$ unpackBMPToRGBA32 bmp+   in	arr++++-- Write ------------------------------------------------------------------------------------------+-- | Write a matrix to a BMP file.+--	Negative values are discarded. Positive values are normalised to the maximum +--	value in the matrix and used as greyscale pixels.+writeMatrixToGreyscaleBMP +	:: FilePath+	-> Array DIM2 Double+	-> IO ()++writeMatrixToGreyscaleBMP fileName arr+ = let	arrNorm		= normalisePositive01 arr++	scale :: Double -> Word8+	scale x		= fromIntegral (truncate (x * 255) :: Int)++	arrWord8	= A.map scale arrNorm+   in	writeComponentsToBMP fileName arrWord8 arrWord8 arrWord8+		++-- | Write RGB components to a BMP file.+--	All arrays must have the same extent, else `error`.+writeComponentsToBMP+	:: FilePath+	-> Array DIM2 Word8+	-> Array DIM2 Word8+	-> Array DIM2 Word8+	-> IO ()++writeComponentsToBMP fileName arrRed arrGreen arrBlue+ | not $ (  extent arrRed   == extent arrGreen       +         && extent arrGreen == extent arrBlue)+ = error "Data.Array.Repa.IO.BMP.writeComponentsToBMP: arrays don't have same extent"++ | otherwise+ = do	let Z :. height :. width	+			= extent arrRed+		+	-- Build image data from the arrays.+	let arrAlpha	= fromFunction (extent arrRed) (\_ -> 255)+	let arrRGBA	= interleave4 arrRed arrGreen arrBlue arrAlpha+	let bmp		= packRGBA32ToBMP width height+			$ A.toByteString arrRGBA+	+	writeBMP fileName bmp+++-- | Write a RGBA image to a BMP file.+--	The higher two dimensions are the height and width of the image. +--	The lowest dimension must have size 4, corresponding to the RGBA components+--	of each pixel, else `error`. +writeImageToBMP +	:: FilePath+	-> Array DIM3 Word8+	-> IO ()++writeImageToBMP fileName arrImage+	| comps /= 4+	= error "Data.Array.Repa.IO.BMP: lowest order dimension must be 4"++	| otherwise+	= let 	bmp	= packRGBA32ToBMP height width +			$ A.toByteString arrImage+	  in	writeBMP fileName bmp+	+	where	Z :. height :. width :. comps	+			= extent arrImage+	++-- Normalise --------------------------------------------------------------------------------------+-- | Normalise a matrix to to [0 .. 1], discarding negative values.+--	If the maximum value is 0 then return the array unchanged.+normalisePositive01+	:: (Shape sh, U.Elt a, Fractional a, Ord a)+	=> Array sh a+	-> Array sh a++{-# INLINE normalisePositive01 #-}+normalisePositive01 arr	+ = let	mx		= foldAll max 0 arr+   	elemFn x+	 | x >= 0	= x / mx+	 | otherwise	= x+   in	mx `seq`+	 if mx == 0 +	  then arr+	  else A.map elemFn arr+
+ Data/Array/Repa/IO/ColorRamp.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE RankNTypes #-}++-- | Hyprometric color ramps, for making pretty images from scalar data.+module	Data.Array.Repa.IO.ColorRamp+	(rampColorHotToCold)+where++-- | Standard Hot to Cold hypsometric color ramp.+--	Color sequence is red, yellow, green, cyan, blue.+rampColorHotToCold +	:: forall a+	.  (Ord a, Floating a) +	=> a 	-- ^ Minimum value of range.+	-> a 	-- ^ Maximum value of range.+	-> a 	-- ^ Data value.+	-> (a, a, a)+	+{-# INLINE rampColorHotToCold #-}+rampColorHotToCold vmin vmax vNotNorm+ = let	+	v	| vNotNorm < vmin	= vmin+	 	| vNotNorm > vmax	= vmax+		| otherwise		= vNotNorm+	+	dv	= vmax - vmin	++	result	| v < vmin + 0.25 * dv+		= ( 0+		  , 4 * (v - vmin) / dv+		  , 1.0)+		+		| v < vmin + 0.5 * dv+		= ( 0+		  , 1.0+		  , 1 + 4 * (vmin + 0.25 * dv - v) / dv)+		+		| v < vmin + 0.75 * dv+		= ( 4 * (v - vmin - 0.5 * dv) / dv+		  , 1.0+		  , 0.0)+		+		| otherwise+		= ( 1.0+		  , 1 + 4 * (vmin + 0.75 * dv - v) / dv+		  , 0)+		+  in	result+
+ Data/Array/Repa/IO/Internals/Text.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_HADDOCK hide #-}+module Data.Array.Repa.IO.Internals.Text+	( hWriteValues+	, readValues)+where+import System.IO+import Data.Char++-- Stuff shared with Matrix module -------------------------------------------------------------+-- | Write out values to a file.+hWriteValues+	:: Show a+	=> Handle +	-> [a] 				-- ^ Data values.+	-> IO ()++hWriteValues handle xx+ = go xx+ where	go []		= return ()+	go (x:xs)+	 = do	hPutStr handle $ show x+		hPutStr handle $ "\n"+		go xs+++-- | Read a string containing ints separated by whitespace.	+readValues :: (Num a, Read a) => String -> [a]+readValues cs	= readValues' [] cs+ where	readValues' _ []	= []+	readValues' acc (c : rest)+		| isSpace c+		= if null acc +			then readValues' [] rest+			else read (reverse acc) : readValues' [] rest++		| isDigit c || c == '.' || c == 'e' || c == '-'+		= readValues' (c : acc) rest++		| otherwise+		= error $ "unexpected char in Matrix file " ++ show (ord c)+
+ Data/Array/Repa/IO/Matrix.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE PackageImports #-}+-- | Read and write matrices as ASCII text files.+--+--   The file format is like:+--+--   @+--	MATRIX			-- header+--	100 100			-- width and height+--	1.23 1.56 1.23 ...	-- data, separated by whitespace+--	....+--   @+module Data.Array.Repa.IO.Matrix+	( readMatrixFromTextFile+	, writeMatrixToTextFile)+where+import Data.Array.Repa.IO.Internals.Text+import Control.Monad+import System.IO+import Data.List				as L+import Data.Array.Repa				as A+import Prelude					as P+import qualified "dph-prim-par" Data.Array.Parallel.Unlifted	as U+++-- | Read a matrix from a text file.+--+--   WARNING: This doesn't do graceful error handling. If the file has the wrong format+--   you'll get a confusing `error`.+readMatrixFromTextFile+	:: (U.Elt a, Num a, Read a)+	=> FilePath+	-> IO (Array DIM2 a)	++readMatrixFromTextFile fileName+ = do	handle		<- openFile fileName ReadMode+	+	"MATRIX"	<- hGetLine handle+	[width, height]	<- liftM (P.map read . words) $ hGetLine handle+	str		<- hGetContents handle+	let vals	= readValues str++	let dims	= Z :. width :. height+	let mat		= fromList dims vals++	return mat+++-- | Write a matrix as a text file.+writeMatrixToTextFile +	:: (U.Elt a, Show a)+	=> FilePath+	-> Array DIM2 a+	-> IO ()++writeMatrixToTextFile fileName arr+ = do	file	<- openFile fileName WriteMode	++	hPutStrLn file "MATRIX"++	let Z :. width :. height	+		= extent arr++	hPutStrLn file $ show width ++ " " ++ show height+		+	hWriteValues file $ toList arr+	hClose file+
+ Data/Array/Repa/IO/Vector.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE PackageImports #-}+-- | Read and write vectors as ASCII text files.+--+--   The file format is like:+--+--   @+--	VECTOR			-- header+--	100			-- length of vector+--	1.23 1.56 1.23 ...	-- data, separated by whitespace+--	....+--   @+module Data.Array.Repa.IO.Vector+	( readVectorFromTextFile+	, writeVectorToTextFile)+where+import Data.Array.Repa				as A+import Data.Array.Repa.IO.Internals.Text+import Data.List				as L+import Prelude					as P+import System.IO+import Control.Monad+import Data.Char+import qualified "dph-prim-par" Data.Array.Parallel.Unlifted	as U+++-- | Read a vector from a text file.+--   WARNING: This doesn't do graceful error handling. If the file has the wrong format+--   you'll get a confusing `error`.+readVectorFromTextFile+	:: (U.Elt a, Num a, Read a)+	=> FilePath+	-> IO (Array DIM1 a)	++readVectorFromTextFile fileName+ = do	handle		<- openFile fileName ReadMode+	+	"VECTOR"	<- hGetLine handle+	[len]		<- liftM (P.map readInt . words) $ hGetLine handle+	str		<- hGetContents handle+	let vals	= readValues str++	let dims	= Z :. len+	let vec		= fromList dims vals++	return vec++readInt :: String -> Int+readInt str+	| and $ P.map isDigit str+	= read str+	+	| otherwise+	= error "Data.Array.Repa.IO.Vector.readVectorFromTextFile parse error when reading data"+	+	+-- | Write a vector as a text file.+writeVectorToTextFile +	:: (U.Elt a, Show a)+	=> Array DIM1 a+	-> FilePath+	-> IO ()++writeVectorToTextFile arr fileName+ = do	file	<- openFile fileName WriteMode	++	hPutStrLn file "VECTOR"++	let Z :. len+		= extent arr++	hPutStrLn file 	$ show len+	hWriteValues file $ toList arr+	hClose file+	hFlush file+
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2010, University of New South Wales.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * 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.+    * Neither the name of the University of New South Wales nor the+      names of its 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 ''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 COPYRIGHT HOLDERS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ repa-io.cabal view
@@ -0,0 +1,40 @@+Name:                repa-io+Version:             1.1.0.0+License:             BSD3+License-file:        LICENSE+Author:              The DPH Team+Maintainer:          Ben Lippmeier <benl@ouroborus.net>+Build-Type:          Simple+Cabal-Version:       >=1.6+Stability:           experimental+Category:            Data Structures+Homepage:            http://trac.haskell.org/repa+Bug-reports:         http://trac.haskell.org/repa/newticket+Description:+        NOTE: You must use the GHC head branch > 6.13.20100309 to get decent performance.+        Read and write Repa arrays in various formats.++Synopsis:+        Read and write Repa arrays in various formats.++Tested-with: GHC == 6.13.20100309, GHC == 6.12.1++Library+  Build-Depends: +        base                 == 4.*,+        dph-prim-par         == 0.4.*,+        repa                 == 1.1.*,+        repa-bytestring      == 1.1.*,+        bmp                  == 1.1.*++  ghc-options:+        -Odph -Wall -fno-warn-missing-signatures++  Exposed-modules:+        Data.Array.Repa.IO.ColorRamp+        Data.Array.Repa.IO.BMP+        Data.Array.Repa.IO.Vector+        Data.Array.Repa.IO.Matrix+      +  Other-modules:+        Data.Array.Repa.IO.Internals.Text