bitwise-0.1.0.1: fast multi-dimensional unboxed bit packed Bool arrays

Portabilityportable
Stabilityunstable
Maintainerclaude@mathr.co.uk
Safe HaskellNone

Codec.Image.PBM

Contents

Description

Encode and decode both versions (binary P4 and plain P1) of PBM: the portable bitmap lowest common denominator monochrome image file format.

References:

Bugs:

  • This implementation is not fully compliant with the PBM specification, with respect to point 8 in the second reference above which states that a comment can actually be in the middle of what you might consider a token Such a pathological PBM file might be rejected by decodePBM, but may instead be wrongly decoded if (for example) the comment were in the middle of the image width token, leading to it being interpreted as a (smaller) width and height.

Synopsis

Documentation

data PBM Source

A decoded PBM image. pbmWidth must be less or equal to the width of the pbmPixels array (which has its first index in Y and the second in X, with lowest coordinates at the top left).

False pixels are white, True pixels are black. Pixels to the right of pbmWidth are don't care padding bits. However, these padding bits are likely to invalidate aggregrate fold operations. See trimPBM.

Constructors

PBM 

Fields

pbmWidth :: !Int
 
pbmPixels :: !(BitArray (Int, Int))
 

Encoding PBM images.

encodePBMSource

Arguments

:: BitArray (Int, Int)

pixels

-> ByteString 

Encode a binary PBM (P4) image, padding rows to multiples of 8 bits as necessary.

encodePlainPBMSource

Arguments

:: BitArray (Int, Int)

pixels

-> String 

Encode a plain PBM (P1) image.

No restrictions on pixels array size, but the file format is exceedingly wasteful of space.

data EncodeError Source

Possible reasons for encoding to fail.

Constructors

BadPixelWidth

array width is not a multiple of 8 bits

Fields

encErrPBM :: PBM
 
BadSmallWidth

image width is too smaller than array width

Fields

encErrPBM :: PBM
 
BadLargeWidth

image width is larger than array width

Fields

encErrPBM :: PBM
 

encodePBM' :: PBM -> Either EncodeError ByteStringSource

Encode a pre-padded PBM to a binary PBM (P4) image.

The pixels array must have a multiple of 8 bits per row. The image width may be less than the pixel array width, with up to 7 padding bits at the end of each row.

Decoding PBM images.

data DecodeError a Source

Possible reasons for decoding to fail, with the input that failed.

Constructors

BadMagicP a

First character was not P.

BadMagicN a

Second character was not 4 (binary) or 1 (plain).

BadWidth a

The width could not be parsed, or was non-positive.

BadHeight a

The height could not be parsed, or was non-positive.

BadSpace a

Parsing failed at the space before the pixel data.

BadPixels a

There weren't enough bytes of pixel data.

Instances

Eq a => Eq (DecodeError a) 
(Eq (DecodeError a), Ord a) => Ord (DecodeError a) 
Read a => Read (DecodeError a) 
Show a => Show (DecodeError a) 

decodePBM :: ByteString -> Either (DecodeError ByteString) (PBM, ByteString)Source

Decode a binary PBM (P4) image.

decodePlainPBM :: String -> Either (DecodeError String) (PBM, String)Source

Decode a plain PBM (P1) image.

Note that the pixel array size is kept as-is (with the width not necessarily a multiple of 8 bits).

decodePBMs :: ByteString -> ([PBM], Maybe (DecodeError ByteString))Source

Decode a sequence of binary PBM (P4) images.

Keeps decoding until end of input (in which case the snd of the result is Nothing) or an error occurred.

Padding and trimming PBM images.

padPBM :: PBM -> PBMSource

Add padding bits at the end of each row to make the array width a multiple of 8 bits, required for binary PBM (P4) encoding.

trimPBM :: PBM -> Maybe PBMSource

Trim any padding bits, required for fold operations to give meaningful results.

Fails for invalid PBM with image width greater than array width.

repadPBM :: PBM -> Maybe PBMSource

Trim then pad. The resulting PBM (if any) is suitable for encoding to binary PBM (P4), moreover its padding bits will be cleared.