{-# OPTIONS_GHC -XScopedTypeVariables -XFlexibleContexts #-}-- | "Graphics.Pgm" is a pure Haskell library to read and write PGM images. It properly supports both 8 bit and 16 bit pixels, and multiple PGMs per file. The PGM is the lowest common denominator of useful image file formats. It consists of a header of the form-- -- @P5 width height maxVal@-- -- followed by a single whitespace charater, usually a newline, where @width@, @height@, and @maxVal@ are positive integers consisting of digits only giving the number of columns, number of rows, and the highest grey level in the image to follow.-- -- If @maxVal@ < 256, then the format uses 1 byte per pixel; otherwise it uses 2. The routines in this library properly handle both, including automatically determining which to write when writing an array to disk.-- -- The header can also contain comments, starting with @#@ on a new line, and continuing to the end of the line. These are read out and returned as a String with newlines kept intact (except for the last newline of the last comment line, which is removed). Comments from anywhere between the header fields are concatenated into the same document. 'pgmToArray' ignores comments; 'pgmToArrayWithComments' reads them.-- -- After the header, the pixel data is written in big-endian binary form, most significant byte first for 16 bit pixels. The pixels are a single row-major raster through the image.-- -- To put multiple PGMs in a file, append them. This module allows you to put white space between them, though this might choke other implementations.-- -- All arrays returned by this library from PGMs have pixel type 'Int', since this is simply more useful for most purposes. If you want to write a PGM back out, you must first coerce your pixel type to 'Word16'! There are too many possibile ways of handling negative values, larger depths, or other things beyond the comprehension of 'Word16' to handle with a simple wrapper function. If you know you have positive values less than 2^16, then you can coerce an array @arr@ to 'Word16' with-- -- > amap (fromIntegral :: Int -> Word16) arr-- -- The array's indices (of the form (row,column)) start at (0,0) and run to (@height@-1,@width@-1).moduleGraphics.Pgm(pgmToArray,pgmsToArrays,pgmToArrayWithComments,pgmsToArraysWithComments,arrayToPgmWithComment,pgmsFromFile,pgmsFromHandle,arrayToPgm,arrayToFile,arrayToHandle,arraysToHandle,arraysToFile)whereimportText.ParsecimportText.Parsec.ByteString(Parser)importSystem.IOimportData.Array.UnboxedimportData.ByteStringasB(take,drop,unpack,pack,ByteString,append,hGetContents,hPutStr)importData.ByteString.Internal(c2w)importData.WordimportText.PrintfimportControl.Monad(liftM)importData.List(intercalate)magicNumber::Parser()magicNumber=do{char'P';char'5';return()}integer::ParserIntinteger=do{s<-many1digit;return$reads}width::ParserIntwidth=integerheight::ParserIntheight=integermaxVal::ParserIntmaxVal=do{i<-integer;return$min65536i}comment::ParserStringcomment=do{char'#';c<-manyTillanyChar(trynewline);return$c++"\n"}commentAwareWhiteSpace::ParserStringcommentAwareWhiteSpace=liftMconcat$many1(choice[comment,do{many1space;return""}])pgmHeader::Parser(Int,Int,Int,String)pgmHeader=domagicNumber<?>"magic number"hVal0<-commentAwareWhiteSpacecols<-width<?>"width"hVal1<-commentAwareWhiteSpacerows<-height<?>"height"hVal2<-commentAwareWhiteSpacem<-maxVal<?>"maximum grey value"spaceletq=hVal0++hVal1++hVal2return(rows,cols,m,Prelude.initq)pgmWithComments::(IArrayUArraya,Integrala)=>Parser(UArray(Int,Int)a,String)pgmWithComments=do(rows,cols,m,comments)<-pgmHeaderletd=if(m<256)then1else2ip<-getInputletbody=B.take(rows*cols*d)ipsetInput$B.drop(rows*cols*d)ipletarr=readArraydrowscolsbodyreturn(arr,comments)pgmsWithComments::(IArrayUArraya,Integrala)=>Parser[(UArray(Int,Int)a,String)]pgmsWithComments=many1(do{h<-pgmWithComments;spaces;returnh})pgm::(IArrayUArraya,Integrala)=>Parser(UArray(Int,Int)a)pgm=do(rows,cols,m,_)<-pgmHeaderletd=if(m<256)then1else2ip<-getInputletbody=B.take(rows*cols*d)ipsetInput$B.drop(rows*cols*d)ipletarr=readArraydrowscolsbodyreturn(arr)pgms::(IArrayUArraya,Integrala)=>Parser[UArray(Int,Int)a]pgms=many1(do{h<-pgm;spaces;returnh})-- | Parse the first (and possible only) PGM in a 'ByteString' into an array. If the parsing succeeds, you will still need to match on the 'Right' constructor to get the array.pgmToArray::(Integrala,IArrayUArraya)=>B.ByteString->EitherParseError(UArray(Int,Int)a)pgmToArrays=parsepgm"Failed to parse PGM."s-- | The same as 'pgmToArray', but taking also returning the comments in the PGM file as a String.pgmToArrayWithComments::(Integrala,IArrayUArraya)=>B.ByteString->EitherParseError(UArray(Int,Int)a,String)pgmToArrayWithCommentss=parsepgmWithComments"Failed to parse PGM."s-- | Precisely the same as 'pgmToArray', but this time fetches all the PGMs in the file, and returns them as a list of arrays.pgmsToArrays::(Integrala,IArrayUArraya)=>B.ByteString->EitherParseError[UArray(Int,Int)a]pgmsToArrayss=parsepgms"Failed to parse PGMs."s-- | Same as 'pgmsToArrays', but again returning comments.pgmsToArraysWithComments::(Integrala,IArrayUArraya)=>B.ByteString->EitherParseError[(UArray(Int,Int)a,String)]pgmsToArraysWithCommentss=parsepgmsWithComments"Failed to parse PGMs."s-- | A wrapper around 'pgmsFromHandle' which also opens the file to read from.pgmsFromFile::String->IO(EitherParseError[UArray(Int,Int)Int])pgmsFromFilefname=doh<-openFilefnameReadModes<-pgmsFromHandlehhClosehreturns-- | Parse all PGMs in the contents of a handle, and return them as a list of arrays.pgmsFromHandle::Handle->IO(EitherParseError[UArray(Int,Int)Int])pgmsFromHandleh=liftMpgmsToArrays$B.hGetContentshreadArray8::Int->Int->B.ByteString->UArray(Int,Int)Word8readArray8rowscolssrc=listArray((0,0),(rows-1,cols-1))(unpacksrc)readArray16::Int->Int->B.ByteString->UArray(Int,Int)Word16readArray16rowscolssrc=listArray((0,0),(rows-1,cols-1))src'whereraw=unpacksrcsrc'=pairWithfrawfab=(fromIntegrala)*256+(fromIntegralb)readArray::(IArrayUArraya,Integrala)=>Int->Int->Int->B.ByteString->UArray(Int,Int)areadArray1rowscolssrc=amapfromIntegral$readArray8rowscolssrcreadArray2rowscolssrc=amapfromIntegral$readArray16rowscolssrcpair::[a]->[(a,a)]pair[]=[]pair(_:[])=[]pair(a:b:ls)=(a,b):(pairls)pairWith::(a->a->b)->[a]->[b]pairWithfls=Prelude.map(\(a,b)->fab)$pairlspgmHeaderString::Int->Int->Word16->String->B.ByteStringpgmHeaderStringrowscolsmValcomm=pack$(Prelude.mapc2w)$printf"P5\n#%s\n%d %d %d\n"(formatcomm)(cols+1)(rows+1)mValwhereformatstr=Data.List.intercalate"\n#"$linesstr-- | Takes an array (which must already be coerced to have element type 'Word16') and produces a 'ByteString' encoding that array as a PGM.arrayToPgm::IArraymWord16=>m(Int,Int)Word16->B.ByteStringarrayToPgmarr=pgmHeaderStringrowscolsmVal""`B.append`listToByteStringmVal(elemsarr)where(rows,cols)=(xmax-xmin,ymax-ymin)((xmin,ymin),(xmax,ymax))=boundsarrmVal=arrayLiftmaxarr-- | Precisely the same as 'arrayToPgm', but takes a 'String' to encode into the file header as a comment after the magic number but before the width field.arrayToPgmWithComment::IArraymWord16=>m(Int,Int)Word16->String->B.ByteStringarrayToPgmWithCommentarrcm=pgmHeaderStringrowscolsmValcm`B.append`listToByteStringmVal(elemsarr)where(rows,cols)=(xmax-xmin,ymax-ymin)((xmin,ymin),(xmax,ymax))=boundsarrmVal=arrayLiftmaxarrarrayLift::(Ixi,IArrayma)=>(a->a->a)->mia->aarrayLiftfarr=Prelude.foldlf(headq)qwhereq=elemsarrlistToByteString::Word16->[Word16]->B.ByteStringlistToByteStringdvs|d<256=pack$((Prelude.mapfromIntegralvs)::[Word8])|otherwise=pack$concat$map(\x->[fromIntegral(x`div`256),fromIntegral(x`rem`256)])vs-- | Write a single array to a given handle.arrayToHandle::IArraymWord16=>Handle->m(Int,Int)Word16->IO()arrayToHandleharr=B.hPutStrh(arrayToPgmarr)-- | A wrapper around 'arrayToHandle' which opens the file to write to, then closes it afterwards.arrayToFile::IArraymWord16=>String->m(Int,Int)Word16->IO()arrayToFilefnamearr=doh<-openFilefnameWriteModearrayToHandleharrhCloseh-- | Writes a list of arrays to a given handle. Note that most implementations of PGM will ignore all but the first when they read this file.arraysToHandle::IArraymWord16=>Handle->[m(Int,Int)Word16]->IO()arraysToHandleharrs=mapM_(arrayToHandleh)arrs-- | A wrapper around 'arraysToHandle' which opens and closes the file to write to.arraysToFile::IArraymWord16=>String->[m(Int,Int)Word16]->IO()arraysToFilefnamearrs=doh<-openFilefnameWriteModearraysToHandleharrshCloseh