Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

wandtest from ImageMagick distribution

  • Loading branch information...
commit 965ed899834a46e99790212c084ae6a6e8731c02 1 parent aa57afe
@qrilka qrilka authored
View
1  Graphics/ImageMagick/MagickCore/Types.hs
@@ -6,6 +6,7 @@ import Graphics.ImageMagick.MagickCore.Types.FFI.AlphaChannelType as X
import Graphics.ImageMagick.MagickCore.Types.FFI.CacheView as X
import Graphics.ImageMagick.MagickCore.Types.FFI.ChannelType as X
import Graphics.ImageMagick.MagickCore.Types.FFI.Composite as X
+import Graphics.ImageMagick.MagickCore.Types.FFI.Compress as X
import Graphics.ImageMagick.MagickCore.Types.FFI.Constitute as X
import Graphics.ImageMagick.MagickCore.Types.FFI.Distort as X
import Graphics.ImageMagick.MagickCore.Types.FFI.Exception as X
View
36 Graphics/ImageMagick/MagickCore/Types/FFI/Compress.hsc
@@ -0,0 +1,36 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Graphics.ImageMagick.MagickCore.Types.FFI.Compress
+ where
+
+import Foreign.C.Types
+#include <magick/MagickCore.h>
+
+newtype CompressionType = CompressionType { unCompressionType :: CInt }
+ deriving (Eq, Show)
+
+#{enum CompressionType, CompressionType
+ , undefinedCompression = UndefinedCompression
+ , noCompression = NoCompression
+ , bzipCompression = BZipCompression
+ , dxt1Compression = DXT1Compression
+ , dxt3Compression = DXT3Compression
+ , dxt5Compression = DXT5Compression
+ , axCompression = FaxCompression
+ , group4Compression = Group4Compression
+ , jpegCompression = JPEGCompression
+ , jpeg2000Compression = JPEG2000Compression /* ISO/IEC std 15444-1 */
+ , losslessJPEGCompression = LosslessJPEGCompression
+ , lzwCompression = LZWCompression
+ , rleCompression = RLECompression
+ , zipCompression = ZipCompression
+ , zipsCompression = ZipSCompression
+ , pizCompression = PizCompression
+ , pxr24Compression = Pxr24Compression
+ , b44Compression = B44Compression
+ , b44aCompression = B44ACompression
+ , lzmaCompression = LZMACompression /* Lempel-Ziv-Markov chain algorithm */
+ , jbig1Compression = JBIG1Compression /* ISO/IEC std 11544 / ITU-T rec T.82 */
+ , jbig2Compression = JBIG2Compression /* ISO/IEC std 14492 / ITU-T rec T.88 */
+}
View
43 Graphics/ImageMagick/MagickWand/FFI/MagickWand.hsc
@@ -209,18 +209,6 @@ This integer returns the number of image formats in the list.
-MagickRelinquishMemory() relinquishes memory resources returned by such methods as MagickIdentifyImage(), MagickGetException(), etc.
-
-The format of the MagickRelinquishMemory method is:
-
- void *MagickRelinquishMemory(void *resource)
-
-A description of each parameter follows:
-resource
-
-Relinquish the memory associated with this resource.
-
-
@@ -441,3 +429,34 @@ foreign import ccall "MagickSetIteratorIndex" magickSetIteratorIndex
foreign import ccall "MagickResetIterator" magickResetIterator
:: Ptr MagickWand
-> IO ()
+
+-- | MagickSetLastIterator() sets the wand iterator to the last image.
+-- The last image is actually the current image, and the next use of
+-- MagickPreviousImage() will not change this allowing this function
+-- to be used to iterate over the images in the reverse direction.
+-- In this sense it is more like MagickResetIterator() than
+-- MagickSetFirstIterator().
+-- Typically this function is used before MagickAddImage(),
+-- MagickReadImage() functions to ensure new images are appended to
+-- the very end of wand's image list.
+foreign import ccall "MagickSetFirstIterator" magickSetFirstIterator
+ :: Ptr MagickWand
+ -> IO ()
+
+-- | MagickSetFirstIterator() sets the wand iterator to the first image.
+-- After using any images added to the wand using MagickAddImage() or
+-- MagickReadImage() will be prepended before any image in the wand.
+-- Also the current image has been set to the first image (if any) in
+-- the Magick Wand. Using MagickNextImage() will then set teh current
+-- image to the second image in the list (if present).
+-- This operation is similar to MagickResetIterator() but differs in
+-- how MagickAddImage(), MagickReadImage(), and MagickNextImage()
+-- behaves afterward.
+foreign import ccall "MagickSetLastIterator" magickSetLastIterator
+ :: Ptr MagickWand
+ -> IO ()
+
+-- | MagickRelinquishMemory() relinquishes memory resources returned
+-- by such methods as MagickIdentifyImage(), MagickGetException(), etc.
+foreign import ccall "MagickRelinquishMemory" magickRelinquishMemory
+ :: Ptr () -> IO ()
View
23 Graphics/ImageMagick/MagickWand/FFI/WandImage.hsc
@@ -29,10 +29,13 @@ foreign import ccall "MagickGetImagePixelColor" magickGetImagePixelColor
-> IO MagickBooleanType
-- | MagickGetImageCompressionQuality() gets the image compression quality.
-
foreign import ccall "MagickGetImageCompressionQuality" magickGetImageCompressionQuality
:: Ptr MagickWand -> IO CSize
+-- | MagickSetImageCompression() sets the image compression.
+foreign import ccall "MagickSetImageCompression" magickSetImageCompression
+ :: Ptr MagickWand -> CompressionType -> IO MagickBooleanType
+
-- | MagickSetImageCompressionQuality() sets the image compression quality.
foreign import ccall "MagickSetImageCompressionQuality" magickSetImageCompressionQuality
:: Ptr MagickWand -> CSize -> IO MagickBooleanType
@@ -552,3 +555,21 @@ foreign import ccall "MagickExportImagePixels" magickExportImagePixels
-- You must preallocate this array where the expected length varies depending on
-- the values of width, height, map, and type
-> IO MagickBooleanType
+
+-- | MagickRotateImage() rotates an image the specified number of degrees.
+-- Empty triangles left over from rotating the image are filled with the
+-- background color.
+foreign import ccall "MagickRotateImage" magickRotateImage
+ :: Ptr MagickWand -> Ptr PixelWand -> CDouble -> IO MagickBooleanType
+
+-- | MagickSetImageDepth() sets the image depth.
+foreign import ccall "MagickSetImageDepth" magickSetImageDepth
+ :: Ptr MagickWand -> CSize -> IO MagickBooleanType
+
+-- | MagickSetImageDelay() sets the image delay.
+foreign import ccall "MagickSetImageDelay" magickSetImageDelay
+ :: Ptr MagickWand -> CSize -> IO MagickBooleanType
+
+-- | MagickGetImageDelay() gets the image delay.
+foreign import ccall "MagickGetImageDelay" magickGetImageDelay
+ :: Ptr MagickWand -> IO CSize
View
97 Graphics/ImageMagick/MagickWand/FFI/WandProperties.hsc
@@ -5,10 +5,24 @@ module Graphics.ImageMagick.MagickWand.FFI.WandProperties
import Foreign
import Foreign.C.String
+import Foreign.C.Types
import Graphics.ImageMagick.MagickWand.FFI.Types
+foreign import ccall "MagickDeleteOption" magickDeleteOption
+ :: Ptr MagickWand
+ -> CString -- ^ the key
+ -> IO MagickBooleanType
+
+-- | MagickGetOption() returns a value associated with a wand
+-- and the specified key. Use MagickRelinquishMemory() to free
+-- the value when you are finished with it.
+foreign import ccall "MagickGetOption" magickGetOption
+ :: Ptr MagickWand
+ -> CString -- ^ the key
+ -> IO CString
+
-- | MagickSetOption() associates one or options with the wand
-- (e.g. MagickSetOption(wand,"jpeg:perserve","yes")).
foreign import ccall "MagickSetOption" magickSetOption
@@ -17,4 +31,87 @@ foreign import ccall "MagickSetOption" magickSetOption
-> CString -- ^ the value
-> IO MagickBooleanType
+-- | MagickSetFormat() sets the format of the magick wand.
+foreign import ccall "MagickSetImageFormat" magickSetImageFormat
+ :: Ptr MagickWand
+ -> CString -- ^ the image format
+ -> IO MagickBooleanType
+
+-- | MagickGetOptions() returns all the option names that match the
+-- specified pattern associated with a wand. Use MagickGetOption()
+-- to return the value of a particular option. Use MagickRelinquishMemory()
+-- to free the value when you are finished with it.
+foreign import ccall "MagickGetOptions" magickGetOptions
+ :: Ptr MagickWand
+ -> CString -- ^ the pattern
+ -> Ptr CSize
+ -> IO (Ptr CString)
+
+-- | MagickDeleteImageProperty() deletes a wand property.
+foreign import ccall "MagickDeleteImageProperty" magickDeleteImageProperty
+ :: Ptr MagickWand
+ -> CString -- ^ the property
+ -> IO MagickBooleanType
+
+-- | MagickGetImageProperty() returns a value associated with the
+-- specified property. Use MagickRelinquishMemory() to free the value
+-- when you are finished with it.
+foreign import ccall "MagickGetImageProperty" magickGetImageProperty
+ :: Ptr MagickWand
+ -> CString -- ^ the property
+ -> IO CString
+
+-- | MagickGetImageProperties() returns all the property names that
+-- match the specified pattern associated with a wand. Use
+-- MagickGetImageProperty() to return the value of a particular property.
+-- Use MagickRelinquishMemory() to free the value when you are finished
+-- with it.
+foreign import ccall "MagickGetImageProperties" magickGetImageProperties
+ :: Ptr MagickWand
+ -> CString -- ^ the pattern
+ -> Ptr CSize
+ -> IO (Ptr CString)
+
+-- | MagickSetImageProperty() associates a property with an image.
+foreign import ccall "MagickSetImageProperty" magickSetImageProperty
+ :: Ptr MagickWand
+ -> CString -- ^ the property
+ -> CString -- ^ the value
+ -> IO MagickBooleanType
+
+-- | MagickGetImageProfile() returns the named image profile.
+foreign import ccall "MagickGetImageProfile" magickGetImageProfile
+ :: Ptr MagickWand
+ -> CString -- ^ the profile name
+ -> Ptr CSize -- ^ the profile length
+ -> IO (Ptr Word8)
+
+-- | MagickRemoveImageProfile() removes the named image profile and
+-- returns it.
+foreign import ccall "MagickRemoveImageProfile" magickRemoveImageProfile
+ :: Ptr MagickWand
+ -> CString -- ^ the profile name
+ -> Ptr CSize -- ^ the profile length
+ -> IO (Ptr Word8)
+-- | MagickSetImageProfile() adds a named profile to the magick wand.
+-- If a profile with the same name already exists, it is replaced.
+-- This method differs from the MagickProfileImage() method in that
+-- it does not apply any CMS color profiles.
+foreign import ccall "MagickSetImageProfile" magickSetImageProfile
+ :: Ptr MagickWand
+ -> CString -- ^ the profile name
+ -> Ptr Word8 -- ^ the profile
+ -> CSize -- ^ the profile length
+ -> IO MagickBooleanType
+
+-- | MagickGetImageProfiles() returns all the profile names that match
+-- the specified pattern associated with a wand. Use
+-- MagickGetImageProfile() to return the value of a particular property.
+-- Use MagickRelinquishMemory() to free the value when you are finished
+-- with it.
+foreign import ccall "MagickGetImageProfiles" magickGetImageProfiles
+ :: Ptr MagickWand
+ -> CString -- ^ the pattern
+ -> Ptr CSize
+ -> IO (Ptr CString)
View
147 Graphics/ImageMagick/MagickWand/MagickWand.hs
@@ -24,17 +24,27 @@ module Graphics.ImageMagick.MagickWand.MagickWand
-- , setLastIterator
, resetIterator
, magickIterate
+ , deleteOption
+ , getOption
, setOption
+ , getOptions
+ , deleteImageProperty
+ , getImageProperty
+ , setImageProperty
+ , getImageProperties
+ , setImageFormat
+ , getImageProfile
+ , removeImageProfile
+ , setImageProfile
+ , getImageProfiles
-- , queryConfigureOption
-- , queryConfigureOptions
-- , queryFontMetrics
-- , queryMultilineFontMetrics
-- , queryFonts
-- , relinquishMemory
- , setImageArtifact
-- , deleteImageArtifact
-- , deleteImageProperty
--- , deleteOption
-- , getAntialias
-- , getBackgroundColor
-- , getColorspace
@@ -48,14 +58,8 @@ module Graphics.ImageMagick.MagickWand.MagickWand
-- , getHomeURL
-- , getImageArtifact
-- , getImageArtifacts
--- , getImageProfile
--- , getImageProfiles
--- , getImageProperty
--- , getImageProperties
-- , getInterlaceScheme
-- , getInterpolateMethod
--- , getOption
--- , getOptions
-- , getOrientation
-- , getPackageName
-- , getPage
@@ -86,10 +90,8 @@ module Graphics.ImageMagick.MagickWand.MagickWand
-- , setGravity
-- , setImageArtifact
-- , setImageProfile
--- , setImageProperty
-- , setInterlaceScheme
-- , setInterpolateMethod
--- , setOption
-- , setOrientation
-- , setPage
-- , setPassphrase
@@ -109,9 +111,13 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.ByteString
import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Vector.Storable (Vector)
+import qualified Data.Vector.Storable as V
import Filesystem.Path.CurrentOS
import Foreign hiding (void)
+import Foreign.C.String
+import Foreign.C.Types
import qualified Graphics.ImageMagick.MagickWand.FFI.MagickWand as F
import Graphics.ImageMagick.MagickWand.FFI.Types
import qualified Graphics.ImageMagick.MagickWand.FFI.WandProperties as F
@@ -135,18 +141,20 @@ magickWand :: (MonadResource m) => m (ReleaseKey, Ptr MagickWand)
magickWand = wandResource F.newMagickWand
magickIterateF :: (MonadResource m) =>
- (PMagickWand -> IO MagickBooleanType) -> PMagickWand -> (PMagickWand -> m ()) -> m ()
-magickIterateF nf w f = liftIO (F.magickResetIterator w) >> go -- TODO: use fix
+ (PMagickWand -> IO ())
+ -> (PMagickWand -> IO MagickBooleanType)
+ -> PMagickWand -> (PMagickWand -> m ()) -> m ()
+magickIterateF initF next w f = liftIO (initF w) >> go -- TODO: use fix
where
go = do
- i <- liftIO $ nf w
- unless (i==mTrue) $ f w >> go
+ i <- liftIO $ next w
+ when (i==mTrue) $ f w >> go
magickIterate :: (MonadResource m) => Ptr MagickWand -> (Ptr MagickWand -> m ()) -> m ()
-magickIterate = magickIterateF F.magickNextImage
+magickIterate = magickIterateF F.magickResetIterator F.magickNextImage
magickIterateReverse :: (MonadResource m) => Ptr MagickWand -> (Ptr MagickWand -> m ()) -> m ()
-magickIterateReverse = magickIterateF F.magickPreviousImage
+magickIterateReverse = magickIterateF F.magickSetLastIterator F.magickPreviousImage
wandResource :: (MonadResource m) => (IO (Ptr MagickWand)) -> m (ReleaseKey, Ptr MagickWand)
wandResource f = allocate f destroy
@@ -196,8 +204,113 @@ getIteratorIndex w = liftIO $ fromIntegral <$> F.magickGetIteratorIndex w
resetIterator :: (MonadResource m) => Ptr MagickWand -> m ()
resetIterator = liftIO . F.magickResetIterator
+getOption :: (MonadResource m) => Ptr MagickWand -> Text -> m Text
+getOption w key = liftIO $ do
+ cstr <- useAsCString (encodeUtf8 key) (F.magickGetOption w)
+ value <- decodeUtf8 <$> packCString cstr
+ F.magickRelinquishMemory (castPtr cstr)
+ return value
+
+-- | Associates one or options with the wand (e.g. setOption wand "jpeg:perserve" "yes").
+deleteOption :: (MonadResource m) => Ptr MagickWand -> Text -> m ()
+deleteOption w key =
+ withException_ w $ useAsCString (encodeUtf8 key) (F.magickDeleteOption w)
+
-- | Associates one or options with the wand (e.g. setOption wand "jpeg:perserve" "yes").
setOption :: (MonadResource m) => Ptr MagickWand -> Text -> Text -> m ()
setOption w key value =
withException_ w $ useAsCString (encodeUtf8 key) $
\cstr -> useAsCString (encodeUtf8 value) (F.magickSetOption w cstr)
+
+setImageFormat :: (MonadResource m) => Ptr MagickWand -> Text -> m ()
+setImageFormat w format =
+ withException_ w $ useAsCString (encodeUtf8 format) (F.magickSetImageFormat w)
+
+getOptions :: (MonadResource m) => Ptr MagickWand -> Text -> m [Text]
+getOptions w pattern = liftIO $ alloca $ \pn -> do
+ poptionps <- useAsCString (encodeUtf8 pattern) (\cstr -> F.magickGetOptions w cstr pn)
+ n <- fromIntegral <$> peek pn
+ optionps <- peekArray n poptionps
+ options <- forM optionps $ \optionp -> do
+ option <- decodeUtf8 <$> packCString optionp
+ F.magickRelinquishMemory (castPtr optionp)
+ return option
+ F.magickRelinquishMemory (castPtr poptionps)
+ return options
+
+-- | Deletes a wand property
+deleteImageProperty :: (MonadResource m) => Ptr MagickWand -> Text -> m ()
+deleteImageProperty w prop =
+ withException_ w $ useAsCString (encodeUtf8 prop) (F.magickDeleteImageProperty w)
+
+-- | Returns a value associated with the specified property
+getImageProperty :: (MonadResource m) => Ptr MagickWand -> Text -> m Text
+getImageProperty w prop = liftIO $ do
+ cstr <- useAsCString (encodeUtf8 prop) (F.magickGetImageProperty w)
+ value <- decodeUtf8 <$> packCString cstr
+ F.magickRelinquishMemory (castPtr cstr)
+ return value
+
+-- | Associates a property with an image.
+setImageProperty :: (MonadResource m) => Ptr MagickWand -> Text -> Text -> m ()
+setImageProperty w prop value =
+ withException_ w $ useAsCString (encodeUtf8 prop) $
+ \cstr -> useAsCString (encodeUtf8 value) (F.magickSetImageProperty w cstr)
+
+-- | Returns all the property names that match the specified pattern associated
+-- with a wand
+getImageProperties :: (MonadResource m) => Ptr MagickWand -> Text -> m [Text]
+getImageProperties w pattern = liftIO $ alloca $ \pn -> do
+ ppropps <- useAsCString (encodeUtf8 pattern) (\cstr -> F.magickGetImageProperties w cstr pn)
+ n <- fromIntegral <$> peek pn
+ propps <- peekArray n ppropps
+ props <- forM propps $ \propp -> do
+ prop <- decodeUtf8 <$> packCString propp
+ F.magickRelinquishMemory (castPtr propp)
+ return prop
+ F.magickRelinquishMemory (castPtr ppropps)
+ return props
+
+getProfile :: (MonadResource m) =>
+ (PMagickWand -> CString -> Ptr CSize -> IO (Ptr Word8)) ->
+ PMagickWand -> Text -> m (Vector Word8)
+getProfile f w name = liftIO $ do
+ (pprofile, len) <- alloca $ \pn -> useAsCString (encodeUtf8 name) $ \cstr -> do
+ p <- f w cstr pn
+ n <- fromIntegral <$> peek pn
+ return (p,n)
+ -- TODO: maybe we should use copyBytes instead?
+ profile <- V.generateM len (peekElemOff pprofile)
+ F.magickRelinquishMemory (castPtr pprofile)
+ return profile
+
+-- | Returns the named image profile.
+getImageProfile :: (MonadResource m) => Ptr MagickWand -> Text -> m (Vector Word8)
+getImageProfile = getProfile F.magickGetImageProfile
+
+-- | Removes the named image profile and returns it
+removeImageProfile :: (MonadResource m) => Ptr MagickWand -> Text -> m (Vector Word8)
+removeImageProfile = getProfile F.magickRemoveImageProfile
+
+-- | Adds a named profile to the magick wand. If a profile with the same
+-- name already exists, it is replaced. This method differs from the
+-- `profileImage` method in that it does not apply any CMS color profiles.
+setImageProfile :: (MonadResource m) => Ptr MagickWand -> Text -> Vector Word8 -> m ()
+setImageProfile w name profile =
+ withException_ w $ useAsCString (encodeUtf8 name) $
+ \cstr -> V.unsafeWith profile $
+ \p -> (F.magickSetImageProfile w cstr) p (fromIntegral $ V.length profile)
+
+-- | Returns all the profile names that match the specified pattern
+-- associated with a wand.
+getImageProfiles :: (MonadResource m) => Ptr MagickWand -> Text -> m [Text]
+getImageProfiles w pattern = liftIO $ alloca $ \pn -> do
+ pprofileps <- useAsCString (encodeUtf8 pattern) (\cstr -> F.magickGetImageProfiles w cstr pn)
+ n <- fromIntegral <$> peek pn
+ profileps <- peekArray n pprofileps
+ profiles <- forM profileps $ \profilep -> do
+ profile <- decodeUtf8 <$> packCString profilep
+ F.magickRelinquishMemory (castPtr profilep)
+ return profile
+ F.magickRelinquishMemory (castPtr pprofileps)
+ return profiles
View
3  Graphics/ImageMagick/MagickWand/PixelIterator.hs
@@ -66,11 +66,10 @@ pixelSetMagickColor w c = liftIO $ withForeignPtr c (F.pixelSetMagickColor w)
pixelSyncIterator :: (MonadResource m) => PPixelIterator -> m ()
pixelSyncIterator p = withException_ p $ F.pixelSyncIterator p
-
pixelResetIterator :: (MonadResource m) => PPixelIterator -> m ()
pixelResetIterator = liftIO . F.pixelResetIterator
-
+-- | creates lazy list of pixel vectors
pixelIterateList :: (MonadResource m) => PPixelIterator -> m [Vector PPixelWand]
pixelIterateList it = pixelResetIterator it >> liftIO go
where
View
22 Graphics/ImageMagick/MagickWand/Types.hs
@@ -14,7 +14,6 @@ module Graphics.ImageMagick.MagickWand.Types
, ExceptionCarrier(..)
, module Graphics.ImageMagick.MagickCore.Types
, Pixel(..)
- , Pixels(..)
) where
import Control.Exception.Base
@@ -75,37 +74,24 @@ instance ExceptionCarrier (Ptr DrawingWand) where
return $ ImageWandException x' s
class (Storable a) => Pixel a where
- data Pixels a
pixelStorageType :: [a] -> StorageType
withPixels :: [a] -> (Ptr a -> IO b) -> IO b
withPixels xs f = V.unsafeWith (V.fromList xs) f
-instance Pixel Int8 where
- data Pixels Int8 = CharPixels [Int8]
+instance Pixel Word8 where
pixelStorageType = const charPixel
-instance Pixel Int16 where
- data Pixels Int16 = ShortPixels [Int16]
+instance Pixel Word16 where
pixelStorageType = const shortPixel
-instance Pixel Int32 where
- data Pixels Int32 = IntegerPixels [Int32]
+instance Pixel Word32 where
pixelStorageType = const longPixel
-instance Pixel Int64 where
- data Pixels Int64 = LongPixels [Int64]
+instance Pixel Word64 where
pixelStorageType = const longPixel
instance Pixel Float where
- data Pixels Float = FloatPixels [Float]
pixelStorageType = const floatPixel
instance Pixel Double where
- data Pixels Double = DoublePixels [Double]
pixelStorageType = const doublePixel
- {-
-
-data Pixels = | ShortPixels [Int16] | IntegerPixels [Int32] |
- LongPixels [Int64] | FloatPixels [Float] | DoublePixels [Double]
- deriving (Eq, Show)
--}
View
32 Graphics/ImageMagick/MagickWand/WandImage.hs
@@ -5,6 +5,7 @@ module Graphics.ImageMagick.MagickWand.WandImage
, getImagePixelColor
, resizeImage
, getImageCompressionQuality
+ , setImageCompression
, setImageCompressionQuality
, getImageBackgroundColor
, setImageBackgroundColor
@@ -328,6 +329,10 @@ module Graphics.ImageMagick.MagickWand.WandImage
, removeImage
, importImagePixels
, exportImagePixels
+ , rotateImage
+ , setImageDepth
+ , getImageDelay
+ , setImageDelay
) where
import Control.Applicative ((<$>))
@@ -789,8 +794,8 @@ importImagePixels :: (MonadResource m, Pixel a) => PMagickWand
-> [a] -- ^ imported pixels
-> m ()
importImagePixels w x y width height cmap pixels =
- withException_ w $ useAsCString (encodeUtf8 cmap) $ \cstr ->
- withPixels pixels $ (F.magickImportImagePixels w x' y' width' height' cstr stype) . castPtr
+ withException_ w $ useAsCString (encodeUtf8 cmap) $ \cstr ->
+ withPixels pixels $ (F.magickImportImagePixels w x' y' width' height' cstr stype) . castPtr
where
x' = fromIntegral x
y' = fromIntegral y
@@ -808,7 +813,7 @@ exportImagePixels :: (MonadResource m, Pixel a) => PMagickWand
-- TODO migrate to typesafe parameter
-> Text -- ^ map
-> m [a]
-exportImagePixels w x y width height cmap = liftIO $ useAsCString (encodeUtf8 cmap) $ \cstr ->
+exportImagePixels w x y width height cmap = liftIO $ useAsCString (encodeUtf8 cmap) $ \cstr ->
exportArray arrLength (F.magickExportImagePixels w x' y' width' height' cstr) (undefined)
where
exportArray :: (Pixel a) => Int -> (StorageType -> Ptr () -> IO b) -> [a] -> IO [a]
@@ -819,3 +824,24 @@ exportImagePixels w x y width height cmap = liftIO $ useAsCString (encodeUtf8 cm
width' = fromIntegral width
height' = fromIntegral height
arrLength = width * height * (T.length cmap)
+
+-- | Rotates an image the specified number of degrees. Empty triangles left over
+-- from rotating the image are filled with the background color.
+rotateImage :: (MonadResource m) => PMagickWand -> PPixelWand -> Double -> m ()
+rotateImage w background degrees = withException_ w $ F.magickRotateImage w background (realToFrac degrees)
+
+-- | Sets the image depth.
+setImageDepth :: (MonadResource m) => PMagickWand -> Int -> m ()
+setImageDepth w depth = withException_ w $ F.magickSetImageDepth w (fromIntegral depth)
+
+-- | Sets the image compression.
+setImageCompression:: (MonadResource m) => PMagickWand -> CompressionType -> m ()
+setImageCompression w compressionType = withException_ w $ F.magickSetImageCompression w compressionType
+
+-- | Gets the image delay.
+getImageDelay :: (MonadResource m) => PMagickWand -> m Int
+getImageDelay w = liftIO $ fromIntegral <$> F.magickGetImageDelay w
+
+-- | Sets the image delay.
+setImageDelay :: (MonadResource m) => PMagickWand -> Int -> m ()
+setImageDelay w delay = withException_ w $ F.magickSetImageDelay w (fromIntegral delay)
View
254 examples/wandtest.hs
@@ -1,19 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
+import Control.Monad (forM_, when)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Resource (release)
import Data.Int
-import Control.Monad (when)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Resource (release)
+import qualified Data.Text as T
+import Data.Vector.Storable (Vector, (!))
+import qualified Data.Vector.Storable as V
+import Data.Word
import Graphics.ImageMagick.MagickWand
-import Text.Printf (printf)
+import Graphics.ImageMagick.MagickWand.FFI.Types
+import System.Exit
+import Text.Printf (printf)
throwAPIException w = undefined
-exitWithMessage msg = undefined
+exitWithMessage msg = liftIO $ do
+ putStrLn msg
+ exitFailure
iterateWand magick_wand = magickIterate magick_wand $ \w -> do
i <- getIteratorIndex w
s <- getImageScene w
- liftIO $ putStrLn $ printf "index %02d scene %02d" i s
+ liftIO $ putStrLn $ printf "index %2d scene %2d" i s
main :: IO ()
@@ -21,7 +29,7 @@ main = withMagickWandGenesis $ do
(_,magick_wand) <- magickWand
setSize magick_wand 640 480
size <- getSize magick_wand
- when (size /= (640,480)) $ exitWithMessage "Unexpected magick wand size\n"
+ when (size /= (640,480)) $ exitWithMessage "Unexpected magick wand size"
liftIO $ putStrLn "Reading images...\n"
readImage magick_wand "sequence.miff"
n <- getNumberImages magick_wand
@@ -33,7 +41,7 @@ main = withMagickWandGenesis $ do
magickIterateReverse magick_wand $ \w -> do
i <- getIteratorIndex w
s <- getImageScene w
- liftIO $ putStrLn $ printf "index %02d scene %02d" i s
+ liftIO $ putStrLn $ printf "index %2d scene %2d" i s
liftIO $ putStrLn "Remove scene 1..."
setIteratorIndex magick_wand 1
@@ -57,7 +65,7 @@ main = withMagickWandGenesis $ do
resetIterator magick_wand
background <- pixelWand
background `setColor` "#000000"
--- rotateImage magick_wand background 90.0
+ rotateImage magick_wand background 90.0
border <- pixelWand
background `setColor` "green"
border `setColor` "black"
@@ -66,7 +74,7 @@ main = withMagickWandGenesis $ do
(drawing_key,drawing_wand) <- drawingWand
pushDrawingWand drawing_wand
--- drawRotate drawing_wand 45
+ rotate drawing_wand 45
drawing_wand `setFontSize` 18
fill <- pixelWand
fill `setColor` "green"
@@ -89,172 +97,76 @@ main = withMagickWandGenesis $ do
255, 0, 255,
255, 255, 0,
128, 128, 128
- ] :: [Int8]
+ ] :: [Word8]
setIteratorIndex magick_wand 2
importImagePixels magick_wand 10 10 3 3 "RGB" primary_colors
pixels <- exportImagePixels magick_wand 10 10 3 3 "RGB"
-
when (pixels /= primary_colors) $ exitWithMessage "Get pixels does not match set pixels"
-{-
- {
- unsigned char
- pixels[27],
- (void) MagickSetIteratorIndex(magick_wand,2);
- status=MagickImportImagePixels(magick_wand,10,10,3,3,"RGB",CharPixel,
- primary_colors);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- status=MagickExportImagePixels(magick_wand,10,10,3,3,"RGB",CharPixel,
- pixels);
-
- if (status == MagickFalse)
- throwAPIException magick_wand);
- for (i=0; i < 9; i++)
- if (pixels[i] != primary_colors[i])
- {
- (void) FormatLocaleFile(stderr,
- "Get pixels does not match set pixels\n");
- exit(1);
- }
- }
-
+ setIteratorIndex magick_wand 3
+ resizeImage magick_wand 50 50 undefinedFilter 1.0
+ magickIterate magick_wand $ \w -> do
+ setImageDepth w 8
+ setImageCompression w rleCompression
- (void) MagickSetIteratorIndex(magick_wand,3);
- status=MagickResizeImage(magick_wand,50,50,UndefinedFilter,1.0);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- MagickResetIterator(magick_wand);
- while (MagickNextImage(magick_wand) != MagickFalse)
- {
- (void) MagickSetImageDepth(magick_wand,8);
- (void) MagickSetImageCompression(magick_wand,RLECompression);
- }
- MagickResetIterator(magick_wand);
- (void) MagickSetIteratorIndex(magick_wand,4);
- (void) FormatLocaleFile(stdout,
- "Utilitize pixel iterator to draw diagonal...\n");
- iterator=NewPixelIterator(magick_wand);
- if (iterator == (PixelIterator *) NULL)
- throwAPIException magick_wand);
- pixels=PixelGetNextIteratorRow(iterator,&number_wands);
- for (i=0; pixels != (PixelWand **) NULL; i++)
- {
- (void) PixelSetColor(pixels[i],"#224466");
- (void) PixelSyncIterator(iterator);
- pixels=PixelGetNextIteratorRow(iterator,&number_wands);
- }
- (void) PixelSyncIterator(iterator);
- iterator=DestroyPixelIterator(iterator);
- (void) FormatLocaleFile(stdout,"Write to wandtest_out.miff...\n");
- status=MagickWriteImages(magick_wand,"wandtest_out.miff",MagickTrue);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- (void) FormatLocaleFile(stdout,
- "Change image format from \"MIFF\" to \"GIF\"...\n");
- status=MagickSetImageFormat(magick_wand,"GIF");
- if (status == MagickFalse)
- throwAPIException magick_wand);
- (void) FormatLocaleFile(stdout,"Set delay between frames to %d seconds...\n",
- WandDelay);
- status=MagickSetImageDelay(magick_wand,100*WandDelay);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- delay=MagickGetImageDelay(magick_wand);
- if (delay != (100*WandDelay))
- {
- (void) FormatLocaleFile(stderr,"Get delay does not match set delay\n");
- exit(1);
- }
- (void) FormatLocaleFile(stdout,"Write to wandtest_out.gif...\n");
- status=MagickWriteImages(magick_wand,"wandtest_out.gif",MagickTrue);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- (void) FormatLocaleFile(stdout,"Set, list, get, and delete wand option...\n");
- status=MagickSetOption(magick_wand,"wand:custom-option",CustomOption);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- option=MagickGetOption(magick_wand,"wand:custom-option");
- if ((option == (const char *) NULL) ||
- (strlen(option) != strlen(CustomOption)) ||
- (memcmp(option,CustomOption,strlen(option)) != 0))
- {
- (void) FormatLocaleFile(stderr,"Option does not match\n");
- exit(1);
- }
- options=MagickGetOptions(magick_wand,"*",&number_options);
- if (options != (char **) NULL)
- {
- for (i=0; i < (ssize_t) number_options; i++)
- {
- (void) FormatLocaleFile(stdout," %s\n",options[i]);
- options[i]=(char *) MagickRelinquishMemory(options[i]);
- }
- options=(char **) MagickRelinquishMemory(options);
- }
- status=MagickDeleteOption(magick_wand,"wand:custom-option");
- if (status == MagickFalse)
- throwAPIException magick_wand);
- (void) FormatLocaleFile(stdout,
- "Set, list, get, and delete wand property...\n");
- status=MagickSetImageProperty(magick_wand,"wand:custom-property",
- CustomProperty);
- if (status == MagickFalse)
- throwAPIException magick_wand);
- property=MagickGetImageProperty(magick_wand,"wand:custom-property");
- if ((property == (const char *) NULL) ||
- (strlen(property) != strlen(CustomProperty)) ||
- (memcmp(property,CustomProperty,strlen(property)) != 0))
- {
- (void) FormatLocaleFile(stderr,"Property does not match\n");
- exit(1);
- }
- properties=MagickGetImageProperties(magick_wand,"*",&number_properties);
- if (properties != (char **) NULL)
- {
- for (i=0; i < (ssize_t) number_properties; i++)
- {
- (void) FormatLocaleFile(stdout," %s\n",properties[i]);
- properties[i]=(char *) MagickRelinquishMemory(properties[i]);
- }
- properties=(char **) MagickRelinquishMemory(properties);
- }
- status=MagickDeleteImageProperty(magick_wand,"wand:custom-property");
- if (status == MagickFalse)
- throwAPIException magick_wand);
- (void) FormatLocaleFile(stdout,
- "Set, list, get, and remove sRGB color profile...\n");
- status=MagickSetImageProfile(magick_wand,"sRGB",sRGBProfile,
- sizeof(sRGBProfile));
- if (status == MagickFalse)
- throwAPIException magick_wand);
- profile=(unsigned char *) MagickGetImageProfile(magick_wand,"sRGB",&length);
- if ((profile == (unsigned char *) NULL) || (length != sizeof(sRGBProfile)) ||
- (memcmp(profile,sRGBProfile,length) != 0))
- {
- (void) FormatLocaleFile(stderr,"Profile does not match\n");
- exit(1);
- }
- profile=(unsigned char *) MagickRelinquishMemory(profile);
- profiles=MagickGetImageProfiles(magick_wand,"*",&number_profiles);
- if (profiles != (char **) NULL)
- {
- for (i=0; i < (ssize_t) number_profiles; i++)
- {
- (void) FormatLocaleFile(stdout," %s\n",profiles[i]);
- profiles[i]=(char *) MagickRelinquishMemory(profiles[i]);
- }
- profiles=(char **) MagickRelinquishMemory(profiles);
- }
- profile=(unsigned char *) MagickRemoveImageProfile(magick_wand,"sRGB",
- &length);
- if ((profile == (unsigned char *) NULL) || (length != sizeof(sRGBProfile)) ||
- (memcmp(profile,sRGBProfile,length) != 0))
- {
- (void) FormatLocaleFile(stderr,"Profile does not match\n");
- exit(1);
- }
- profile=(unsigned char *) MagickRelinquishMemory(profile);
--}
+ resetIterator magick_wand
+ setIteratorIndex magick_wand 4
+ liftIO $ putStrLn "Utilitize pixel iterator to draw diagonal..."
+ (iterator_key,iterator) <- pixelIterator magick_wand
+ pixelRows <- pixelIterateList iterator
+ forM_ (zip [0..] pixelRows) $ \(i, pixelRow) -> do
+ pixelRow!i `setColor` "#224466"
+ pixelSyncIterator iterator
+ release iterator_key
+
+ liftIO $ putStrLn "Write to wandtest_out.miff..."
+ writeImages magick_wand "wandtest_out.miff" True
+ liftIO $ putStrLn "Change image format from \"MIFF\" to \"GIF\"..."
+ setImageFormat magick_wand "GIF"
+ let wandDelay = 3
+ newDelay = 100 * wandDelay
+ liftIO $ putStrLn $ printf "Set delay between frames to %d seconds..." wandDelay
+ setImageDelay magick_wand newDelay
+ delay <- getImageDelay magick_wand
+ when (delay /= newDelay) $ exitWithMessage "Get delay does not match set delay"
+ liftIO $ putStrLn "Write to wandtest_out.gif..."
+ writeImages magick_wand "wandtest_out.gif" True
+
+ let customOption = "custom option"
+ customOptionName = "wand:custom-option"
+ liftIO $ putStrLn "Set, list, get, and delete wand option..."
+ setOption magick_wand customOptionName customOption
+ option <- getOption magick_wand customOptionName
+ when (option /= customOption) $ exitWithMessage "Option does not match"
+ options <- getOptions magick_wand "*"
+ forM_ options $ \o -> liftIO $ putStrLn $ printf " %s" (T.unpack o)
+ deleteOption magick_wand customOptionName
+
+ let customPropertyName = "wand:custom-property"
+ customProperty = "custom profile"
+ liftIO $ putStrLn "Set, list, get, and delete wand property..."
+ setImageProperty magick_wand customPropertyName customProperty
+ property <- getImageProperty magick_wand customPropertyName
+ when (property /= customProperty) $ exitWithMessage "Property does not match"
+ properties <- getImageProperties magick_wand "*"
+ forM_ properties $ \p -> liftIO $ putStrLn $ printf " %s" (T.unpack p)
+ deleteImageProperty magick_wand customPropertyName
+
+ let profileName = "sRGB"
+ liftIO $ putStrLn "Set, list, get, and remove sRGB color profile..."
+ setImageProfile magick_wand profileName sRGBProfile
+ profile <- getImageProfile magick_wand profileName
+ when (profile /= sRGBProfile) $ exitWithMessage "Profile does not match"
+ profiles <- getImageProfiles magick_wand "*"
+ forM_ profiles $ \p -> liftIO $ putStrLn $ printf " %s" (T.unpack p)
+ removedProfile <- removeImageProfile magick_wand profileName
+ when (removedProfile /= sRGBProfile) $ exitWithMessage "Profile does not match"
liftIO $ putStrLn "Wand tests pass."
+
+-- only first 24 bytes from wandtest.c taken (no actual need for 60k profile)
+sRGBProfile :: Vector Word8
+sRGBProfile = V.fromList [
+ 0x00, 0x00, 0xee, 0x20, 0x00, 0x00, 0x00, 0x00, 0x04, 0x20, 0x00, 0x00,
+ 0x73, 0x70, 0x61, 0x63, 0x52, 0x47, 0x42, 0x20, 0x4c, 0x61, 0x62, 0x20
+ ]
View
1  imagemagick.cabal
@@ -23,6 +23,7 @@ Library
, Graphics.ImageMagick.MagickCore.FFI.Gem
, Graphics.ImageMagick.MagickCore.Types.FFI.CacheView
, Graphics.ImageMagick.MagickCore.Types.FFI.Composite
+ , Graphics.ImageMagick.MagickCore.Types.FFI.Compress
, Graphics.ImageMagick.MagickCore.Types.FFI.Constitute
, Graphics.ImageMagick.MagickCore.Types.FFI.Distort
, Graphics.ImageMagick.MagickCore.Types.FFI.Exception
View
BIN  sequence.miff
Binary file not shown
Please sign in to comment.
Something went wrong with that request. Please try again.