Parsing the raw bytestream: Haskell (319 = 332 - 13)
Without any imports at all, this program crops P1 PBM images.
g _[]=[]
g z x=(\(a,b)->a:g z b).splitAt z$x
q=map
f=filter
main=do c<-readFile"in.pbm";let(r:p)=tail.f((/='#').head).lines$c;(w:h:_)=(q read).words$r;m=min w h;t s=take m.drop((s-m)`div`2);k d=[[m,m]]++(q(t w)(t h d))in writeFile"out.pbm".("P1\n"++).unlines.q(unwords.(q show)).k.(q((q read).g 1)).take h.g w.f(`elem`"01").concat$p
Special case: helpful formatting (214 = 227 - 13)
My first attempt at PBM (P1) was based on the example at Wikipedia and assumed spaces separated the pixels, and lines in the text correlated with lines in the image. Under those conditions, this shorter version works fine.
main=do c<-readFile"in.pbm";writeFile"out.pbm".("P1\n"++).unlines.q(unwords.(q show)).k.q((q read).words).tail.filter((/='#').head).lines$c
k((w:h:_):d)=let m=min w h;t s=take m.drop((s-m)`div`2)in[[m,m]]++(q(t w)(t h d))
q=map
Bonus feature: strips out comments!
Both of the above work in essentially the same manner as the original below, but with a simpler header, lower bit depth, and no padding, although the topmost program works harder to allow for a range of formatting options.
Also available in a wide range of colours: Haskell (545 = 558 - 13)
No pre-existing image-handling functions were harmed in the making of this program.
Uncompressed 24-bit RGB bitmaps have a fairly straight-forward header system but are complicated by the mod-4 padding for each row's byte array. This code grabs the bitmap offset, width, and height from the input header, calculates the row padding, and extracts the bitmap data into a list of lists (rows of columns, bottom-left corner first).
Cropping is as simple as dropping half the excess and then taking the desired length from each list. The new file size is calculated as 3*(padded width)*height + 54 bytes (for the minimal required headers). The new header is constructed and the cropped image data appended. It's all mapped to characters and written back out to disk.
Input: in.bmp (6 characters removed from total)
Output: out.bmp (7 characters removed from total)
I think there's still some redundancy still in there, but my brain hurts to look at it this way.
import System.IO
import Data.Char
import Data.List.Split
main=do k"in.bmp"ReadMode(\h->do i h u;c<-hGetContents h;let d=l(ord)c;w=s 18d;h=s 22d;p=o w;m=min w h;q=o m;j a b=y a(r b m)in k"out.bmp"WriteMode(\g->do i g u;hPutStr g$"BM"++l chr((z e[m*(3*m+q)+54,0,54,40,m,m,1572865,0,0,1,1,0,0])++((z((++(f q$cycle[0])).y(3*m)(3*r w m)).j m h$chunksOf(3*w+p)$n(s 10d)d)))))
i=hSetBinaryMode
k=withFile
z=concatMap
l=map
v=div
f=take
n=drop
u=True
y t d=f t.n d
s d=sum.zipWith(*)(l(256^)[0..3]).y 4d
o=(`mod`4)
r a b=v(a-b)2
e x=l((`mod`256).(x`v`).(256^))[0..3]
For comparison, an ungolfed version is over 8 times as long, at 4582 (4595 - 13) bytes:
import System.IO
import Data.Char
import Data.List.Split
main = readImage cropImageToSquare
cropImageToSquare fileHandle = do
hSetBinaryMode fileHandle True
fileContents <- hGetContents fileHandle
let
inImageData = asBytes fileContents
inImageBitmapOffset = getIntFromWordAt 10 inImageData
inImageWidth = getIntFromWordAt 18 inImageData
inImageHeight = getIntFromWordAt 22 inImageData
inImageBitmapData = drop inImageBitmapOffset inImageData
inImageBitmap = chunksOf (paddedBytesForWidth inImageWidth) inImageBitmapData
outImageSideLength = min inImageWidth inImageHeight
outFileHeader = fileHeader outImageSideLength outImageSideLength
outImageHeader = imageHeader outImageSideLength outImageSideLength
outHeaders = outFileHeader ++ outImageHeader
outImageBitmap = crop outImageSideLength outImageSideLength inImageWidth inImageBitmap
in
writeImage "out.bmp" outHeaders outImageBitmap
--- Read Image ---------------------------------------------------------
readImage = withFile "in.bmp" ReadMode
--------------------------------------------------------- Read Image ---
--- Write Image --------------------------------------------------------
writeImage filename header imageBitmap = do
withFile filename WriteMode write'
where
write' fileHandle = do
hSetBinaryMode fileHandle True
hPutStr fileHandle . ("BM"++)
. map chr $ (concatMap wordFromInt header)
++ (concat imageBitmap)
-------------------------------------------------------- Write Image ---
--- Character-Integer Conversion ---------------------------------------
asBytes = map ord
getWordAt offset = take 4 . drop offset
getIntFromWordAt offset = intFromWord . getWordAt offset
intFromWord = sum . zipWith (*) (map (256^) [0..3])
wordFromInt int = map((`mod` 256) . (int `div`) . (256^)) [0..3]
--------------------------------------- Character-Integer Conversion ---
--- Headers ------------------------------------------------------------
fileHeader width height = [ fileSize
, reserved
, bitmapOffset
]
where
fileSize = imageFileSize width height
reserved = 0
bitmapOffset = 54
imageFileSize width height = 54 + height * (paddedBytesForWidth width)
paddedBytesForWidth width = 3 * width + rowPadding width
rowPadding = (`mod` 4)
imageHeader width height = [ imageHeaderSize
, width
, height
, planesAndBits
, compression
, bitmapSize
, horizontalImageResolution
, verticalImageResolution
, paletteSize
, coloursUsed
]
where
imageHeaderSize = 40
planesAndBits = int32FromInt16s colourPlanes bitDepth
colourPlanes = 1
bitDepth = 24
compression = 0
bitmapSize = 0
horizontalImageResolution = pixelsPerMetreFromDPI 72
verticalImageResolution = pixelsPerMetreFromDPI 72
paletteSize = 0
coloursUsed = 0
pixelsPerMetreFromDPI = round . (* (100/2.54))
int32FromInt16s lowBytes highBytes = lowBytes + shift 2 highBytes
shift bytesUp number = (256 ^ bytesUp) * number
------------------------------------------------------------ Headers ---
--- Crop Image ---------------------------------------------------------
crop toHeight toWidth fromWidth = cropWidth toWidth fromWidth
. cropHeight toHeight
cropHeight toHeight image = take toHeight
. drop ( halfExtra (length image) toHeight)
$ image
cropWidth toWidth fromWidth image = map ( padRow toWidth
. take (3 * toWidth)
. drop (3 * (halfExtra fromWidth toWidth))
)
$ image
padRow toWidth xs = take (paddedBytesForWidth toWidth)
$ xs ++ (repeat 0)
halfExtra fromLength toLength = (fromLength - toLength) `div` 2
--------------------------------------------------------- Crop Image ---
