'From Squeak3.3alpha of 24 January 2002 [latest update: #4889] on 16 June 2002 at 9:37:47 pm'! "Change Set: BMPReadWriter-ar Date: 16 June 2002 Author: Andreas Raab Published to 3.3a as 4891BMPReadWriter-ar.cs. Adds class BMPReadWriter, cleans up some stuff in class Form, makes BMP reading a lot faster by adding a tiny plugin. Also makes JPEGReadWriter prefer JPEGReadWriter2 if the plugin is present and removes the need to read the entire file just to figure out if JPEGRW will understand it."! ImageReadWriter subclass: #BMPReadWriter instanceVariableNames: 'bfType bfSize bfOffBits biSize biWidth biHeight biPlanes biBitCount biCompression biSizeImage biXPelsPerMeter biYPelsPerMeter biClrUsed biClrImportant ' classVariableNames: '' module: #(Squeak Media Graphics Files)! InterpreterPlugin subclass: #BMPReadWriterPlugin instanceVariableNames: '' classVariableNames: '' module: #(Squeak VMConstruction Plugins)! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 15:36'! nextImage | colors | stream binary. self readHeader. biBitCount = 24 ifTrue:[^self read24BmpFile]. "read the color map" colors := self readColorMap. ^self readIndexedBmpFile: colors! ! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 17:24'! read24BmpFile "Read 24-bit pixel data from the given a BMP stream." | form formBits pixelLine bitsIndex | form _ Form extent: biWidth@biHeight depth: 32. pixelLine := ByteArray new: (((24 * biWidth) + 31) // 32) * 4. bitsIndex := form height - 1 * biWidth + 1. formBits := form bits. 1 to: biHeight do: [:i | pixelLine := stream nextInto: pixelLine. self read24BmpLine: pixelLine into: formBits startingAt: bitsIndex width: biWidth. bitsIndex := bitsIndex - biWidth. ]. ^ form ! ! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 18:47'! read24BmpLine: pixelLine into: formBits startingAt: formBitsIndex width: width | pixIndex rgb bitsIndex | pixIndex _ 0. "pre-increment" bitsIndex := formBitsIndex-1. "pre-increment" 1 to: width do: [:j | rgb := (pixelLine at: (pixIndex := pixIndex+1)) + ((pixelLine at: (pixIndex := pixIndex+1)) bitShift: 8) + ((pixelLine at: (pixIndex := pixIndex+1)) bitShift: 16). rgb = 0 ifTrue:[rgb := 16rFF000001] ifFalse:[rgb := rgb + 16rFF000000]. formBits at: (bitsIndex := bitsIndex+1) put: rgb. ]. ! ! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 18:17'! readColorMap "Read colorCount BMP color map entries from the given binary stream. Answer an array of Colors." | colorCount colors maxLevel b g r ccStream | colorCount _ (bfOffBits - 54) // 4. "Note: some programs (e.g. Photoshop 4.0) apparently do not set colorCount; assume that any data between the end of the header and the start of the pixel data is the color map" biBitCount = 16 ifTrue:[^nil]. colorCount = 0 ifTrue: [ "this BMP file does not have a color map" "default monochrome color map" biBitCount = 1 ifTrue: [^ Array with: Color white with: Color black]. "default gray-scale color map" maxLevel _ (2 raisedTo: biBitCount) - 1. ^ (0 to: maxLevel) collect: [:level | Color gray: (level asFloat / maxLevel)]]. ccStream := ReadStream on: (stream next: colorCount*4). colors _ Array new: colorCount. 1 to: colorCount do: [:i | b _ ccStream next. g _ ccStream next. r _ ccStream next. ccStream next. "skip reserved" colors at: i put: (Color r: r g: g b: b range: 255)]. ^ colors ! ! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 15:20'! readHeader | reserved | bfType _ stream nextLittleEndianNumber: 2. bfSize _ stream nextLittleEndianNumber: 4. reserved _ stream nextLittleEndianNumber: 4. bfOffBits _ stream nextLittleEndianNumber: 4. biSize _ stream nextLittleEndianNumber: 4. biWidth _ stream nextLittleEndianNumber: 4. biHeight _ stream nextLittleEndianNumber: 4. biPlanes _ stream nextLittleEndianNumber: 2. biBitCount _ stream nextLittleEndianNumber: 2. biCompression _ stream nextLittleEndianNumber: 4. biSizeImage _ stream nextLittleEndianNumber: 4. biXPelsPerMeter _ stream nextLittleEndianNumber: 4. biYPelsPerMeter _ stream nextLittleEndianNumber: 4. biClrUsed _ stream nextLittleEndianNumber: 4. biClrImportant _ stream nextLittleEndianNumber: 4. ! ! !BMPReadWriter methodsFor: 'reading' stamp: 'ar 6/16/2002 15:35'! readIndexedBmpFile: colors "Read uncompressed pixel data of depth d from the given BMP stream, where d is 1, 4, 8, or 16" | form bytesPerRow pixelData pixelLine startIndex cm word formBits | colors ifNil:[form _ Form extent: biWidth@biHeight depth: biBitCount] ifNotNil:[form _ ColorForm extent: biWidth@biHeight depth: biBitCount. form colors: colors]. bytesPerRow _ (((biBitCount* biWidth) + 31) // 32) * 4. pixelData _ ByteArray new: bytesPerRow * biHeight. biHeight to: 1 by: -1 do: [:y | pixelLine _ stream next: bytesPerRow. startIndex _ ((y - 1) * bytesPerRow) + 1. pixelData replaceFrom: startIndex to: startIndex + bytesPerRow - 1 with: pixelLine startingAt: 1]. form bits copyFromByteArray: pixelData. biBitCount = 16 ifTrue:[ "swap red and blue components" cm _ Bitmap new: (1 << 15). word _ 0. 0 to: 31 do:[:r| 0 to: 31 do:[:g| 0 to: 31 do:[:b| cm at: (word _ word + 1) put: (b bitShift: 10) + (g bitShift: 5) + r]]]. cm at: 1 put: 1. formBits _ form bits. 1 to: formBits size do:[:i| word _ formBits at: i. word _ (cm at: (word bitAnd: 16r7FFF) + 1) + ((cm at: ((word bitShift: -16) bitAnd: 16r7FFF) +1) bitShift: 16). formBits at: i put: word. ]. ]. ^ form ! ! !BMPReadWriter methodsFor: 'writing' stamp: 'ar 6/16/2002 17:50'! nextPutImage: aForm | bhSize rowBytes rgb data colorValues depth image | depth := aForm depth. [#(1 4 8 32) includes: depth] whileFalse:[depth := depth + 1 asLargerPowerOfTwo]. image := aForm asFormOfDepth: depth. image unhibernate. bhSize _ 14. "# bytes in file header" biSize _ 40. "info header size in bytes" biWidth := image width. biHeight := image height. biClrUsed _ depth = 32 ifTrue: [0] ifFalse:[1 << depth]. "No. color table entries" bfOffBits _ biSize + bhSize + (4*biClrUsed). rowBytes _ ((depth min: 24) * biWidth + 31 // 32) * 4. biSizeImage _ biHeight * rowBytes. "Write the file header" stream position: 0. stream nextLittleEndianNumber: 2 put: 19778. "bfType = BM" stream nextLittleEndianNumber: 4 put: bfOffBits + biSizeImage. "Entire file size in bytes" stream nextLittleEndianNumber: 4 put: 0. "bfReserved" stream nextLittleEndianNumber: 4 put: bfOffBits. "Offset of bitmap data from start of hdr (and file)" "Write the bitmap info header" stream position: bhSize. stream nextLittleEndianNumber: 4 put: biSize. "info header size in bytes" stream nextLittleEndianNumber: 4 put: image width. "biWidth" stream nextLittleEndianNumber: 4 put: image height. "biHeight" stream nextLittleEndianNumber: 2 put: 1. "biPlanes" stream nextLittleEndianNumber: 2 put: (depth min: 24). "biBitCount" stream nextLittleEndianNumber: 4 put: 0. "biCompression" stream nextLittleEndianNumber: 4 put: biSizeImage. "size of image section in bytes" stream nextLittleEndianNumber: 4 put: 2800. "biXPelsPerMeter" stream nextLittleEndianNumber: 4 put: 2800. "biYPelsPerMeter" stream nextLittleEndianNumber: 4 put: biClrUsed. stream nextLittleEndianNumber: 4 put: 0. "biClrImportant" biClrUsed > 0 ifTrue: [ "write color map; this works for ColorForms, too" colorValues _ image colormapIfNeededForDepth: 32. 1 to: biClrUsed do: [:i | rgb _ colorValues at: i. 0 to: 24 by: 8 do: [:j | stream nextPut: (rgb >> j bitAnd: 16rFF)]]]. 1 to: biHeight do:[:i | data _ (image copy: (0@(biHeight-i) extent: biWidth@1)) bits. depth = 32 ifTrue: [1 to: data size do: [:j | stream nextLittleEndianNumber: 3 put: (data at: j)]. 1 to: (data size*3)+3//4*4-(data size*3) do: [:j | stream nextPut: 0 "pad to 32-bits"]] ifFalse: [1 to: data size do: [:j | stream nextNumber: 4 put: (data at: j)]]]. stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure']. stream close.! ! !BMPReadWriter methodsFor: 'testing' stamp: 'ar 6/16/2002 15:27'! understandsImageFormat stream size < 54 ifTrue:[^false]. "min size = BITMAPFILEHEADER+BITMAPINFOHEADER" self readHeader. bfType = 19778 "BM" ifFalse:[^false]. biSize = 40 ifFalse:[^false]. biPlanes = 1 ifFalse:[^false]. bfSize <= stream size ifFalse:[^false]. biCompression = 0 ifFalse:[^false]. ^true! ! !BMPReadWriterPlugin methodsFor: 'primitives' stamp: 'ar 6/16/2002 19:57'! primitiveRead24BmpLine | width formBitsIndex formBitsOop pixelLineOop formBitsSize formBits pixelLineSize pixelLine | self export: true. self inline: false. self var: #formBits type: 'unsigned int *'. self var: #pixelLine type: 'unsigned char *'. interpreterProxy methodArgumentCount = 4 ifFalse:[^interpreterProxy primitiveFail]. width := interpreterProxy stackIntegerValue: 0. formBitsIndex := interpreterProxy stackIntegerValue: 1. formBitsOop := interpreterProxy stackObjectValue: 2. pixelLineOop := interpreterProxy stackObjectValue: 3. interpreterProxy failed ifTrue:[^nil]. (interpreterProxy isWords: formBitsOop) ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy isBytes: pixelLineOop) ifFalse:[^interpreterProxy primitiveFail]. formBitsSize := interpreterProxy slotSizeOf: formBitsOop. formBits := interpreterProxy firstIndexableField: formBitsOop. pixelLineSize := interpreterProxy slotSizeOf: pixelLineOop. pixelLine := interpreterProxy firstIndexableField: pixelLineOop. (formBitsIndex + width <= formBitsSize and:[width*3 <= pixelLineSize]) ifFalse:[^interpreterProxy primitiveFail]. "do the actual work" self cCode:' formBits += formBitsIndex-1; while(width--) { unsigned int rgb; rgb = (*pixelLine++); rgb += (*pixelLine++) << 8; rgb += (*pixelLine++) << 16; if(rgb) rgb |= 0xFF000000; else rgb |= 0xFF000001; *formBits++ = rgb; } ' inSmalltalk:[formBits. pixelLine. ^interpreterProxy primitiveFail]. interpreterProxy pop: 4. "args" ! ! !Bitmap methodsFor: 'accessing' stamp: 'ar 6/16/2002 18:49'! copyFromByteArray: byteArray "This method should work with either byte orderings" | myHack byteHack | myHack := Form new hackBits: self. byteHack := Form new hackBits: byteArray. Smalltalk isLittleEndian ifTrue:[byteHack swapEndianness]. byteHack displayOn: myHack. ! ! !Form methodsFor: 'initialize-release' stamp: 'ar 6/16/2002 18:39'! swapEndianness "Swap from big to little endian pixels and vice versa" depth := 0 - depth.! ! !Form methodsFor: 'copying' stamp: 'ar 6/16/2002 17:44'! asFormOfDepth: d | newForm | d = self depth ifTrue:[^self]. newForm _ Form extent: self extent depth: d. (BitBlt current toForm: newForm) colorMap: (self colormapIfNeededFor: newForm); copy: (self boundingBox) from: 0@0 in: self fillColor: nil rule: Form over. ^newForm! ! !Form methodsFor: 'fileIn/Out' stamp: 'ar 6/16/2002 17:53'! writeBMPfileNamed: fName "Display writeBMPfileNamed: 'display.bmp'" BMPReadWriter putForm: self onFileNamed: fName! ! !Form class methodsFor: 'instance creation' stamp: 'ar 6/16/2002 18:57'! fromBinaryStream: aBinaryStream "Read a Form or ColorForm from given file, using the first byte of the file to guess its format. Currently handles: GIF, uncompressed BMP, and both old and new DisplayObject writeOn: formats, JPEG, and PCX. Return nil if the file could not be read or was of an unrecognized format." | firstByte | aBinaryStream binary. firstByte _ aBinaryStream next. firstByte = 1 ifTrue: [ "old Squeakform format" ^ self new readFromOldFormat: aBinaryStream]. firstByte = 2 ifTrue: [ "new Squeak form format" ^ self new readFrom: aBinaryStream]. "Try for JPG, GIF, or PCX..." "Note: The following call closes the stream." ^ Smalltalk imageReaderClass formFromStream: aBinaryStream ! ! !Form class methodsFor: 'BMP file reading' stamp: 'ar 6/16/2002 17:41'! fromBMPFile: aBinaryStream "Obsolete" ^self fromBinaryStream: aBinaryStream.! ! !Form class methodsFor: 'BMP file reading' stamp: 'ar 6/16/2002 17:41'! fromBMPFileNamed: fileName "Obsolete" ^self fromFileNamed: fileName ! ! !ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'ar 6/16/2002 17:34'! formFromStream: aBinaryStream "Answer a ColorForm stored on the given stream. closes the stream" | reader readerClass form | readerClass _ self withAllSubclasses detect: [:subclass | subclass understandsImageFormat: aBinaryStream] ifNone: [ (aBinaryStream respondsTo: #close) ifTrue: [ aBinaryStream close ]. ^self error: 'image format not recognized']. reader _ readerClass new on: aBinaryStream reset. Cursor read showWhile: [ form _ reader nextImage. reader close]. ^ form ! ! !ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'ar 6/16/2002 17:33'! understandsImageFormat: aStream ^(self new on: aStream) understandsImageFormat! ! !BMPReadWriter class methodsFor: 'testing' stamp: 'ar 6/16/2002 18:55'! displayAllFrom: fd "BMPReadWriter displayAllFrom: FileDirectory default" fd fileNames do:[:fName| (fName endsWith: '.bmp') ifTrue:[ [(Form fromBinaryStream: (fd readOnlyFileNamed: fName)) display. Display forceDisplayUpdate] on: Error do:[:nix|]. ]. ]. fd directoryNames do:[:fdName| self displayAllFrom: (fd directoryNamed: fdName) ].! ! !BMPReadWriter class methodsFor: 'testing' stamp: 'ar 6/16/2002 18:56'! readAllFrom: fd "MessageTally spyOn:[BMPReadWriter readAllFrom: FileDirectory default]" fd fileNames do:[:fName| (fName endsWith: '.bmp') ifTrue:[ [Form fromBinaryStream: (fd readOnlyFileNamed: fName)] on: Error do:[:nix]. ]. ]. fd directoryNames do:[:fdName| self readAllFrom: (fd directoryNamed: fdName) ].! ! !JPEGReadWriter class methodsFor: 'image reading/writing' stamp: 'ar 6/16/2002 18:54'! understandsImageFormat: aStream (JPEGReadWriter2 understandsImageFormat: aStream) ifTrue:[^false]. aStream reset. aStream next = 16rFF ifFalse: [^ false]. aStream next = 16rD8 ifFalse: [^ false]. ^true! ! !JPEGReadWriter2 class methodsFor: 'image reading/writing' stamp: 'ar 6/16/2002 18:54'! primJPEGPluginIsPresent ^false! ! !StandardFileStream methodsFor: 'access' stamp: 'ar 6/16/2002 18:58'! reset self ensureOpen. self position: 0.! ! Form class removeSelector: #bmp24BitPixelDataFrom:width:height:! Form class removeSelector: #bmpColorsFrom:count:depth:! Form class removeSelector: #bmpPixelDataFrom:width:height:depth:colors:!