module Graphics.Transform.Magick.FFIHelpers(withExceptions,
withExceptions_,
setField,
(-->),
setFilename,
getFilename,
setPage,
doTransform,
doTransformIO,
doTransformIO_XY,
doTransformIO_XY_real,
sideEffectingOp,
linkImagesTogether,
mkNewExceptionInfo,
mkNewImageInfo,
toCEnum,
hImageRows,
hImageColumns,
maybeToPtr,
mkNewUnloadedImage) where
import Graphics.Transform.Magick.Types
import Graphics.Transform.Magick.Magick
import Graphics.Transform.Magick.Errors
import Graphics.Transform.Magick.Util
import Control.Exception
import Prelude hiding (maximum, minimum)
pokeStringIntoCharArray :: Ptr CharArray -> String -> IO ()
pokeStringIntoCharArray ptr s = go (castPtr ptr) s
where go :: Ptr CChar -> String -> IO ()
go p [] = poke p nullChar
go p (c:cs) = do
debug 3 $ "p = " ++ show p ++ " c = " ++ show c
poke p (castCharToCChar c)
go (p `plusPtr` charSize) cs
peekStringFromCharArray :: Ptr CharArray -> IO String
peekStringFromCharArray ptr =
(debug 3 $ "peekStringFromCharArray: ptr = " ++ show ptr)
>> go (castPtr ptr) ""
where go :: Ptr CChar -> String -> IO String
go p s = do
debug 3 $ "p = " ++ show p
c <- (liftM castCCharToChar) $ peek p
debug 3 $ " c = " ++ show c
if c == '\0'
then return s
else go (p `plusPtr` charSize) (s ++ [c])
charSize :: Int
charSize = sizeOf (undefined::CChar)
nullChar :: CChar
nullChar = castCharToCChar '\0'
setField :: Storable a => (a -> a) -> Ptr a -> IO ()
setField modify p = peek p >>= ((poke p).modify)
(-->) :: Storable a => Ptr a -> (a -> b) -> b
(-->) p sel = unsafePerformIO $ peek p >>= (return.sel)
withExceptions :: IO a -> String -> (a -> Bool) -> (Ptr ExceptionInfo) -> IO a
withExceptions action errMsg checker excPtr = do
result <- action
if (checker result)
then do
tellUser "hsMagick: caught a GraphicsMagick exception as follows: "
catch_exception excPtr
signalException errMsg
else return result
withExceptions_ :: IO a -> String -> (a -> Bool) -> Ptr ExceptionInfo -> IO ()
withExceptions_ action errMsg checker excPtr =
withExceptions action errMsg checker excPtr >> return ()
doTransform :: (Ptr HImage_ -> Ptr ExceptionInfo
-> IO (Ptr HImage_)) -> HImage -> HImage
doTransform transform hImage =
doTransformIO (transform (getImage hImage) excInfo) hImage
where excInfo = getExceptionInfo hImage
doTransformIO :: IO (Ptr HImage_) -> HImage -> HImage
doTransformIO act hImage =
setImage hImage (unsafePerformIO
(withExceptions act
"error doing image transformation"
(== nullPtr)
excInfo))
where excInfo = getExceptionInfo hImage
doTransformIO_XY :: (Integral a, Integral b) =>
(Ptr HImage_ -> a -> a -> Ptr ExceptionInfo -> IO (Ptr HImage_)) ->
HImage -> b -> b -> HImage
doTransformIO_XY transform hImage x_ y_ =
doTransformIO (transform (getImage hImage) (fromIntegral x_) (fromIntegral y_)
(getExceptionInfo hImage))
hImage
doTransformIO_XY_real :: (Real b, Fractional a) =>
(Ptr HImage_ -> a -> a -> Ptr ExceptionInfo -> IO (Ptr HImage_)) ->
HImage -> b -> b -> HImage
doTransformIO_XY_real transform hImage x_ y_ =
doTransformIO (transform (getImage hImage) (realToFrac x_) (realToFrac y_)
(getExceptionInfo hImage))
hImage
linkImagesTogether :: [HImage] -> IO ()
linkImagesTogether [] = signalException $ "internal error: linkImagesTogether:"
++ " empty list"
linkImagesTogether (img:images) = do
foldM (\ bigImage smallImage -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 6580)) (getImage bigImage)
(getImage smallImage)
return smallImage)
img
images
debug 3 $ "Checking assertion..."
allGood <- allM nextImageNotNull (butLast images)
lastNull <- (liftM not) (nextImageNotNull (last images))
assertM (allGood && lastNull)
"flattenImage: internal error: couldn't create sequence"
where nextImageNotNull hImage = do
debug 3 $ "peeking: " ++ show (getImage hImage)
nextIm <- ((\hsc_ptr -> peekByteOff hsc_ptr 6580)) (getImage hImage)
debug 3 $ "peeked! " ++ show nextIm
return $ nextIm /= nullPtr
instance Storable FilterTypes where
sizeOf _ = sizeOf (undefined::CUInt)
alignment _ = alignment (undefined::CUInt)
peek ptr = do
(theInt::CUInt) <- peek (castPtr ptr)
return $ toEnum (fromIntegral theInt)
poke ptr val = poke (castPtr ptr) (fromEnum val)
instance Storable CompositeOp where
sizeOf _ = sizeOf (undefined::CUInt)
alignment _ = alignment (undefined::CUInt)
peek ptr = do
(theInt::CUInt) <- peek (castPtr ptr)
return $ toEnum (fromIntegral theInt)
poke ptr val = poke (castPtr ptr) (fromEnum val)
instance Storable ImageCharacteristics where
sizeOf _ = (sizeOf (undefined::CUInt)) * 5
alignment _ = alignment (undefined::CUInt)
peek ptr = do
cmyk' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
grayscale' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
mONOCHROME' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
opaque' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
palette' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
return $ ImageC { cmyk=toEnum cmyk', grayscale=toEnum grayscale',
mONOCHROME=toEnum mONOCHROME', opaque=toEnum opaque',
palette=toEnum palette'}
poke ptr i = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromEnum$ cmyk i)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (fromEnum$ grayscale i)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (fromEnum$ mONOCHROME i)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (fromEnum$ opaque i)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (fromEnum$ palette i)
instance Storable ImageStatistics where
sizeOf _ = 4 * sizeOf (undefined::ImageChannelStatistics)
alignment _ = alignment (undefined::ImageChannelStatistics)
peek ptr = do
red' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
green' <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
blue' <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) ptr
opacity' <- ((\hsc_ptr -> peekByteOff hsc_ptr 120)) ptr
return $ ImageS { red_=red', green_=green', blue_=blue', opacity_=opacity' }
poke ptr i = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (red_ i)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (green_ i)
((\hsc_ptr -> pokeByteOff hsc_ptr 80)) ptr (blue_ i)
((\hsc_ptr -> pokeByteOff hsc_ptr 120)) ptr (opacity_ i)
instance Storable ImageChannelStatistics where
sizeOf _ = 5 * sizeOf (undefined::CDouble)
alignment _ = alignment (undefined::CDouble)
peek ptr = do
(maximum'::CDouble) <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
(minimum'::CDouble) <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
(mean'::CDouble) <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
(standard_deviation'::CDouble) <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
(variance'::CDouble) <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
return $ ImageCS { maximum=realToFrac maximum', minimum=realToFrac minimum',
mean=realToFrac mean', standard_deviation=realToFrac standard_deviation',
variance=realToFrac variance' }
poke ptr i = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (maximum i)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (minimum i)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (mean i)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (standard_deviation i)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (variance i)
instance Storable ExceptionInfo where
sizeOf _ = 32
alignment _ = alignment (undefined::CULong)
peek ptr = do
severity' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
reason' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
description' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
error_number' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
mODULE' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
function' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
line' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
signature__' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
return $ ExceptionInfo { severity=severity',
reason=reason',
description=description',
error_number=error_number',
mODULE=mODULE',
function=function',
line=line',
signature__=signature__'}
poke ptr e = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (severity e )
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (reason e )
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (description e )
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (error_number e)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (mODULE e )
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr (function e )
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (signature__ e )
instance Storable (PixelPacket Word8) where
sizeOf _ = 4*(sizeOf(undefined::Word8))
alignment _ = alignment (undefined::Word8)
peek ptr = do
red' <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) ptr
green' <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) ptr
blue' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
opacity' <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) ptr
return $ PixelPacket{ red=red', green=green',
blue=blue', opacity=opacity' }
poke ptr p = do
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) ptr (red p)
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (blue p)
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) ptr (green p)
((\hsc_ptr -> pokeByteOff hsc_ptr 3)) ptr (opacity p)
instance Storable CharArray where
sizeOf _ = maxTextExtent
alignment _ = 1
peek _ = error "CharArray: peek is not implemented"
poke _ _ = error "CharArray: poke is not implemented"
instance Storable HImageInfo where
sizeOf _ = ((8404))
alignment _ = alignment (undefined::CULong)
peek ptr = do
compression' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
temporary' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
adjoin' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
antialias' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
subimage' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
subrange' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
depth' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
size' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
tile' <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
page' <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
interlace' <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
endian' <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) ptr
units' <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
quality' <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) ptr
sampling_factor' <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
server_name' <- ((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
font' <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
texture' <- ((\hsc_ptr -> peekByteOff hsc_ptr 68)) ptr
density' <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) ptr
pointsize' <- ((\hsc_ptr -> peekByteOff hsc_ptr 76)) ptr
fuzz' <- ((\hsc_ptr -> peekByteOff hsc_ptr 84)) ptr
pen' <- ((\hsc_ptr -> peekByteOff hsc_ptr 92)) ptr
background_color' <- ((\hsc_ptr -> peekByteOff hsc_ptr 96)) ptr
border_color' <- ((\hsc_ptr -> peekByteOff hsc_ptr 100)) ptr
matte_color' <- ((\hsc_ptr -> peekByteOff hsc_ptr 104)) ptr
dither' <- ((\hsc_ptr -> peekByteOff hsc_ptr 108)) ptr
monochrome' <- ((\hsc_ptr -> peekByteOff hsc_ptr 112)) ptr
colorspace' <- ((\hsc_ptr -> peekByteOff hsc_ptr 120)) ptr
tYPE' <- ((\hsc_ptr -> peekByteOff hsc_ptr 124)) ptr
group' <- ((\hsc_ptr -> peekByteOff hsc_ptr 128)) ptr
verbose' <- ((\hsc_ptr -> peekByteOff hsc_ptr 132)) ptr
view' <- ((\hsc_ptr -> peekByteOff hsc_ptr 136)) ptr
progress' <- ((\hsc_ptr -> peekByteOff hsc_ptr 116)) ptr
authenticate' <- ((\hsc_ptr -> peekByteOff hsc_ptr 140)) ptr
client_data' <- ((\hsc_ptr -> peekByteOff hsc_ptr 144)) ptr
file' <- ((\hsc_ptr -> peekByteOff hsc_ptr 148)) ptr
magick' <- peekStringFromCharArray $ ((\hsc_ptr -> hsc_ptr `plusPtr` 152)) ptr
filename' <- peekStringFromCharArray $ ((\hsc_ptr -> hsc_ptr `plusPtr` 2205)) ptr
cache' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4260)) ptr
definitions' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4264)) ptr
attributes' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4268)) ptr
ping' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4272)) ptr
preview_type' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4276)) ptr
affirm' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4280)) ptr
blob' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4284)) ptr
lENGTH' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4288)) ptr
unique' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4292)) ptr
zero' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6345)) ptr
signature' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8400)) ptr
return $ HImageInfo{compression=compression',
temporary=temporary',
adjoin=adjoin',
antialias=antialias',
subimage=subimage',
subrange=subrange',
depth=depth',
size=size',
tile=tile',
page=page',
interlace=interlace',
endian=endian',
units=units',
quality=quality',
sampling_factor=sampling_factor',
server_name=server_name',
font=font',
texture=texture',
density=density',
pointsize=pointsize',
fuzz=fuzz',
pen=pen',
background_color=background_color',
border_color=border_color',
matte_color=matte_color',
dither=dither',
monochrome=monochrome',
colorspace=colorspace',
tYPE=tYPE',
group=group',
verbose=verbose',
view=view',
progress=progress',
authenticate=authenticate',
client_data=client_data',
file=file',
magick=magick',
filename=filename',
cache=cache',
definitions=definitions',
attributes=attributes',
ping=ping',
preview_type=preview_type',
affirm=affirm',
blob=blob',
lENGTH=lENGTH',
unique=unique',
zero=zero',
signature=signature'}
poke ptr hImageInfo = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (compression hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (temporary hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (adjoin hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (antialias hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (subimage hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr (subrange hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (depth hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr (size hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (tile hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr (page hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (interlace hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 44)) ptr (endian hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr (units hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 52)) ptr (quality hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr (sampling_factor hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 60)) ptr (server_name hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 64)) ptr (font hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 68)) ptr (texture hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 72)) ptr (density hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 76)) ptr (pointsize hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 84)) ptr (fuzz hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 92)) ptr (pen hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 96)) ptr (background_color hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 100)) ptr (border_color hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 104)) ptr (matte_color hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 108)) ptr (dither hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 112)) ptr (monochrome hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 120)) ptr (colorspace hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 124)) ptr (tYPE hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 128)) ptr (group hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 132)) ptr (verbose hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 136)) ptr (view hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 140)) ptr (authenticate hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 144)) ptr (client_data hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 148)) ptr (file hImageInfo )
pokeStringIntoCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 152)) ptr) (magick hImageInfo)
pokeStringIntoCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 2205)) ptr) (filename hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4260)) ptr (cache hImageInfo )
((\hsc_ptr -> pokeByteOff hsc_ptr 4264)) ptr (definitions hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4268)) ptr (attributes hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4272)) ptr (ping hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4276)) ptr (preview_type hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4280)) ptr (affirm hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4284)) ptr (blob hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4288)) ptr (lENGTH hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 4292)) ptr (unique hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 6345)) ptr (zero hImageInfo)
((\hsc_ptr -> pokeByteOff hsc_ptr 8400)) ptr (signature hImageInfo)
instance Storable HImage_ where
sizeOf _ = ((6648))
alignment _ = alignment (undefined::CULong)
peek ptr = do
storage_class' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
colorspace_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
compression_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
dither_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
matte' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
columns' <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
rows' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
colors' <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
depth_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
colormap' <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
background_color_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
border_color_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) ptr
matte_color_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
gamma' <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) ptr
chromaticity' <- ((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
orientation' <- ((\hsc_ptr -> peekByteOff hsc_ptr 156)) ptr
rendering_intent' <- ((\hsc_ptr -> peekByteOff hsc_ptr 160)) ptr
units_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 164)) ptr
montage' <- ((\hsc_ptr -> peekByteOff hsc_ptr 168)) ptr
directory' <- ((\hsc_ptr -> peekByteOff hsc_ptr 172)) ptr
geometry' <- ((\hsc_ptr -> peekByteOff hsc_ptr 176)) ptr
offset' <- ((\hsc_ptr -> peekByteOff hsc_ptr 180)) ptr
x_resolution' <- ((\hsc_ptr -> peekByteOff hsc_ptr 184)) ptr
y_resolution' <- ((\hsc_ptr -> peekByteOff hsc_ptr 192)) ptr
page_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 200)) ptr
tile_info' <- ((\hsc_ptr -> peekByteOff hsc_ptr 216)) ptr
blur' <- ((\hsc_ptr -> peekByteOff hsc_ptr 232)) ptr
fuzz_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 240)) ptr
fILTER' <- ((\hsc_ptr -> peekByteOff hsc_ptr 248)) ptr
interlace_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 252)) ptr
endian_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 256)) ptr
gravity' <- ((\hsc_ptr -> peekByteOff hsc_ptr 260)) ptr
compose' <- ((\hsc_ptr -> peekByteOff hsc_ptr 264)) ptr
dispose' <- ((\hsc_ptr -> peekByteOff hsc_ptr 268)) ptr
scene' <- ((\hsc_ptr -> peekByteOff hsc_ptr 272)) ptr
delay' <- ((\hsc_ptr -> peekByteOff hsc_ptr 276)) ptr
iterations' <- ((\hsc_ptr -> peekByteOff hsc_ptr 280)) ptr
total_colors' <- ((\hsc_ptr -> peekByteOff hsc_ptr 284)) ptr
start_loop' <- ((\hsc_ptr -> peekByteOff hsc_ptr 288)) ptr
eRROR' <- ((\hsc_ptr -> peekByteOff hsc_ptr 292)) ptr
timer' <- ((\hsc_ptr -> peekByteOff hsc_ptr 316)) ptr
client_data_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 372)) ptr
filename_' <- peekStringFromCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 376)) ptr)
magick_filename' <- peekStringFromCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 2429)) ptr)
magick_' <- peekStringFromCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 4482)) ptr)
magick_rows' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6540)) ptr
exception' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6544)) ptr
previous' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6576)) ptr
next' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6580)) ptr
profiles' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6584)) ptr
is_monochrome' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6588)) ptr
is_grayscale' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6592)) ptr
taint' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6596)) ptr
clip_mask' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6600)) ptr
cache_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6608)) ptr
attributes_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6616)) ptr
ascii85' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6620)) ptr
blob_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6624)) ptr
reference_count' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6628)) ptr
semaphore' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6632)) ptr
logging' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6636)) ptr
list' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6640)) ptr
signature_' <- ((\hsc_ptr -> peekByteOff hsc_ptr 6644)) ptr
return $ HImage_ {
storage_class=storage_class',
colorspace_=colorspace_',
compression_=compression_',
dither_=dither_',
matte=matte',
columns=columns',
rows=rows',
colors=colors',
depth_=depth_',
colormap=colormap',
background_color_=background_color_',
border_color_=border_color_',
matte_color_=matte_color_',
gamma=gamma',
chromaticity=chromaticity',
orientation=orientation',
rendering_intent=rendering_intent',
units_=units_',
montage=montage',
directory=directory',
geometry=geometry',
offset=offset',
x_resolution=x_resolution',
y_resolution=y_resolution',
page_=page_',
tile_info=tile_info',
blur=blur',
fuzz_=fuzz_',
fILTER=fILTER',
interlace_=interlace_',
endian_=endian_',
gravity=gravity',
compose=compose',
dispose=dispose',
scene=scene',
delay=delay',
iterations=iterations',
total_colors=total_colors',
start_loop=start_loop',
eRROR=eRROR',
timer=timer',
client_data_=client_data_',
filename_=filename_',
magick_filename=magick_filename',
magick_=magick_',
magick_rows=magick_rows',
exception=exception',
previous=previous',
next=next',
profiles=profiles',
is_monochrome=is_monochrome',
is_grayscale=is_grayscale',
taint=taint',
clip_mask=clip_mask',
cache_=cache_',
attributes_=attributes_',
ascii85=ascii85',
blob_=blob_',
reference_count=reference_count',
semaphore=semaphore',
logging=logging',
list=list',
signature_=signature_'
}
poke ptr hImage = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (storage_class hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (colorspace_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (compression_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (dither_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (matte hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr (columns hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (rows hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr (colors hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (depth_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr (colormap hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (background_color_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 44)) ptr (border_color_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr (matte_color_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 52)) ptr (gamma hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 60)) ptr (chromaticity hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 156)) ptr (orientation hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 160)) ptr (rendering_intent hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 164)) ptr (units_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 168)) ptr (montage hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 172)) ptr (directory hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 176)) ptr (geometry hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 180)) ptr (offset hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 184)) ptr (x_resolution hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 192)) ptr (y_resolution hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 200)) ptr (page_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 216)) ptr (tile_info hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 232)) ptr (blur hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 240)) ptr (fuzz_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 248)) ptr (fILTER hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 252)) ptr (interlace_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 256)) ptr (endian_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 260)) ptr (gravity hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 264)) ptr (compose hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 268)) ptr (dispose hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 272)) ptr (scene hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 276)) ptr (delay hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 280)) ptr (iterations hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 284)) ptr (total_colors hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 288)) ptr (start_loop hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 292)) ptr (eRROR hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 316)) ptr (timer hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 372)) ptr (client_data_ hImage)
pokeStringIntoCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 376)) ptr) (filename_ hImage)
pokeStringIntoCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 2429)) ptr) (magick_filename hImage)
pokeStringIntoCharArray (((\hsc_ptr -> hsc_ptr `plusPtr` 4482)) ptr) (magick_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6540)) ptr (magick_rows hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6544)) ptr (exception hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6576)) ptr (previous hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6580)) ptr (next hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6584)) ptr (profiles hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6588)) ptr (is_monochrome hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6592)) ptr (is_grayscale hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6596)) ptr (taint hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6600)) ptr (clip_mask hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6608)) ptr (cache_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6616)) ptr (attributes_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6620)) ptr (ascii85 hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6624)) ptr (blob_ hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6628)) ptr (reference_count hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6632)) ptr (semaphore hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6636)) ptr (logging hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6640)) ptr (list hImage)
((\hsc_ptr -> pokeByteOff hsc_ptr 6644)) ptr (signature_ hImage)
instance Storable Rectangle where
sizeOf _ = (2*(sizeOf(undefined::CUInt))) +
(2*(sizeOf(undefined::CInt)))
alignment _ = alignment (undefined::CInt)
peek ptr = do
width' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
height' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
x' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
y' <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
return $ Rectangle{ width=width', height=height',
x=x', y=y'}
poke ptr rect = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (width rect)
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (height rect)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (x rect)
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (y rect)
instance Storable AffineMatrix where
sizeOf _ = ((48))
alignment _ = alignment (undefined::CDouble)
peek ptr = do
sx' <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
rx' <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
ry' <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
sy' <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
tx' <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
ty' <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
return $ AffineMatrix { sx=sx', rx=rx', ry=ry', sy=sy', tx=tx', ty=ty' }
poke ptr mat = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (sx mat)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (rx mat)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (ry mat)
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (sy mat)
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (tx mat)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (ty mat)
maxTextExtent :: Int
maxTextExtent = 2053
hImageRows, hImageColumns :: HImage -> Word
hImageRows = fromIntegral.columns.unsafePerformIO.peek.getImage
hImageColumns = fromIntegral.rows.unsafePerformIO.peek.getImage
class HasFilename a where
setFilename :: a -> FilePath -> IO ()
getFilename :: a -> FilePath
instance HasFilename ImageNotLoaded where
getFilename (ImageNotLoaded{ imageInfo = iInfo}) = iInfo-->filename
setFilename (ImageNotLoaded{ imageInfo = iInfo}) s =
setField (\ info -> info{filename=s}) iInfo
instance HasFilename HImage where
getFilename(HImage{ image=p, otherInfo=other }) =
let filename1 = p-->filename_
filename2 = getFilename other in
assert (filename1 == filename2) filename1
setFilename(HImage{ image=p, otherInfo=other }) s =
setFilename other s >>
setField (\ im -> im{filename_=s}) p
setPage :: HImage -> Rectangle -> IO ()
setPage hImage rect = ((\hsc_ptr -> pokeByteOff hsc_ptr 200)) (getImage hImage) rect
sideEffectingOp :: (HImage -> IO CUInt) -> HImage -> HImage
sideEffectingOp impureFun = (\ hImage -> unsafePerformIO $ do
newImage <- cloneImage hImage
withExceptions_ (impureFun newImage) "hsMagick: Error doing transformation"
(== 0) (getExceptionInfo newImage)
return newImage)
cloneImage :: HImage -> IO HImage
cloneImage hImage = do
clonedImagePtr <- cloneImagePtr (getImage hImage)
clonedImageInfo <- clone_image_info (getImageInfo hImage)
clonedExceptionInfo <- mkNewExceptionInfo
return $ mkImage clonedImagePtr (mkUnloadedImage clonedImageInfo clonedExceptionInfo)
where cloneImagePtr p = withExceptions (clone_image p 0 0 1 (getExceptionInfo hImage))
"cloneImagePtr: error cloning image"
(== nullPtr)
(getExceptionInfo hImage)
mkNewExceptionInfo :: IO (Ptr ExceptionInfo)
mkNewExceptionInfo = do
infoPtr <- malloc
get_exception_info infoPtr
return infoPtr
mkNewImageInfo :: IO (Ptr HImageInfo)
mkNewImageInfo = clone_image_info nullPtr
mkNewUnloadedImage :: ImageNotLoaded
mkNewUnloadedImage = unsafePerformIO $ do
e <- mkNewExceptionInfo
i <- mkNewImageInfo
return $ mkUnloadedImage i e
toCEnum :: (Enum a, Num b) => a -> b
toCEnum = fromIntegral.fromEnum
maybeToPtr :: Storable a => Maybe a -> Ptr a -> IO (Ptr a)
maybeToPtr Nothing _ = return nullPtr
maybeToPtr (Just stuff) p = poke p stuff >> return p