'From Squeak3.7beta of ''1 April 2004'' [latest update: #5878] on 18 April 2004 at 7:52:27 am'! "Change Set: IsKindOfForm-nk Date: 18 April 2004 Author: Ned Konz Changes callers of 'isKindOf: Form' and 'isKindOf: ColorForm' to use the existing queries isForm and isColorForm. Reorganizes the method protocols in Form. "! !Object methodsFor: 'testing' stamp: 'nk 4/17/2004 19:43'! isColorForm ^false! ! !BitBlt methodsFor: 'copying' stamp: 'nk 4/17/2004 19:41'! copyBits "Primitive. Perform the movement of bits from the source form to the destination form. Fail if any variables are not of the right type (Integer, Float, or Form) or if the combination rule is not implemented. In addition to the original 16 combination rules, this BitBlt supports 16 fail (to simulate paint) 17 fail (to simulate mask) 18 sourceWord + destinationWord 19 sourceWord - destinationWord 20 rgbAdd: sourceWord with: destinationWord 21 rgbSub: sourceWord with: destinationWord 22 rgbDiff: sourceWord with: destinationWord 23 tallyIntoMap: destinationWord 24 alphaBlend: sourceWord with: destinationWord 25 pixPaint: sourceWord with: destinationWord 26 pixMask: sourceWord with: destinationWord 27 rgbMax: sourceWord with: destinationWord 28 rgbMin: sourceWord with: destinationWord 29 rgbMin: sourceWord bitInvert32 with: destinationWord " "Check for compressed source, destination or halftone forms" (combinationRule >= 30 and: [combinationRule <= 31]) ifTrue: ["No alpha specified -- re-run with alpha = 1.0" ^ self copyBitsTranslucent: 255]. ((sourceForm isForm) and: [sourceForm unhibernate]) ifTrue: [^ self copyBits]. ((destForm isForm) and: [destForm unhibernate]) ifTrue: [^ self copyBits]. ((halftoneForm isForm) and: [halftoneForm unhibernate]) ifTrue: [^ self copyBits]. "Check for unimplmented rules" combinationRule = Form oldPaint ifTrue: [^ self paintBits]. combinationRule = Form oldErase1bitShape ifTrue: [^ self eraseBits]. "Check if BitBlt doesn't support full color maps" (colorMap notNil and:[colorMap isColormap]) ifTrue:[ colorMap _ colorMap colors. ^self copyBits]. "Check if clipping gots us way out of range" self clipRange ifTrue:[^self copyBits]. self error: 'Bad BitBlt arg (Fraction?); proceed to convert.'. "Convert all numeric parameters to integers and try again." destX _ destX asInteger. destY _ destY asInteger. width _ width asInteger. height _ height asInteger. sourceX _ sourceX asInteger. sourceY _ sourceY asInteger. clipX _ clipX asInteger. clipY _ clipY asInteger. clipWidth _ clipWidth asInteger. clipHeight _ clipHeight asInteger. ^ self copyBitsAgain! ! !BitBlt methodsFor: 'copying' stamp: 'nk 4/17/2004 19:42'! copyBitsTranslucent: factor "This entry point to BitBlt supplies an extra argument to specify translucency for operations 30 and 31. The argument must be an integer between 0 and 255." "Check for compressed source, destination or halftone forms" ((sourceForm isForm) and: [sourceForm unhibernate]) ifTrue: [^ self copyBitsTranslucent: factor]. ((destForm isForm) and: [destForm unhibernate]) ifTrue: [^ self copyBitsTranslucent: factor]. ((halftoneForm isForm) and: [halftoneForm unhibernate]) ifTrue: [^ self copyBitsTranslucent: factor]. self primitiveFailed "Later do nicer error recovery -- share copyBits recovery"! ! !ColorForm class methodsFor: 'as yet unclassified' stamp: 'nk 4/17/2004 19:44'! mappingWhiteToTransparentFrom: aFormOrCursor "Return a ColorForm copied from the given Form or Cursor with white mapped to transparent." | f map | aFormOrCursor depth <= 8 ifFalse: [ ^ self error: 'argument depth must be 8-bits per pixel or less']. (aFormOrCursor isColorForm) ifTrue: [ f _ aFormOrCursor deepCopy. map _ aFormOrCursor colors. ] ifFalse: [ f _ ColorForm extent: aFormOrCursor extent depth: aFormOrCursor depth. f copyBits: aFormOrCursor boundingBox from: aFormOrCursor at: 0@0 clippingBox: aFormOrCursor boundingBox rule: Form over fillColor: nil. map _ Color indexedColors copyFrom: 1 to: (1 bitShift: aFormOrCursor depth)]. map _ map collect: [:c | c = Color white ifTrue: [Color transparent] ifFalse: [c]]. f colors: map. ^ f ! ! !GIFReadWriter methodsFor: 'accessing' stamp: 'nk 4/17/2004 19:44'! nextPutImage: aForm | f newF | aForm unhibernate. f _ aForm colorReduced. "minimize depth" f depth > 8 ifTrue: [ "Not enough color space; do it the hard way." f _ f asFormOfDepth: 8]. f depth < 8 ifTrue: [ "writeBitData: expects depth of 8" newF _ f class extent: f extent depth: 8. (f isColorForm) ifTrue: [ newF copyBits: f boundingBox from: f at: 0@0 clippingBox: f boundingBox rule: Form over fillColor: nil map: nil. newF colors: f colors] ifFalse: [f displayOn: newF]. f _ newF]. (f isColorForm) ifTrue: [ (f colorsUsed includes: Color transparent) ifTrue: [ transparentIndex _ (f colors indexOf: Color transparent) - 1]] ifFalse: [transparentIndex _ nil]. width _ f width. height _ f height. bitsPerPixel _ f depth. colorPalette _ f colormapIfNeededForDepth: 32. interlace _ false. self writeHeader. self writeBitData: f bits. ! ! !InfiniteForm methodsFor: 'displaying' stamp: 'nk 4/17/2004 19:48'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm "This is the real display message, but it doesn't get used until the new display protocol is installed." | targetBox patternBox bb | (patternForm isForm) ifFalse: [^ aDisplayMedium fill: clipRectangle rule: ruleInteger fillColor: patternForm]. "Do it iteratively" targetBox _ aDisplayMedium boundingBox intersect: clipRectangle. patternBox _ patternForm boundingBox. bb _ BitBlt current destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm combinationRule: ruleInteger destOrigin: 0@0 sourceOrigin: 0@0 extent: patternBox extent clipRect: clipRectangle. bb colorMap: (patternForm colormapIfNeededFor: aDisplayMedium). (targetBox left truncateTo: patternBox width) to: targetBox right - 1 by: patternBox width do: [:x | (targetBox top truncateTo: patternBox height) to: targetBox bottom - 1 by: patternBox height do: [:y | bb destOrigin: x@y; copyBits]]! ! !InfiniteForm methodsFor: 'displaying' stamp: 'nk 4/17/2004 19:48'! displayOnPort: aPort at: offset | targetBox patternBox savedMap top left | self flag: #bob. "this *may* not get called at the moment. I have been trying to figure out the right way for this to work and am using #displayOnPort:offsetBy: as my current offering - Bob" (patternForm isForm) ifFalse: [ "patternForm is a Pattern or Color; just use it as a mask for BitBlt" ^ aPort fill: aPort clipRect fillColor: patternForm rule: Form over]. "do it iteratively" targetBox _ aPort clipRect. patternBox _ patternForm boundingBox. savedMap _ aPort colorMap. aPort sourceForm: patternForm; fillColor: nil; combinationRule: Form paint; sourceRect: (0@0 extent: patternBox extent); colorMap: (patternForm colormapIfNeededFor: aPort destForm). top _ (targetBox top truncateTo: patternBox height) "- (offset y \\ patternBox height)". left _ (targetBox left truncateTo: patternBox width) "- (offset x \\ patternBox width)". left to: (targetBox right - 1) by: patternBox width do: [:x | top to: (targetBox bottom - 1) by: patternBox height do: [:y | aPort destOrigin: x@y; copyBits]]. aPort colorMap: savedMap. ! ! !InfiniteForm methodsFor: 'displaying' stamp: 'nk 4/17/2004 19:48'! displayOnPort: aPort offsetBy: offset | targetBox patternBox savedMap top left | "this version tries to get the form aligned where the user wants it and not just aligned with the cliprect" (patternForm isForm) ifFalse: [ "patternForm is a Pattern or Color; just use it as a mask for BitBlt" ^ aPort fill: aPort clipRect fillColor: patternForm rule: Form over]. "do it iteratively" targetBox _ aPort clipRect. patternBox _ patternForm boundingBox. savedMap _ aPort colorMap. aPort sourceForm: patternForm; fillColor: nil; combinationRule: Form paint; sourceRect: (0@0 extent: patternBox extent); colorMap: (patternForm colormapIfNeededFor: aPort destForm). top _ (targetBox top truncateTo: patternBox height) + offset y. left _ (targetBox left truncateTo: patternBox width) + offset x. left to: (targetBox right - 1) by: patternBox width do: [:x | top to: (targetBox bottom - 1) by: patternBox height do: [:y | aPort destOrigin: x@y; copyBits]]. aPort colorMap: savedMap. ! ! !PNGReadWriter methodsFor: 'writing' stamp: 'nk 4/17/2004 19:44'! nextPutImage: aForm interlace: aMethod filter: aFilterType "Note: For now we keep it simple - interlace and filtering are simply ignored" | crcStream | bigEndian := Smalltalk isBigEndian. form := aForm. width := aForm width. height := aForm height. aForm depth <= 8 ifTrue:[ bitsPerChannel := aForm depth. colorType := 3. bytesPerScanline _ width * aForm depth + 7 // 8. ] ifFalse:[ bitsPerChannel := 8. colorType := 6. bytesPerScanline _ width * 4. ]. self writeFileSignature. crcStream := WriteStream on: (ByteArray new: 1000). crcStream resetToStart. self writeIHDRChunkOn: crcStream. self writeChunk: crcStream. (form depth <= 8) ifTrue:[ crcStream resetToStart. self writePLTEChunkOn: crcStream. self writeChunk: crcStream. (form isColorForm) ifTrue:[ crcStream resetToStart. self writeTRNSChunkOn: crcStream. self writeChunk: crcStream. ]. ]. form depth = 16 ifTrue:[ crcStream resetToStart. self writeSBITChunkOn: crcStream. self writeChunk: crcStream. ]. crcStream resetToStart. self writeIDATChunkOn: crcStream. self writeChunk: crcStream. crcStream resetToStart. self writeIENDChunkOn: crcStream. self writeChunk: crcStream.! ! !PNGReadWriter methodsFor: 'writing' stamp: 'nk 4/17/2004 19:44'! writePLTEChunkOn: aStream "Write the PLTE chunk" | r g b colors | aStream nextPutAll: 'PLTE' asByteArray. (form isColorForm) ifTrue:[colors := form colors] ifFalse:[colors := Color indexedColors copyFrom: 1 to: (1 bitShift: form depth)]. colors do:[:aColor| r := (aColor red * 255) truncated. g := (aColor green * 255) truncated. b := (aColor blue * 255) truncated. aStream nextPut: r; nextPut: g; nextPut: b. ].! ! !PNGReadWriterTest methodsFor: 'helpers' stamp: 'nk 4/17/2004 19:45'! encodeAndDecode: original "Make sure that the given form is encoded and decoded correctly" | stream bytes decoded maxErr | "encode" stream := ByteArray new writeStream. (PNGReadWriter on: stream) nextPutImage: original; close. bytes := stream contents. self writeEncoded: bytes. "decode" stream := self readEncoded: bytes. decoded := (PNGReadWriter new on: stream) nextImage. decoded display. "compare" self assert: original width = decoded width. self assert: original height = decoded height. self assert: original depth = decoded depth. self assert: original bits = decoded bits. self assert: original class == decoded class. (original isColorForm) ifTrue:[ original colors with: decoded colors do:[:c1 :c2| "we must round here due to encoding errors" maxErr := 1. "max. error for 8bit rgb component" self assert: ((c1 red * 255) truncated - (c2 red * 255) truncated) abs <= maxErr. self assert: ((c1 green * 255) truncated - (c2 green * 255) truncated) abs <= maxErr. self assert: ((c1 blue * 255) truncated - (c2 blue * 255) truncated) abs <= maxErr. self assert: ((c1 alpha * 255) truncated - (c2 alpha * 255) truncated) abs <= maxErr. ]. ].! ! !PNGReadWriterTest methodsFor: 'helpers' stamp: 'nk 4/17/2004 19:45'! encodeAndDecodeReverse: original "Make sure that the given form is encoded and decoded correctly" | stream bytes decoded maxErr reversed | fileName := 'testReverse', original depth printString,'.png'. self assert: original class == Form. "won't work with ColorForm" "Switch pixel order" reversed := Form extent: original extent depth: original depth negated. original displayOn: reversed. self assert: original width = reversed width. self assert: original height = reversed height. self assert: original depth = reversed depth. self deny: original nativeDepth = reversed nativeDepth. original depth = 32 ifTrue:[self assert: original bits = reversed bits] ifFalse:[self deny: original bits = reversed bits]. "encode" stream := ByteArray new writeStream. (PNGReadWriter on: stream) nextPutImage: reversed; close. bytes := stream contents. self writeEncoded: bytes. "decode" stream := bytes readStream. decoded := (PNGReadWriter new on: stream) nextImage. decoded display. "compare" self assert: original width = decoded width. self assert: original height = decoded height. self assert: original depth = decoded depth. self assert: original bits = decoded bits. self assert: original class == decoded class. (original isColorForm) ifTrue:[ original colors with: decoded colors do:[:c1 :c2| "we must round here due to encoding errors" maxErr := 1. "max. error for 8bit rgb component" self assert: ((c1 red * 255) truncated - (c2 red * 255) truncated) abs <= maxErr. self assert: ((c1 green * 255) truncated - (c2 green * 255) truncated) abs <= maxErr. self assert: ((c1 blue * 255) truncated - (c2 blue * 255) truncated) abs <= maxErr. self assert: ((c1 alpha * 255) truncated - (c2 alpha * 255) truncated) abs <= maxErr. ]. ].! ! !PluggableButtonView methodsFor: 'accessing' stamp: 'nk 4/17/2004 19:49'! label: aStringOrDisplayObject "Label this button with the given String or DisplayObject." ((aStringOrDisplayObject isKindOf: Paragraph) or: [aStringOrDisplayObject isForm]) ifTrue: [label _ aStringOrDisplayObject] ifFalse: [label _ aStringOrDisplayObject asParagraph]. self centerLabel. ! ! !PluggableButtonView methodsFor: 'private' stamp: 'nk 4/17/2004 19:49'! centerAlignLabelWith: aPoint "Align the center of the label with aPoint." | alignPt | alignPt _ label boundingBox center. (label isKindOf: Paragraph) ifTrue: [alignPt _ alignPt + (0@(label textStyle leading))]. (label isForm) ifTrue: [label offset: 0 @ 0]. label align: alignPt with: aPoint ! ! !ResourceManager methodsFor: 'loading' stamp: 'nk 4/17/2004 19:50'! loadCachedResources "Load all the resources that we have cached locally" | resource | self class reloadCachedResources. self prioritizedUnloadedResources do:[:loc| self class lookupCachedResource: loc urlString ifPresentDo:[:stream| resource _ resourceMap at: loc ifAbsent:[nil]. self installResource: resource from: stream locator: loc. (resource isForm) ifTrue:[ self formChangedReminder value. World displayWorldSafely]. ]. ].! ! !ResourceManager methodsFor: 'loading' stamp: 'nk 4/17/2004 19:50'! loaderProcess | loader requests req locator resource stream | loader _ HTTPLoader default. requests _ Dictionary new. self prioritizedUnloadedResources do:[:loc| req _ HTTPLoader httpRequestClass for: (self hackURL: loc urlString) in: loader. loader addRequest: req. requests at: req put: loc]. [stopFlag or:[requests isEmpty]] whileFalse:[ stopSemaphore waitTimeoutMSecs: 500. requests keys "need a copy" do:[:r| r isSemaphoreSignaled ifTrue:[ locator _ requests at: r. requests removeKey: r. stream _ r contentStream. resource _ resourceMap at: locator ifAbsent:[nil]. self class cacheResource: locator urlString stream: stream. self installResource: resource from: stream locator: locator. (resource isForm) ifTrue:[ WorldState addDeferredUIMessage: self formChangedReminder] ifFalse: [self halt]. ]. ]. ]. "Either done downloading or terminating process" stopFlag ifTrue:[loader abort]. loaderProcess _ nil. stopSemaphore _ nil.! ! !WarpBlt methodsFor: 'primitives' stamp: 'nk 4/17/2004 19:50'! warpBitsSmoothing: n sourceMap: sourceMap | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps | "Check for compressed source, destination or halftone forms" ((sourceForm isForm) and: [sourceForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. ((destForm isForm) and: [destForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. ((halftoneForm isForm) and: [halftoneForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. (width < 1) | (height < 1) ifTrue: [^ self]. fixedPtOne _ 16384. "1.0 in fixed-pt representation" n > 1 ifTrue: [(destForm depth < 16 and: [colorMap == nil]) ifTrue: ["color map is required to smooth non-RGB dest" ^ self primitiveFail]. pix _ Array new: n*n]. nSteps _ height-1 max: 1. deltaP12 _ (self deltaFrom: p1x to: p2x nSteps: nSteps) @ (self deltaFrom: p1y to: p2y nSteps: nSteps). pA _ (self startFrom: p1x to: p2x offset: nSteps*deltaP12 x) @ (self startFrom: p1y to: p2y offset: nSteps*deltaP12 y). deltaP43 _ (self deltaFrom: p4x to: p3x nSteps: nSteps) @ (self deltaFrom: p4y to: p3y nSteps: nSteps). pB _ (self startFrom: p4x to: p3x offset: nSteps*deltaP43 x) @ (self startFrom: p4y to: p3y offset: nSteps*deltaP43 y). picker _ BitBlt current bitPeekerFromForm: sourceForm. poker _ BitBlt current bitPokerToForm: destForm. poker clipRect: self clipRect. nSteps _ width-1 max: 1. destY to: destY+height-1 do: [:y | deltaPAB _ (self deltaFrom: pA x to: pB x nSteps: nSteps) @ (self deltaFrom: pA y to: pB y nSteps: nSteps). sp _ (self startFrom: pA x to: pB x offset: nSteps*deltaPAB x) @ (self startFrom: pA y to: pB y offset: nSteps*deltaPAB x). destX to: destX+width-1 do: [:x | n = 1 ifTrue: [poker pixelAt: x@y put: (picker pixelAt: sp // fixedPtOne asPoint)] ifFalse: [0 to: n-1 do: [:dx | 0 to: n-1 do: [:dy | pix at: dx*n+dy+1 put: (picker pixelAt: sp + (deltaPAB*dx//n) + (deltaP12*dy//n) // fixedPtOne asPoint)]]. poker pixelAt: x@y put: (self mixPix: pix sourceMap: sourceMap destMap: colorMap)]. sp _ sp + deltaPAB]. pA _ pA + deltaP12. pB _ pB + deltaP43]! ! !WarpBlt class methodsFor: 'form rotation' stamp: 'nk 4/17/2004 19:45'! rotate: srcForm degrees: angleInDegrees center: aPoint scaleBy: scalePoint smoothing: cellSize "Rotate the given Form the given number of degrees about the given center and scale its width and height by x and y of the given scale point. Smooth using the given cell size, an integer between 1 and 3, where 1 means no smoothing. Return a pair where the first element is the rotated Form and the second is the position offset required to align the center of the rotated Form with that of the original. Note that the dimensions of the resulting Form generally differ from those of the original." | srcRect center radians dstOrigin dstCorner p dstRect inverseScale quad dstForm newCenter warpSrc | srcRect _ srcForm boundingBox. center _ srcRect center. radians _ angleInDegrees degreesToRadians. dstOrigin _ dstCorner _ center. srcRect corners do: [:corner | "find the limits of a rectangle that just encloses the rotated original; in general, this rectangle will be larger than the original (e.g., consider a square rotated by 45 degrees)" p _ ((corner - center) scaleBy: scalePoint) + center. p _ (p rotateBy: radians about: center) rounded. dstOrigin _ dstOrigin min: p. dstCorner _ dstCorner max: p]. "rotate the enclosing rectangle back to get the source quadrilateral" dstRect _ dstOrigin corner: dstCorner. inverseScale _ (1.0 / scalePoint x)@(1.0 / scalePoint y). quad _ dstRect innerCorners collect: [:corner | p _ corner rotateBy: radians negated about: center. ((p - center) scaleBy: inverseScale) + center]. "make a Form to hold the result and do the rotation" warpSrc _ srcForm. (srcForm isColorForm) ifTrue: [ cellSize > 1 | true "ar 12/27/2001: Always enable - else sketches won't work" ifTrue: [ warpSrc _ Form extent: srcForm extent depth: 16. srcForm displayOn: warpSrc. dstForm _ Form extent: dstRect extent depth: 16] "use 16-bit depth to allow smoothing" ifFalse: [ dstForm _ srcForm class extent: dstRect extent depth: srcForm depth]] ifFalse: [ dstForm _ srcForm class extent: dstRect extent depth: srcForm depth]. (WarpBlt toForm: dstForm) sourceForm: warpSrc; colorMap: (warpSrc colormapIfNeededFor: dstForm); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: Form paint; copyQuad: quad toRect: dstForm boundingBox. (dstForm isColorForm) ifTrue: [dstForm colors: srcForm colors copy]. newCenter _ (center rotateBy: radians about: aPoint) truncated. ^ Array with: dstForm with: dstRect origin + (newCenter - center) ! ! Form removeSelector: #baldMountainWorkspace! Form removeSelector: #isColorForm! !Form reorganize! ('*ft2-fonts-debugging' asGlyphSampleColored:) ('accessing' bits bits: bitsSize center defaultCanvasClass depth depth: displayScreen extent form getCanvas hasBeenModified hasBeenModified: height nativeDepth offset offset: size width) ('analyzing' cgForPixelValue:orNot: colorsUsed dominantColor innerPixelRectFor:orNot: pixelCompare:with:at: primCountBits rectangleEnclosingPixelsNotOfColor: tallyPixelValues tallyPixelValuesInRect:into: xTallyPixelValue:orNot: yTallyPixelValue:orNot:) ('bordering' border:width:rule:fillColor: borderFormOfWidth:sharpCorners: borderWidth: borderWidth:color: borderWidth:fillColor: shapeBorder:width: shapeBorder:width:interiorPoint:sharpCorners:internal:) ('color mapping' balancedPatternFor: bitPatternFor: colormapFromARGB colormapIfNeededFor: colormapIfNeededForDepth: colormapToARGB makeBWForm: mapColor:to: mapColors:to: maskingMap newColorMap pixelValueFor: pixelWordFor: reducedPaletteOfSize: rgbaBitMasks) ('converting' as8BitColorForm asCursorForm asFormOfDepth: asGrayScale asMorph colorReduced copyWithColorsReducedTo: orderedDither32To16) ('copying' blankCopyOf:scaledBy: contentsOfArea: contentsOfArea:into: copy: copy:from:in:rule: copy:from:to:rule: copyBits:at:translucent: copyBits:from:at:clippingBox:rule:fillColor: copyBits:from:at:clippingBox:rule:fillColor:map: copyBits:from:at:colorMap: deepCopy veryDeepCopyWith:) ('display box access' boundingBox computeBoundingBox) ('displaying' displayInterpolatedIn:on: displayInterpolatedOn: displayOn:at:clippingBox:rule:fillColor: displayOn:transformation:clippingBox:align:with:rule:fillColor: displayOnPort:at: displayResourceFormOn: displayScaledOn: drawLine:from:to:clippingBox:rule:fillColor: paintBits:at:translucent:) ('editing' bitEdit bitEditAt:scale: edit morphEdit) ('encoding' addDeltasFrom: deltaFrom: deltaFrom:at: encodeForRemoteCanvas) ('fileIn/Out' comeFullyUpOnReload: hibernate objectForDataStream: printOn: readAttributesFrom: readBitsFrom: readFrom: readFromOldFormat: replaceByResource: store15To24HexBitsOn: store32To24HexBitsOn: storeBits:to:on: storeBitsOn:base: storeHexBitsOn: storeOn: storeOn:base: unhibernate writeAttributesOn: writeBMPfileNamed: writeBitsOn: writeJPEGfileNamed: writeJPEGfileNamed:progressive: writeOn: writeOnMovie: writeUncompressedOn:) ('filling' anyShapeFill bitPatternForDepth: convexShapeFill: eraseShape: fill:rule:fillColor: fillFromXColorBlock: fillFromXYColorBlock: fillFromYColorBlock: findShapeAroundSeedBlock: floodFill2:at: floodFill:at: floodFill:at:tolerance: floodFillMapFrom:to:mappingColorsWithin:to: shapeFill:interiorPoint: shapeFill:seedBlock:) ('image manipulation' replaceColor:withColor: smear:distance: stencil trimBordersOfColor:) ('initialize-release' allocateForm: finish flush fromDisplay: shutDown swapEndianness) ('other' fixAlpha formForColorCount: graphicForViewerTab primPrintHScale:vScale:landscape: relativeTextAnchorPosition setAsBackground) ('pixel access' colorAt: colorAt:put: isTransparentAt: pixelValueAt: pixelValueAt:put:) ('postscript generation' bitsPerComponent bytesPerRow decodeArray encodePostscriptOn: numComponents paddedWidth printPostscript:operator: rowPadding setColorspaceOn: storePostscriptHexOn:) ('resources' readNativeResourceFrom: readResourceFrom: resourceTag storeResourceOn:) ('scaling, rotation' flipBy:centerAt: magnify:by: magnify:by:smoothing: magnifyBy: rotateBy: rotateBy:centerAt: rotateBy:magnify:smoothing: rotateBy:smoothing: scaledToSize: shrink:by:) ('testing' appearsToBeSameCostumeAs: hasNonStandardPalette isAllWhite isBigEndian isBltAccelerated:for: isDisplayScreen isExternalForm isFillAccelerated:for: isForm isLittleEndian isStatic isTranslucent shouldPreserveContents) ('transitions' fadeImage:at:indexAndMaskDo: fadeImageCoarse:at: fadeImageFine:at: fadeImageHor:at: fadeImageHorFine:at: fadeImageSquares:at: fadeImageVert:at: pageImage:at:corner: pageWarp:at:forward: slideImage:at:delta: wipeImage:at:clippingBox:rectForIndex: wipeImage:at:delta: wipeImage:at:delta:clippingBox: zoomIn:orOutTo:at:vanishingPoint: zoomInTo:at: zoomOutTo:at:) ('private' hackBits: initFromArray: privateFloodFillValue: setExtent:depth: setExtent:depth:bits: setResourceBits:) !