[squeak-dev] The Trunk: Graphics-ct.457.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 3 20:19:46 UTC 2022
Christoph Thiede uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-ct.457.mcz ==================== Summary ==================== Name: Graphics-ct.457 Author: ct Time: 3 January 2022, 9:19:39.486397 pm UUID: fd7bbdad-6898-7041-8182-7fea4f36fbee Ancestors: Graphics-mt.456 Improves multilingual support in Graphics-Files. Also includes a few recategorizations and removes two outdated helper methods. =============== Diff against Graphics-mt.456 =============== Item was changed: ----- Method: BMPReadWriter>>nextPutImage: (in category 'writing') ----- nextPutImage: aForm | bhSize rowBytes rgb data colorValues depth image ppw scanLineLen pixline | depth := aForm depth. depth := #(1 4 8 32 ) detect: [ :each | each >= depth]. 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)]]]. depth < 32 ifTrue: [ "depth = 1, 4 or 8." data := image bits asByteArray. ppw := 32 // depth. scanLineLen := biWidth + ppw - 1 // ppw * 4. "# of bytes in line" 1 to: biHeight do: [:i | stream next: scanLineLen putAll: data startingAt: (biHeight-i)*scanLineLen+1. ]. ] ifFalse: [ data := image bits. pixline := ByteArray new: (((biWidth * 3 + 3) // 4) * 4). 1 to: biHeight do:[:i | self store24BitBmpLine: pixline from: data startingAt: (biHeight-i)*biWidth+1 width: biWidth. stream nextPutAll: pixline. ]. ]. + stream position = (bfOffBits + biSizeImage) ifFalse: [self error: 'Write failure' translated]. - stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure']. stream close.! Item was changed: ----- Method: GIFReadWriter class>>grabScreenAndSaveOnDisk (in category 'examples') ----- grabScreenAndSaveOnDisk "GIFReadWriter grabScreenAndSaveOnDisk" | form fileName | form := Form fromUser. form bits size = 0 ifTrue: [^Beeper beep]. fileName := FileDirectory default nextNameFor: 'Squeak' extension: 'gif'. + Project uiManager + informUser: ('Writing {1}' translated format: {fileName}) + during: [GIFReadWriter putForm: form onFileNamed: fileName].! - UIManager default informUser: 'Writing ' , fileName - during: [GIFReadWriter putForm: form onFileNamed: fileName]! Item was changed: ----- Method: GIFReadWriter>>nextImage (in category 'accessing') ----- nextImage "Read in the next GIF image from the stream." | f thisImageColorTable | localColorTable := nil. self readHeader. f := self readBody. self close. + f == nil ifTrue: [^ self error: 'corrupt GIF file' translated]. - f == nil ifTrue: [^ self error: 'corrupt GIF file']. thisImageColorTable := localColorTable ifNil: [colorPalette]. transparentIndex ifNotNil: [ transparentIndex + 1 > thisImageColorTable size ifTrue: [ thisImageColorTable := thisImageColorTable forceTo: transparentIndex + 1 paddingWith: Color white ]. thisImageColorTable at: transparentIndex + 1 put: Color transparent ]. f colors: thisImageColorTable. ^ f ! Item was changed: ----- Method: GIFReadWriter>>readBitData (in category 'private-decoding') ----- readBitData "using modified Lempel-Ziv Welch algorithm." | outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar i bytes f c packedBits hasLocalColor localColorSize maxOutCodes | maxOutCodes := 4096. offset := self readWord at self readWord. "Image Left at Image Top" width := self readWord. height := self readWord. "--- Local Color Table Flag 1 Bit Interlace Flag 1 Bit Sort Flag 1 Bit Reserved 2 Bits Size of Local Color Table 3 Bits ----" packedBits := self next. interlace := (packedBits bitAnd: 16r40) ~= 0. hasLocalColor := (packedBits bitAnd: 16r80) ~= 0. localColorSize := 1 bitShift: ((packedBits bitAnd: 16r7) + 1). hasLocalColor ifTrue: [localColorTable := self readColorTable: localColorSize]. pass := 0. xpos := 0. ypos := 0. rowByteSize := ((width + 3) // 4) * 4. remainBitCount := 0. bufByte := 0. bufStream := ReadStream on: ByteArray new. outCodes := ByteArray new: maxOutCodes + 1. outCount := 0. bitMask := (1 bitShift: bitsPerPixel) - 1. prefixTable := Array new: 4096. suffixTable := Array new: 4096. initCodeSize := self next. self setParameters: initCodeSize. + bitsPerPixel > 8 ifTrue: [^self error: ('never heard of a GIF that deep (depth = {1})' translated format: {bitsPerPixel})]. - bitsPerPixel > 8 ifTrue: [^self error: 'never heard of a GIF that deep']. bytes := ByteArray new: rowByteSize * height. [(code := self readCode) = eoiCode] whileFalse: [code = clearCode ifTrue: [self setParameters: initCodeSize. curCode := oldCode := code := self readCode. finChar := curCode bitAnd: bitMask. "Horrible hack to avoid running off the end of the bitmap. Seems to cure problem reading some gifs!!? tk 6/24/97 20:16" xpos = 0 ifTrue: [ ypos < height ifTrue: [ bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]] ifFalse: [bytes at: (ypos * rowByteSize) + xpos + 1 put: finChar]. self updatePixelPosition] ifFalse: [curCode := inCode := code. curCode >= freeCode ifTrue: [curCode := oldCode. outCodes at: (outCount := outCount + 1) put: finChar]. [curCode > bitMask] whileTrue: [outCount > maxOutCodes + ifTrue: [^self error: ('corrupt GIF file ({1})' translated format: {'OutCount'})]. - ifTrue: [^self error: 'corrupt GIF file (OutCount)']. outCodes at: (outCount := outCount + 1) put: (suffixTable at: curCode + 1). curCode := prefixTable at: curCode + 1]. finChar := curCode bitAnd: bitMask. outCodes at: (outCount := outCount + 1) put: finChar. i := outCount. [i > 0] whileTrue: ["self writePixel: (outCodes at: i) to: bits" bytes at: (ypos * rowByteSize) + xpos + 1 put: (outCodes at: i). self updatePixelPosition. i := i - 1]. outCount := 0. prefixTable at: freeCode + 1 put: oldCode. suffixTable at: freeCode + 1 put: finChar. oldCode := inCode. freeCode := freeCode + 1. self checkCodeSize]]. prefixTable := suffixTable := nil. f := ColorForm extent: width at height depth: 8. f bits copyFromByteArray: bytes. "Squeak can handle depths 1, 2, 4, and 8" bitsPerPixel > 4 ifTrue: [^ f]. "reduce depth to save space" c := ColorForm extent: width at height depth: (bitsPerPixel = 3 ifTrue: [4] ifFalse: [bitsPerPixel]). f displayOn: c. + ^ c! - ^ c - ! Item was changed: ----- Method: GIFReadWriter>>readHeader (in category 'private-decoding') ----- readHeader | is89 byte hasColorMap | (self hasMagicNumber: 'GIF87a' asByteArray) ifTrue: [is89 := false] ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray) ifTrue: [is89 := true] + ifFalse: [^ self error: 'This does not appear to be a GIF file' translated]]. - ifFalse: [^ self error: 'This does not appear to be a GIF file']]. self readWord. "skip Screen Width" self readWord. "skip Screen Height" byte := self next. hasColorMap := (byte bitAnd: 16r80) ~= 0. bitsPerPixel := (byte bitAnd: 7) + 1. byte := self next. "skip background color." self next ~= 0 ifTrue: [is89 + ifFalse: [^self error: ('corrupt GIF file ({1})' translated format: {'screen descriptor'})]]. - ifFalse: [^self error: 'corrupt GIF file (screen descriptor)']]. hasColorMap ifTrue: [colorPalette := self readColorTable: (1 bitShift: bitsPerPixel)] ifFalse: ["Transcript cr; show: 'GIF file does not have a color map.'." colorPalette := nil "Palette monochromeDefault"].! Item was changed: ----- Method: GIFReadWriter>>updatePixelPosition (in category 'private') ----- updatePixelPosition (xpos := xpos + 1) >= width ifFalse: [^self]. xpos := 0. interlace ifFalse: [ypos := ypos + 1. ^self]. pass = 0 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 4]. ^self]. pass = 1 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 2]. ^self]. pass = 2 ifTrue: [(ypos := ypos + 4) >= height ifTrue: [pass := pass + 1. ypos := 1]. ^self]. pass = 3 ifTrue: [ypos := ypos + 2. ^self]. + ^pass caseError! - ^self error: 'can''t happen'! Item was changed: ----- Method: ImageReadWriter class>>formFromStream: (in category 'image reading/writing') ----- formFromStream: aBinaryStream "Answer a ColorForm stored on the given stream. closes the stream" | reader readerClass form | readerClass := self withAllSubclasses detect: [:subclass | aBinaryStream reset. subclass understandsImageFormat: aBinaryStream] ifNone: [ aBinaryStream close. + ^self error: 'image format not recognized' translated]. - ^self error: 'image format not recognized']. aBinaryStream reset. reader := readerClass new on: aBinaryStream. Cursor read showWhile: [ form := reader nextImage. reader close]. ^ form ! Item was changed: ----- Method: ImageReadWriter>>changePadOfBits:width:height:depth:from:to: (in category 'private') ----- changePadOfBits: bits width: width height: height depth: depth from: oldPad to: newPad "Change padding size of bits." | srcRowByteSize dstRowByteSize newBits srcRowBase rowEndOffset | (#(8 16 32) includes: oldPad) + ifFalse: [^self error: ('Invalid pad: {1}' translated format: {oldPad})]. - ifFalse: [^self error: 'Invalid pad: ', oldPad printString]. (#(8 16 32) includes: newPad) + ifFalse: [^self error: ('Invalid pad: {1}' translated format: {newPad})]. - ifFalse: [^self error: 'Invalid pad: ', newPad printString]. srcRowByteSize := width * depth + oldPad - 1 // oldPad * (oldPad / 8). srcRowByteSize * height = bits size + ifFalse: [^self error: 'Incorrect bitmap array size.' translated]. - ifFalse: [^self error: 'Incorrect bitmap array size.']. dstRowByteSize := width * depth + newPad - 1 // newPad * (newPad / 8). newBits := ByteArray new: dstRowByteSize * height. srcRowBase := 1. rowEndOffset := dstRowByteSize - 1. 1 to: newBits size by: dstRowByteSize do: [:dstRowBase | newBits replaceFrom: dstRowBase to: dstRowBase + rowEndOffset with: bits startingAt: srcRowBase. srcRowBase := srcRowBase + srcRowByteSize]. ^newBits! Item was changed: ----- Method: ImageReadWriter>>unpackBits:depthTo8From:with:height:pad: (in category 'private') ----- unpackBits: bits depthTo8From: depth with: width height: height pad: pad "Unpack bits of depth 1, 2, or 4 image to it of depth 8 image." | bitMask pixelInByte bitsWidth upBitsWidth stopWidth trailingSize upBits bitIndex upBitIndex val | (#(1 2 4) includes: depth) + ifFalse: [^self error: 'depth must be 1, 2, or 4' translated]. - ifFalse: [^self error: 'depth must be 1, 2, or 4']. (#(8 16 32) includes: pad) + ifFalse: [^self error: 'pad must be 8, 16, or 32' translated]. - ifFalse: [^self error: 'pad must be 8, 16, or 32']. bitMask := (1 bitShift: depth) - 1. pixelInByte := 8 / depth. bitsWidth := width * depth + pad - 1 // pad * (pad / 8). upBitsWidth := width * 8 + pad - 1 // pad * (pad / 8). stopWidth := width * depth + 7 // 8. trailingSize := width - (stopWidth - 1 * pixelInByte). upBits := ByteArray new: upBitsWidth * height. 1 to: height do: [:i | bitIndex := i - 1 * bitsWidth. upBitIndex := i - 1 * upBitsWidth. 1 to: stopWidth - 1 do: [:j | val := bits at: (bitIndex := bitIndex + 1). upBitIndex := upBitIndex + pixelInByte. 1 to: pixelInByte do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. val := (bits at: (bitIndex := bitIndex + 1)) bitShift: depth negated * (pixelInByte - trailingSize). upBitIndex := upBitIndex + trailingSize. 1 to: trailingSize do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. ^ upBits ! Item was changed: ----- Method: JPEGReadStream>>decodeValueFrom: (in category 'huffman trees') ----- decodeValueFrom: table "Decode the next value in the receiver using the given huffman table." | bits bitsNeeded tableIndex value | bitsNeeded := (table at: 1) bitShift: -24. "Initial bits needed" tableIndex := 2. "First real table" [bits := self getBits: bitsNeeded. "Get bits" value := table at: (tableIndex + bits). "Lookup entry in table" (value bitAnd: 16r3F000000) = 0] "Check if it is a non-leaf node" whileFalse:["Fetch sub table" tableIndex := value bitAnd: 16rFFFF. "Table offset in low 16 bit" bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit" + bitsNeeded > MaxBits ifTrue:[^self error: 'Invalid huffman table entry' translated]]. - bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']]. ^value! Item was changed: ----- Method: JPEGReadStream>>getBits: (in category 'accessing') ----- getBits: requestedBits | value | requestedBits > bitsInBuffer ifTrue:[ self fillBuffer. requestedBits > bitsInBuffer ifTrue:[ + self error: 'not enough bits available to decode' translated]]. - self error: 'not enough bits available to decode']]. value := bitBuffer bitShift: (requestedBits - bitsInBuffer). bitBuffer := bitBuffer bitAnd: (1 bitShift: (bitsInBuffer - requestedBits)) -1. bitsInBuffer := bitsInBuffer - requestedBits. ^ value! Item was changed: ----- Method: JPEGReadWriter>>nextImageDitheredToDepth: (in category 'public access') ----- nextImageDitheredToDepth: depth | form xStep yStep x y bb | ditherMask := DitherMasks at: depth + ifAbsent: [self error: 'can only dither to display depths' translated]. - ifAbsent: [self error: 'can only dither to display depths']. residuals := WordArray new: 3. sosSeen := false. self parseFirstMarker. [sosSeen] whileFalse: [self parseNextMarker]. form := Form extent: (width @ height) depth: depth. bb := BitBlt toForm: form. bb sourceForm: mcuImageBuffer. bb colorMap: (mcuImageBuffer colormapIfNeededFor: form). bb sourceRect: mcuImageBuffer boundingBox. bb combinationRule: Form over. xStep := mcuWidth * DCTSize. yStep := mcuHeight * DCTSize. y := 0. 1 to: mcuRowsInScan do: [:row | x := 0. 1 to: mcusPerRow do: [:col | self decodeMCU. self idctMCU. self colorConvertMCU. bb destX: x; destY: y; copyBits. x := x + xStep]. y := y + yStep]. ^ form! Item was removed: - ----- Method: JPEGReadWriter>>notSupported: (in category 'error handling') ----- - notSupported: aString - - self error: aString , ' is not currently supported'! Item was changed: ----- Method: JPEGReadWriter>>parseAPPn (in category 'marker parsing') ----- parseAPPn | length buffer thumbnailLength markerStart | markerStart := self position. length := self nextWord. buffer := self next: 4. (buffer asString = 'JFIF') ifFalse: [ "Skip APPs that we're not interested in" stream next: length-6. ^self]. self next. majorVersion := self next. minorVersion := self next. densityUnit := self next. xDensity := self nextWord. yDensity := self nextWord. thumbnailLength := self next * self next * 3. length := length - (self position - markerStart). + length = thumbnailLength ifFalse: [self error: 'APP0 thumbnail length is incorrect.' translated]. - length = thumbnailLength ifFalse: [self error: 'APP0 thumbnail length is incorrect.']. self next: length! Item was changed: ----- Method: JPEGReadWriter>>parseDecoderRestartInterval (in category 'marker parsing') ----- parseDecoderRestartInterval | length | length := self nextWord. + length = 4 ifFalse: [self error: 'DRI length is incorrect.' translated]. - length = 4 ifFalse: [self error: 'DRI length incorrect']. restartInterval := self nextWord.! Item was changed: ----- Method: JPEGReadWriter>>parseFirstMarker (in category 'marker parsing') ----- parseFirstMarker | marker | + self next = 16rFF ifFalse: [self error: 'JFIF marker expected' translated]. - self next = 16rFF ifFalse: [self error: 'JFIF marker expected']. marker := self next. marker = 16rD9 ifTrue: [^self "halt: 'EOI encountered.'"]. + marker = 16rD8 ifFalse: [self error: 'SOI marker expected' translated]. - marker = 16rD8 ifFalse: [self error: 'SOI marker expected']. self parseStartOfInput. ! Item was changed: ----- Method: JPEGReadWriter>>parseHuffmanTable (in category 'marker parsing') ----- parseHuffmanTable | length markerStart index bits count huffVal isACTable hTable | markerStart := self position. length := self nextWord. [self position - markerStart >= length] whileFalse: [index := self next. isACTable := (index bitAnd: 16r10) ~= 0. index := (index bitAnd: 16r0F) + 1. index > HuffmanTableSize + ifTrue: [self error: ('image has more than {1} quantization tables' translated format: {HuffmanTableSize})]. - ifTrue: [self error: 'image has more than ', HuffmanTableSize printString, - ' quantization tables']. bits := self next: 16. count := bits sum. (count > 256 or: [(count > (length - (self position - markerStart)))]) + ifTrue: [self error: 'Huffman Table count is incorrect' translated]. - ifTrue: [self error: 'Huffman Table count is incorrect']. huffVal := self next: count. hTable := stream buildLookupTable: huffVal counts: bits. isACTable ifTrue: [self hACTable at: index put: hTable] ifFalse: [self hDCTable at: index put: hTable]].! Item was changed: ----- Method: JPEGReadWriter>>parseNextMarker (in category 'marker parsing') ----- parseNextMarker "Parse the next marker of the stream" | byte discardedBytes | discardedBytes := 0. [(byte := self next) = 16rFF] whileFalse: [discardedBytes := discardedBytes + 1]. [[(byte := self next) = 16rFF] whileTrue. byte = 16r00] whileTrue: [discardedBytes := discardedBytes + 2]. discardedBytes > 0 ifTrue: [self "notifyWithLabel: 'warning: extraneous data discarded'"]. self perform: (JFIFMarkerParser at: byte ifAbsent: [(self okToIgnoreMarker: byte) ifTrue: [#skipMarker] + ifFalse: [self error: ('marker {1} cannot be handled' translated format: {byte printStringHex})]])! - ifFalse: [self error: 'marker ', byte printStringHex , ' cannot be handled']])! Item was changed: ----- Method: JPEGReadWriter>>parseQuantizationTable (in category 'marker parsing') ----- parseQuantizationTable | length markerStart n prec value table | markerStart := self position. length := self nextWord. [self position - markerStart >= length] whileFalse: [value := self next. n := (value bitAnd: 16r0F) + 1. prec := (value >> 4) > 0. n > QuantizationTableSize + ifTrue: [self error: ('image has more than {1} quantization tables' translated format: {QuantizationTableSize})]. - ifTrue: [self error: 'image has more than ', - QuantizationTableSize printString, - ' quantization tables']. table := IntegerArray new: DCTSize2. 1 to: DCTSize2 do: [:i | value := (prec ifTrue: [self nextWord] ifFalse: [self next]). table at: (JPEGNaturalOrder at: i) put: value]. self useFloatingPoint ifTrue: [self scaleQuantizationTable: table]. self qTable at: n put: table]! Item was changed: ----- Method: JPEGReadWriter>>parseStartOfFile (in category 'marker parsing') ----- parseStartOfFile | length markerStart value n | markerStart := self position. length := self nextWord. dataPrecision := self next. dataPrecision = 8 + ifFalse: [self error: ('cannot handle {1}-bit components' translated format: {dataPrecision})]. - ifFalse: [self error: 'cannot handle ', dataPrecision printString, '-bit components']. height := self nextWord. width := self nextWord. n := self next. + (height = 0) | (width = 0) | (n = 0) ifTrue: [self error: 'empty image' translated]. - (height = 0) | (width = 0) | (n = 0) ifTrue: [self error: 'empty image']. (length - (self position - markerStart)) ~= (n * 3) + ifTrue: [self error: 'component length is incorrect' translated]. - ifTrue: [self error: 'component length is incorrect']. components := Array new: n. 1 to: components size do: [:i | components at: i put: (JPEGColorComponent new id: self next; "heightInBlocks: (((value := self next) >> 4) bitAnd: 16r0F); widthInBlocks: (value bitAnd: 16r0F);" widthInBlocks: (((value := self next) >> 4) bitAnd: 16r0F); heightInBlocks: (value bitAnd: 16r0F); qTableIndex: self next + 1)]! Item was changed: ----- Method: JPEGReadWriter>>parseStartOfScan (in category 'marker parsing') ----- parseStartOfScan | length n id value dcNum acNum comp | length := self nextWord. n := self next. + (length ~= (n*2 + 6)) | (n < 1) ifTrue: [self error: 'SOS length is incorrect' translated]. - (length ~= (n*2 + 6)) | (n < 1) ifTrue: [self error: 'SOS length is incorrect']. currentComponents := Array new: n. 1 to: n do: [:i | id := self next. value := self next. dcNum := (value >> 4) bitAnd: 16r0F. acNum := value bitAnd: 16r0F. comp := components detect: [:c | c id = id]. comp dcTableIndex: dcNum+1; acTableIndex: acNum+1. currentComponents at: i put: comp]. ss := self next. se := self next. value := self next. ah := (value >> 4) bitAnd: 16r0F. al := value bitAnd: 16r0F. self initialSOSSetup. self perScanSetup. sosSeen := true! Item was changed: ----- Method: JPEGReadWriter>>perScanSetup (in category 'marker parsing') ----- perScanSetup mcusPerRow := (width / (mcuWidth * DCTSize)) ceiling. mcuRowsInScan := (height / (mcuHeight * DCTSize)) ceiling. (currentComponents size = 3 or: [currentComponents size = 1]) + ifFalse: [self error: 'JPEG color space not recognized' translated]. - ifFalse: [self error: 'JPEG color space not recognized']. mcuMembership := OrderedCollection new. currentComponents withIndexDo: [:c :i | c priorDCValue: 0. mcuMembership addAll: ((1 to: c totalMcuBlocks) collect: [:b | i])]. mcuMembership := mcuMembership asArray. mcuSampleBuffer := (1 to: mcuMembership size) collect: [:i | IntegerArray new: DCTSize2]. currentComponents withIndexDo: [:c :i | c initializeSampleStreamBlocks: ((1 to: mcuMembership size) select: [:j | i = (mcuMembership at: j)] thenCollect: [:j | mcuSampleBuffer at: j])]. mcuImageBuffer := Form extent: (mcuWidth @ mcuHeight) * DCTSize depth: 32. restartsToGo := restartInterval.! Item was changed: ----- Method: JPEGReadWriter2>>compress:quality: (in category 'public access') ----- compress: aForm quality: quality "Encode the given Form and answer the compressed ByteArray. Quality goes from 0 (low) to 100 (high), where -1 means default. We can only compress: * 32-bit deep Forms * -32-bit deep Forms * 16-bit deep Forms * -16-bit deep Forms * GrayScale ColorForms (see #isGrayScale)" | sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount | aForm unhibernate. sourceForm := self supports8BitGrayscaleJPEGs ifTrue: [ (aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale) ifTrue: [aForm] ifFalse: [aForm asFormOfDepth: 32 ]] ifFalse: [ (aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even))) ifTrue: [aForm] ifFalse: [aForm asFormOfDepth: 32 ]]. jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. buffer := ByteArray new: sourceForm width * sourceForm height + 1024. byteCount := self primJPEGWriteImage: jpegCompressStruct onByteArray: buffer form: sourceForm quality: quality progressiveJPEG: false errorMgr: jpegErrorMgr2Struct. + byteCount = 0 ifTrue: [self error: 'buffer too small for compressed data' translated]. - byteCount = 0 ifTrue: [self error: 'buffer too small for compressed data']. ^ buffer copyFrom: 1 to: byteCount ! Item was changed: ----- Method: JPEGReadWriter2>>nextPutImage:quality:progressiveJPEG: (in category 'public access') ----- nextPutImage: aForm quality: quality progressiveJPEG: progressiveFlag "Encode the given Form on my stream with the given settings. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG. We can compress: * 32-bit deep Forms * -32-bit deep Forms * 16-bit deep * -16-bit deep * GrayScale ColorForms (see #isGrayScale)" | sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount | aForm unhibernate. sourceForm := self supports8BitGrayscaleJPEGs ifTrue: [ (aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale) ifTrue: [aForm] ifFalse: [aForm asFormOfDepth: 32 ]] ifFalse: [ (aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even))) ifTrue: [aForm] ifFalse: [aForm asFormOfDepth: 32 ]]. jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. buffer := ByteArray new: sourceForm width * sourceForm height + 1024. "Try to write the image. Retry with a larger buffer if needed." [ byteCount := self primJPEGWriteImage: jpegCompressStruct onByteArray: buffer form: sourceForm quality: quality progressiveJPEG: progressiveFlag errorMgr: jpegErrorMgr2Struct. byteCount = 0 and: [ buffer size < (sourceForm width * sourceForm height * 3 + 1024) ] ] whileTrue: [ buffer := ByteArray new: buffer size * 2 ]. + byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' translated ]. - byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' ]. stream next: byteCount putAll: buffer startingAt: 1. self close. ! Item was changed: ----- Method: JPEGReadWriter2>>uncompress:into:doDithering: (in category 'public access') ----- uncompress: aByteArray into: aForm doDithering: ditherFlag "Uncompress an image from the given ByteArray into the given Form. Fails if the given Form has the wrong dimensions or depth. We can read RGB JPEGs into: * 32-bit Forms * -32-bit Forms * 16-bit Forms (with or without dithering!!) * -16-bit Forms (with or without dithering!!) We can read grayscale JPEGs into: * 32-bit Forms * -32-bit Forms * 16-bit Forms (with or without dithering!!) * -16-bit Forms (with or without dithering!!) * 8-bit grayScale ColorForms (see #isGrayScale) * -8-bit grayScale ColorForms (see #isGrayScale)" | jpegDecompressStruct jpegErrorMgr2Struct width height components | aForm unhibernate. jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: aByteArray errorMgr: jpegErrorMgr2Struct. width := self primImageWidth: jpegDecompressStruct. height := self primImageHeight: jpegDecompressStruct. components := self primImageNumComponents: jpegDecompressStruct. ((aForm width = width) & (aForm height = height)) ifFalse: [ + ^ self error: 'form dimensions do not match' translated ]. - ^ self error: 'form dimensions do not match' ]. self supports8BitGrayscaleJPEGs ifTrue: [ components = 3 ifTrue: [ aForm depth = 8 + ifTrue: [ ^ self error: 'Cannot uncompress multi-channel JPEGs into 8-bit deep forms' translated ]]. - ifTrue: [ ^ self error: 'Cannot uncompress multi-channel JPEGs into 8-bit deep forms' ]]. components = 1 ifTrue: [ aForm depth = 8 ifTrue: [ aForm isGrayScale + ifFalse: [ ^ self error: 'Cannot uncompress single-channel JPEGs into 8-bit deep forms that are not grayscale' translated ]]]] - ifFalse: [ ^ self error: 'Cannot uncompress single-channel JPEGs into 8-bit deep forms that are not grayscale' ]]]] ifFalse: [ aForm nativeDepth < 0 + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into little-endian forms' translated ] - ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into little-endian forms' ] ifFalse: [ aForm depth = 16 ifTrue: [ width odd + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs with an odd width into 16-bit deep forms' translated ]]. - ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs with an odd width into 16-bit deep forms' ]]. aForm depth = 8 + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into 8-bit deep forms' translated ]]]. - ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into 8-bit deep forms' ]]]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: aByteArray onForm: aForm doDithering: ditherFlag + errorMgr: jpegErrorMgr2Struct.! - errorMgr: jpegErrorMgr2Struct. - ! Item was changed: ----- Method: PCXReadWriter>>readPalette (in category 'private-decoding') ----- readPalette | r g b array | + self next = 12 ifFalse: [self error: 'no Color Palette!!' translated]. - self next = 12 ifFalse: [self error: 'no Color Palette!!']. array := Array new: (1 bitShift: bitsPerPixel). 1 to: array size do: [:i | r := self next. g := self next. b := self next. array at: i put: (Color r: r g: g b: b range: 255)]. ^ array. ! Item was changed: + ----- Method: PNGReadWriter class>>computeSwizzleMapForDepth: (in category 'class initialization') ----- - ----- Method: PNGReadWriter class>>computeSwizzleMapForDepth: (in category 'as yet unclassified') ----- computeSwizzleMapForDepth: depth "Answer a map that maps pixels in a word to their opposite location. Used for 'middle-endian' forms where the byte-order is different from the bit order (good joke, eh?)." | map swizzled | map := Bitmap new: 256. depth = 4 ifTrue:[ 0 to: 255 do:[:pix| swizzled := 0. swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 15) bitShift: 4). swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 15) bitShift: 0). map at: pix+1 put: swizzled. ]. ^ColorMap colors: map ]. depth = 2 ifTrue:[ 0 to: 255 do:[:pix| swizzled := 0. swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 3) bitShift: 6). swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 3) bitShift: 4). swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 3) bitShift: 2). swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 3) bitShift: 0). map at: pix+1 put: swizzled. ]. ^ColorMap colors: map ]. depth = 1 ifTrue:[ 0 to: 255 do:[:pix| swizzled := 0. swizzled := swizzled bitOr: (((pix bitShift: 0) bitAnd: 1) bitShift: 7). swizzled := swizzled bitOr: (((pix bitShift: -1) bitAnd: 1) bitShift: 6). swizzled := swizzled bitOr: (((pix bitShift: -2) bitAnd: 1) bitShift: 5). swizzled := swizzled bitOr: (((pix bitShift: -3) bitAnd: 1) bitShift: 4). swizzled := swizzled bitOr: (((pix bitShift: -4) bitAnd: 1) bitShift: 3). swizzled := swizzled bitOr: (((pix bitShift: -5) bitAnd: 1) bitShift: 2). swizzled := swizzled bitOr: (((pix bitShift: -6) bitAnd: 1) bitShift: 1). swizzled := swizzled bitOr: (((pix bitShift: -7) bitAnd: 1) bitShift: 0). map at: pix+1 put: swizzled. ]. ^ColorMap colors: map ]. self error: 'Unrecognized depth'! Item was changed: + ----- Method: PNGReadWriter class>>debugging: (in category 'support') ----- - ----- Method: PNGReadWriter class>>debugging: (in category 'as yet unclassified') ----- debugging: aBoolean Debugging := aBoolean! Item was changed: + ----- Method: PNGReadWriter class>>initialize (in category 'class initialization') ----- - ----- Method: PNGReadWriter class>>initialize (in category 'as yet unclassified') ----- initialize " PNGReadWriter initialize " BPP := { #(1 2 4 8 16). #(0 0 0 0 0). #(0 0 0 24 48). #(1 2 4 8 0). #(0 0 0 16 32). #(0 0 0 0 0). #(0 0 0 32 64). #(0 0 0 0 0) }. BlockHeight := #(8 8 4 4 2 2 1). BlockWidth := #(8 4 4 2 2 1 1). StandardColors := Color indexedColors collect:[:aColor| Color r: (aColor red * 255) truncated / 255 g: (aColor green * 255) truncated / 255 b: (aColor blue * 255) truncated / 255. ]. StandardSwizzleMaps := Array new: 4. #(1 2 4) do:[:i| StandardSwizzleMaps at: i put: (self computeSwizzleMapForDepth: i)].! Item was removed: - ----- Method: PNGReadWriter class>>insertMorph:named:into: (in category 'as yet unclassified') ----- - insertMorph: aMorph named: aString into: aBook - - | newPage | - - aBook ifNil: [^self]. - newPage := aBook insertPageLabel: aString morphs: {aMorph}. - newPage color: Color lightYellow. - newPage extent: ( - newPage submorphs inject: 10 at 10 into: [ :ex :m | - m left: 10. - ex max: m width @ m bottom - ] - ) + (20 at 20). - ! Item was changed: ----- Method: PNGReadWriter>>nextImage (in category 'accessing') ----- nextImage bigEndian := Smalltalk isBigEndian. filtersSeen := Bag new. idatChunkStream := nil. transparentPixelValue := nil. unknownChunks := Set new. stream reset. stream binary. stream skip: 8. [stream atEnd] whileFalse: [self processNextChunk]. "Set up our form" palette ifNotNil: ["Dump the palette if it's the same as our standard palette" palette = (StandardColors copyFrom: 1 to: palette size) ifTrue: [palette := nil]]. (depth <= 8 and: [palette notNil]) ifTrue: [form := ColorForm extent: width @ height depth: depth. form colors: palette] ifFalse: [form := Form extent: width @ height depth: depth]. backColor ifNotNil: [form fillColor: backColor]. idatChunkStream + ifNil: [ self error: 'image data is missing' translated ] - ifNil: [ self error: 'image data is missing' ] ifNotNil: [ self processIDATChunk ]. unknownChunks isEmpty ifFalse: ["Transcript show: ' ',unknownChunks asSortedCollection asArray printString." ]. self debugging ifTrue: [Transcript cr; show: 'form = ' , form printString. Transcript cr; show: 'colorType = ' , colorType printString. Transcript cr; show: 'interlaceMethod = ' , interlaceMethod printString. Transcript cr; show: 'filters = ' , filtersSeen sortedCounts asArray printString]. ^form! Item was changed: ----- Method: PNGReadWriter>>processInterlaced (in category 'chunks') ----- processInterlaced | z startingCol colIncrement rowIncrement startingRow | startingCol := #(0 4 0 2 0 1 0 ). colIncrement := #(8 8 4 4 2 2 1 ). rowIncrement := #(8 8 8 4 4 2 2 ). startingRow := #(0 0 4 0 2 0 1 ). z := ZLibReadStream on: idatChunkStream originalContents from: 1 to: idatChunkStream position. 1 to: 7 do: [:pass | | cx sc bytesPerPass | (self doPass: pass) ifTrue: [cx := colIncrement at: pass. sc := startingCol at: pass. bytesPerPass := width - sc + cx - 1 // cx * bitsPerPixel + 7 // 8. prevScanline := ByteArray new: bytesPerPass. thisScanline := ByteArray new: bytesPerScanline. (startingRow at: pass) to: height - 1 by: (rowIncrement at: pass) do: [:y | | filter temp | filter := z next. filtersSeen add: filter. (filter isNil or: [(filter between: 0 and: 4) not]) ifTrue: [^ self]. thisScanline := z next: bytesPerPass into: thisScanline startingAt: 1. self filterScanline: filter count: bytesPerPass. self copyPixels: y at: sc by: cx. temp := prevScanline. prevScanline := thisScanline. thisScanline := temp. ] ] ]. + z atEnd ifFalse:[self error: 'Unexpected data' translated].! - z atEnd ifFalse:[self error:'Unexpected data'].! Item was changed: ----- Method: PNGReadWriter>>processNextChunk (in category 'chunks') ----- processNextChunk | length chunkType crc chunkCrc | length := self nextLong. chunkType := (self next: 4) asString. (chunk isNil or: [ chunk size ~= length ]) ifTrue: [ chunk := self next: length ] ifFalse: [ stream next: length into: chunk startingAt: 1 ]. chunkCrc := self nextLong bitXor: 16rFFFFFFFF. crc := self updateCrc: 16rFFFFFFFF from: 1 to: 4 in: chunkType. crc := self updateCrc: crc from: 1 to: length in: chunk. crc = chunkCrc ifFalse:[ + self error: ('PNGReadWriter crc error in chunk {1}' translated format: {chunkType}). - self error: 'PNGReadWriter crc error in chunk ', chunkType. ]. chunkType = 'IEND' ifTrue: [stream setToEnd. ^self "*should* be the last chunk"]. chunkType = 'sBIT' ifTrue: [^self processSBITChunk "could indicate unusual sample depth in original"]. chunkType = 'gAMA' ifTrue: [^self "indicates gamma correction value"]. chunkType = 'bKGD' ifTrue: [^self processBackgroundChunk]. chunkType = 'pHYs' ifTrue: [^self processPhysicalPixelChunk]. chunkType = 'tRNS' ifTrue: [^self processTransparencyChunk]. chunkType = 'IHDR' ifTrue: [^self processIHDRChunk]. chunkType = 'PLTE' ifTrue: [^self processPLTEChunk]. chunkType = 'IDAT' ifTrue: [ "---since the compressed data can span multiple chunks, stitch them all together first. later, if memory is an issue, we need to figure out how to do this on the fly---" idatChunkStream ifNil: [ idatChunkStream := WriteStream with: chunk copy ] ifNotNil: [ idatChunkStream nextPutAll: chunk ]. ^self ]. unknownChunks add: chunkType. ! Item was changed: ----- Method: PNGReadWriter>>processPLTEChunk (in category 'chunks') ----- processPLTEChunk | colorCount i | + colorCount := chunk size // 3. + self flag: #todo. "validate colorCount against depth" - colorCount := chunk size // 3. "TODO - validate colorCount against depth" palette := Array new: colorCount. 0 to: colorCount-1 do: [ :index | i := index * 3 + 1. palette at: index+1 put: (Color r: (chunk at: i)/255.0 g: (chunk at: i+1)/255.0 b: (chunk at: i+2)/255.0) ].! Item was changed: ----- Method: PNGReadWriter>>writeSBITChunkOn: (in category 'writing') ----- writeSBITChunkOn: aStream "Write the IDAT chunk" aStream nextPutAll: 'sBIT' asByteArray. + form depth = 16 ifFalse: [self notYetImplemented]. - form depth = 16 ifFalse:[self error: 'Unimplemented feature']. aStream nextPut: 5. aStream nextPut: 5. aStream nextPut: 5. aStream nextPut: 1.! Item was changed: ----- Method: PNMReadWriter>>nextImage (in category 'reading') ----- nextImage "read one image" | data p | first ifNil:[ first := false. data := stream contentsOfEntireFile. stream := (RWBinaryOrTextStream with: data) reset. ] ifNotNil:[ type < 4 ifTrue:[ + self error: 'Plain PBM, PGM or PPM have only one image' translated - self error:'Plain PBM, PGM or PPM have only one image' ]. ]. stream ascii. p := stream next. type := (stream next) asInteger - 48. (p = $P and:[type > 0 and:[type < 8]]) ifFalse:[ + self error: 'Not a PNM file' translated - self error:'Not a PNM file' ]. type = 7 ifTrue:[ self readHeaderPAM ] ifFalse: [ self readHeader ]. type caseOf: { [1] -> [^self readPlainBW]. [2] -> [^self readPlainGray]. [3] -> [^self readPlainRGB]. [4] -> [^self readBWreverse: false]. [5] -> [^self readGray]. [6] -> [^self readRGB]. [7] -> [ "PAM" (tupleType asUppercase) caseOf: { ['BLACKANDWHITE'] -> [^self readBWreverse: true]. ['GRAYSCALE'] -> [^self readGray]. ['RGB'] -> [^self readRGB]. + ['RGB_ALPHA'] -> [^self notYetImplemented]. + ['GRAYSCALE_ALPHA'] -> [^self notYetImplemented]. - ['RGB_ALPHA'] -> [^self error:'Not implemented']. - ['GRAYSCALE_ALPHA'] -> [^self error:'Not implemented']. } otherwise: [^self readData]. ] }! Item was changed: ----- Method: PNMReadWriter>>readGray (in category 'reading') ----- readGray "gray form, return ColorForm with gray ramp" | form poker | + maxValue > 255 ifTrue:[self error: ('Gray value > {1} bits not supported in Squeak' translated format: {8})]. - maxValue > 255 ifTrue:[self error:'Gray value > 8 bits not supported in Squeak']. stream binary. form := ColorForm extent: cols at rows depth: depth. form colors: nil. poker := BitBlt bitPokerToForm: form. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | |val| val := stream next. poker pixelAt: x at y put: val. ] ]. "a better way is using a gamma corrected palette" form colors: ((0 to: 255) collect:[:c| c > maxValue ifTrue:[Color white] ifFalse:[Color gray: (c/maxValue) asFloat]]). form colors at: 1 put: (Color black). ^form ! Item was changed: ----- Method: PNMReadWriter>>readHeader (in category 'reading') ----- readHeader "read header for pbm, pgm or ppm" | tokens aux d c | tokens := OrderedCollection new. aux := self getTokenPbm: tokens. cols := aux at: 1. tokens := aux at: 2. aux := self getTokenPbm: tokens. rows := aux at: 1. tokens := aux at: 2. (type = 1 or:[type = 4]) ifTrue:[ maxValue := 1 ] ifFalse: [ aux := self getTokenPbm: tokens. maxValue := aux at: 1. tokens := aux at: 2. ]. d := {1 . 2 . 4 . 8 . 16 . 32}. c := {2 . 4 . 16 . 256 . 32768 . 16777216}. (type = 3 or:[type = 6]) ifTrue: [ maxValue >= 65536 ifTrue:[ + self error: ('Pixmap > {1} bits not supported in PPM' translated format: {48}) - self error:'Pixmap > 48 bits not supported in PPM' ]. maxValue >= 256 ifTrue:[ + self error: ('Pixmap > {1} bits are not supported in Squeak' translated format: {32}) - self error:'Pixmap > 32 bits are not supported in Squeak' ]. maxValue < 32 ifTrue:[depth := 16] ifFalse:[depth := 32]. ] ifFalse: [ depth := nil. 1 to: c size do:[:i| ((c at: i) > maxValue and:[depth = nil]) ifTrue:[depth:=d at: i]]. ]. Transcript cr; show: 'PBM file class ', type asString, ' size ', cols asString, ' x ', rows asString, ' maxValue =', maxValue asString, ' depth=', depth asString. ! Item was changed: ----- Method: PNMReadWriter>>readPlainBW (in category 'reading') ----- readPlainBW "plain BW" | val form poker | form := Form extent: cols at rows depth: depth. poker := BitBlt bitPokerToForm: form. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | [val := stream next. (val = $0 or:[val = $1])] whileFalse:[ + val ifNil: [self error: 'End of file reading PBM' translated]. - val ifNil:[self error:'End of file reading PBM']. ]. poker pixelAt: x at y put: (val asInteger). ] ]. ^form ! Item was changed: ----- Method: PNMReadWriter>>readPlainRGB (in category 'reading') ----- readPlainRGB "RGB form, use 32 bits" | val form poker tokens aux | + maxValue > 255 ifTrue:[self error: ('RGB value > {1} bits not supported in Squeak' translated format: {32})]. - maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak']. form := Form extent: cols at rows depth: 32. poker := BitBlt bitPokerToForm: form. tokens := OrderedCollection new. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | | r g b| aux := self getTokenPbm: tokens. r := aux at: 1. tokens := aux at: 2. aux := self getTokenPbm: tokens. g := aux at: 1. tokens := aux at: 2. aux := self getTokenPbm: tokens. b := aux at: 1. tokens := aux at: 2. val := self r: r g: g b: b for: depth. poker pixelAt: x at y put: val. ] ]. ^form ! Item was changed: ----- Method: PNMReadWriter>>readRGB (in category 'reading') ----- readRGB "RGB form, use 16/32 bits" | val form poker sample shift | + maxValue > 255 ifTrue:[self error: ('RGB value > {1} bits not supported in Squeak' translated format: {32})]. - maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak']. stream binary. form := Form extent: cols at rows depth: depth. poker := BitBlt bitPokerToForm: form. depth = 32 ifTrue:[shift := 8] ifFalse:[shift := 5]. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | val := 16rFF. "no transparency" 1 to: 3 do: [:i | sample := stream next. val := val << shift + sample. ]. poker pixelAt: x at y put: val. ] ]. ^form ! Item was changed: ----- Method: StrikeFont class>>generateDejaVuMethods: (in category 'font creation') ----- generateDejaVuMethods: directory "StrikeFont generateDejaVuMethods: 'DejaVu'." | dir formTemplate dataTemplate methodCategory | methodCategory := #'dejaVu font data'. formTemplate := '{1} <generated> " Form data for {2}. Generated with StrikeFont generateDejaVuMethods: ''{3}''" ^Form fromBinaryStream: ( ''{4}'' ) base64Decoded asByteArray readStream '. dataTemplate := '{1} <generated> " Font meta data for {2}. Generated with StrikeFont generateDejaVuMethods: ''{3}''" ^ #({4}) '. dir := FileDirectory default / directory. #('*.txt' 'Data' '*.png' 'Form') pairsDo: [:match :suffix | (dir fileNamesMatching: match) do: [:local | | selector source stringContent| " .txt and .png have both length 4" selector := (local allButLast: 4) asLegalSelector, suffix. stringContent := dir readOnlyFileNamed: local do: [:stream | suffix = 'Data' ifTrue: [stream contentsOfEntireFile] ifFalse: [(stream binary; contentsOfEntireFile) base64Encoded]]. source := (suffix = 'Data' ifTrue: [dataTemplate] ifFalse: [formTemplate]) format: {selector . (local allButLast: 4) . directory . stringContent }. self class compile: source classified: methodCategory] + displayingProgress: [:local | 'Generating {1}' translated format: {local}]].! - displayingProgress: [:local | 'Generating ', local]].!
More information about the Squeak-dev mailing list |