'From Squeak3.1alpha of 28 February 2001 [latest update: #4035] on 16 May 2001 at 10:28:37 pm'! "Change Set: ColorMaps-ar Date: 14 May 2001 Author: Andreas Raab This change set makes all blit operations go through appropriate color maps. This is crucial if any of the forms involved are in non-standard format (e.g., providing a layout that's different from Squeaks assumptions about where the bits for every color should be)."! !B3DPrimitiveRasterizer methodsFor: 'initialize' stamp: 'ar 5/14/2001 23:28'! target: aForm | bb span sourceForm | super target: aForm. target ifNil:[^self]. "Note: span must be Bitmap since software rasterizer expects canonical RGBA for now" span _ Bitmap new: 2048. sourceForm _ Form extent: span size@1 depth: 32 bits: span. bb _ BitBlt current toForm: target. self class primitiveSetBitBltPlugin: bb getPluginName. bb sourceForm: sourceForm. bb colorMap: (sourceForm colormapIfNeededFor: target). bb combinationRule: (target depth >= 8 ifTrue:[34] ifFalse:[Form paint]). bb destX: 0; destY: 0; sourceX: 0; sourceY: 0; width: 1; height: 1. state spanBuffer: span. state bitBlt: bb.! ! !B3DSimulRasterizer methodsFor: 'initialize' stamp: 'ar 5/14/2001 23:31'! target: destForm | bb span sourceForm | super target: destForm. span _ Bitmap new: 2048. sourceForm _ Form extent: span size@1 depth: 32 bits: span. bb _ BitBlt current toForm: destForm. bb sourceForm: sourceForm. bb colorMap: (sourceForm colormapIfNeededFor: destForm). bb combinationRule: 34 "Form paint". "Later we'll change this to 34 for alpha blending" bb destX: 0; destY: 0; sourceX: 0; sourceY: 0; width: 1; height: 1. scanner spanBuffer: span. scanner bitBlt: bb.! ! !BitBlt methodsFor: 'accessing' stamp: 'ar 5/14/2001 23:25'! fillColor: aColorOrPattern "The destForm will be filled with this color or pattern of colors. May be an old Color, a new type Color, a Bitmap (see BitBlt comment), a Pattern, or a Form. 6/18/96 tk" aColorOrPattern == nil ifTrue: [halftoneForm _ nil. ^ self]. destForm == nil ifTrue: [self error: 'Must set destForm first']. halftoneForm _ destForm bitPatternFor: aColorOrPattern ! ! !BitBlt methodsFor: 'copying' stamp: 'ar 5/14/2001 23:32'! copy: destRectangle from: sourcePt in: srcForm fillColor: hf rule: rule "Specify a Color to fill, not a Form. 6/18/96 tk" | destOrigin | sourceForm _ srcForm. self fillColor: hf. "sets halftoneForm" combinationRule _ rule. destOrigin _ destRectangle origin. destX _ destOrigin x. destY _ destOrigin y. sourceX _ sourcePt x. sourceY _ sourcePt y. width _ destRectangle width. height _ destRectangle height. srcForm == nil ifFalse: [colorMap _ srcForm colormapIfNeededFor: destForm]. ^ self copyBits! ! !BitBlt methodsFor: 'copying' stamp: 'ar 5/14/2001 23:27'! 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 isKindOf: Form) and: [sourceForm unhibernate]) ifTrue: [^ self copyBits]. ((destForm isKindOf: Form) and: [destForm unhibernate]) ifTrue: [^ self copyBits]. ((halftoneForm isKindOf: Form) 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]. 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: 'ar 5/14/2001 23:32'! copyForm: srcForm to: destPt rule: rule ^ self copyForm: srcForm to: destPt rule: rule colorMap: (srcForm colormapIfNeededFor: destForm)! ! !BitBlt methodsFor: 'copying' stamp: 'ar 5/14/2001 23:32'! copyFrom: sourceRectangle in: srcForm to: destPt | sourceOrigin | sourceForm _ srcForm. halftoneForm _ nil. combinationRule _ 3. "store" destX _ destPt x. destY _ destPt y. sourceOrigin _ sourceRectangle origin. sourceX _ sourceOrigin x. sourceY _ sourceOrigin y. width _ sourceRectangle width. height _ sourceRectangle height. colorMap _ srcForm colormapIfNeededFor: destForm. self copyBits! ! !BitBlt methodsFor: 'private' stamp: 'ar 5/14/2001 23:43'! installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor | lastSourceDepth | sourceForm ifNotNil:[lastSourceDepth _ sourceForm depth]. sourceForm _ aStrikeFont glyphs. (colorMap notNil and:[lastSourceDepth = sourceForm depth]) ifFalse: ["Set up color map for a different source depth (color font)" "Uses caching for reasonable efficiency" colorMap _ self cachedFontColormapFrom: sourceForm depth to: destForm depth. colorMap at: 1 put: (destForm pixelValueFor: backgroundColor)]. sourceForm depth = 1 ifTrue: [colorMap at: 2 put: (destForm pixelValueFor: foregroundColor). "Ignore any halftone pattern since we use a color map approach here" halftoneForm _ nil]. sourceY _ 0. height _ aStrikeFont height. ! ! !BitBlt methodsFor: 'private' stamp: 'ar 5/14/2001 23:32'! setDestForm: df sourceForm: sf fillColor: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: sourceOrigin extent: extent clipRect: clipRect | aPoint | destForm _ df. sourceForm _ sf. self fillColor: hf. "sets halftoneForm" combinationRule _ cr. destX _ destOrigin x. destY _ destOrigin y. sourceX _ sourceOrigin x. sourceY _ sourceOrigin y. width _ extent x. height _ extent y. aPoint _ clipRect origin. clipX _ aPoint x. clipY _ aPoint y. aPoint _ clipRect corner. clipWidth _ aPoint x - clipX. clipHeight _ aPoint y - clipY. sourceForm == nil ifFalse: [colorMap _ sourceForm colormapIfNeededFor: destForm]! ! !BitBlt class methodsFor: 'benchmarks' stamp: 'ar 5/14/2001 23:31'! benchmark "BitBlt benchmark" "Run a benchmark on different combinations rules, source/destination depths and BitBlt modes. Note: This benchmark doesn't give you any 'absolute' value - it is intended only for benchmarking improvements in the bitblt code and nothing else. Attention: *this*may*take*a*while*" | bb source dest destRect log t | log _ WriteStream on: String new. destRect _ 0@0 extent: 600@600. "Form paint/Form over - the most common rules" #( 25 3 ) do:[:rule| Transcript cr; show:'---- Combination rule: ', rule printString,' ----'. log cr; nextPutAll:'---- Combination rule: ', rule printString,' ----'. #(1 2 4 8 16 32) do:[:destDepth| dest _ nil. dest _ Form extent: destRect extent depth: destDepth. Transcript cr. log cr. #(1 2 4 8 16 32) do:[:sourceDepth| Transcript cr; show: sourceDepth printString, ' => ', destDepth printString. log cr; nextPutAll: sourceDepth printString, ' => ', destDepth printString. source _ nil. bb _ nil. source _ Form extent: destRect extent depth: sourceDepth. (source getCanvas) fillOval: dest boundingBox color: Color yellow borderWidth: 30 borderColor: Color black. bb _ WarpBlt toForm: dest. bb sourceForm: source. bb sourceRect: source boundingBox. bb destRect: dest boundingBox. bb colorMap: (source colormapIfNeededFor: dest). bb combinationRule: rule. "Measure speed of copyBits" t _ Time millisecondsToRun:[bb copyBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. bb sourceForm: source destRect: source boundingBox. "Measure speed of 1x1 warpBits" bb cellSize: 1. t _ Time millisecondsToRun:[bb warpBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. "Measure speed of 2x2 warpBits" bb cellSize: 2. t _ Time millisecondsToRun:[bb warpBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. "Measure speed of 3x3 warpBits" bb cellSize: 3. t _ Time millisecondsToRun:[bb warpBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. ]. ]. ]. ^log contents! ! !BitBlt class methodsFor: 'benchmarks' stamp: 'ar 5/14/2001 23:31'! benchmark2 "BitBlt benchmark" "Run a benchmark on different combinations rules, source/destination depths and BitBlt modes. Note: This benchmark doesn't give you any 'absolute' value - it is intended only for benchmarking improvements in the bitblt code and nothing else. Attention: *this*may*take*a*while*" | bb source dest destRect log t | log _ WriteStream on: String new. destRect _ 0@0 extent: 600@600. "Form paint/Form over - the most common rules" #( 25 3 ) do:[:rule| Transcript cr; show:'---- Combination rule: ', rule printString,' ----'. log cr; nextPutAll:'---- Combination rule: ', rule printString,' ----'. #(1 2 4 8 16 32) do:[:destDepth| dest _ nil. dest _ Form extent: destRect extent depth: destDepth. Transcript cr. log cr. #(1 2 4 8 16 32) do:[:sourceDepth| Transcript cr; show: sourceDepth printString, ' => ', destDepth printString. log cr; nextPutAll: sourceDepth printString, ' => ', destDepth printString. source _ nil. bb _ nil. source _ Form extent: destRect extent depth: sourceDepth. (source getCanvas) fillOval: dest boundingBox color: Color yellow borderWidth: 30 borderColor: Color black. bb _ WarpBlt toForm: dest. bb sourceForm: source. bb sourceRect: source boundingBox. bb destRect: dest boundingBox. bb colorMap: (source colormapIfNeededFor: dest). bb combinationRule: rule. "Measure speed of copyBits" t _ Time millisecondsToRun:[1 to: 10 do:[:i| bb copyBits]]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. bb sourceForm: source destRect: source boundingBox. "Measure speed of 1x1 warpBits" bb cellSize: 1. t _ Time millisecondsToRun:[1 to: 4 do:[:i| bb warpBits]]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. "Measure speed of 2x2 warpBits" bb cellSize: 2. t _ Time millisecondsToRun:[bb warpBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. "Measure speed of 3x3 warpBits" bb cellSize: 3. t _ Time millisecondsToRun:[bb warpBits]. Transcript tab; show: t printString. log tab; nextPutAll: t printString. ]. ]. ]. ^log contents! ! !BitEditor methodsFor: 'menu messages' stamp: 'ar 5/14/2001 23:43'! setColor: aColor "Set the color that the next edited dots of the model to be the argument, aSymbol. aSymbol can be any color changing message understood by a Form, such as white or black." color _ model pixelValueForDepth: aColor. squareForm fillColor: aColor. ! ! !DisplayScanner methodsFor: 'private' stamp: 'ar 5/14/2001 23:44'! initializeFromParagraph: aParagraph clippedBy: clippingRectangle super initializeFromParagraph: aParagraph clippedBy: clippingRectangle. bitBlt _ BitBlt current toForm: aParagraph destinationForm. bitBlt sourceX: 0; width: 0. "Init BitBlt so that the first call to a primitive will not fail" bitBlt combinationRule: Form paint. bitBlt colorMap: (Bitmap with: 0 "Assumes 1-bit deep fonts" with: (bitBlt destForm pixelValueFor: aParagraph foregroundColor)). bitBlt clipRect: clippingRectangle. ! ! !DisplayScanner methodsFor: 'quick print' stamp: 'ar 5/14/2001 23:45'! quickPrintOn: aForm box: aRectangle font: aStrikeFont color: textColor "Initialize myself." bitBlt _ BitBlt current toForm: aForm. backgroundColor _ Color transparent. paragraphColor _ textColor. font _ aStrikeFont ifNil: [TextStyle defaultFont]. emphasisCode _ 0. kern _ 0. indentationLevel _ 0. self setFont. "Override cbrule and map" bitBlt combinationRule: Form paint. bitBlt colorMap: (Bitmap with: 0 "Assumes 1-bit deep fonts" with: (bitBlt destForm pixelValueFor: textColor)). bitBlt clipRect: aRectangle.! ! !Form methodsFor: 'copying' stamp: 'ar 5/14/2001 23:33'! asFormOfDepth: d | newForm | d = 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: 'displaying' stamp: 'ar 5/14/2001 23:33'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: rule fillColor: aForm aDisplayMedium copyBits: self boundingBox from: self at: aDisplayPoint + self offset clippingBox: clipRectangle rule: rule fillColor: aForm map: (self colormapIfNeededFor: aDisplayMedium). ! ! !Form methodsFor: 'displaying' stamp: 'ar 5/14/2001 23:41'! displayResourceFormOn: aForm "a special display method for blowing up resource thumbnails" | engine tx cmap blitter | self extent = aForm extent ifTrue:[^self displayOn: aForm]. Smalltalk at: #B3DRenderEngine ifPresentAndInMemory: [:engineClass | engine _ engineClass defaultForPlatformOn: aForm]. engine ifNil:[ "We've got no bilinear interpolation. Use WarpBlt instead" (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: 3; cellSize: 2; warpBits. ^self ]. tx _ self asTexture. (blitter _ BitBlt current toForm: tx) sourceForm: self; destRect: aForm boundingBox; sourceOrigin: 0@0; combinationRule: Form paint. "map transparency to current World background color" (World color respondsTo: #pixelWordForDepth:) ifTrue: [ cmap _ Bitmap new: (depth <= 8 ifTrue: [1 << self depth] ifFalse: [4096]). cmap at: 1 put: (tx pixelWordFor: World color). blitter colorMap: cmap. ]. blitter copyBits. engine viewport: aForm boundingBox. engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white). engine texture: tx. engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect). engine finish. "the above, using bilinear interpolation doesn't leave transparent pixel values intact" (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: Form and; colorMap: (Color maskingMap: self depth); warpBits.! ! !Form methodsFor: 'filling' stamp: 'ar 5/14/2001 23:46'! colorAt: aPoint put: aColor "Store a Color into the pixel at coordinate aPoint. " self pixelValueAt: aPoint put: (self pixelValueFor: aColor). "[Sensor anyButtonPressed] whileFalse: [Display colorAt: Sensor cursorPoint put: Color red]" ! ! !Form methodsFor: 'filling' stamp: 'ar 5/14/2001 23:46'! floodFill2: aColor at: interiorPoint "Fill the shape (4-connected) at interiorPoint. The algorithm is based on Paul Heckbert's 'A Seed Fill Algorithm', Graphic Gems I, Academic Press, 1990. NOTE: This is a less optimized variant for flood filling which is precisely along the lines of Heckbert's algorithm. For almost all cases #floodFill:at: will be faster (see the comment there) but this method is left in both as reference and as a fallback if such a strange case is encountered in reality." | peeker poker stack old new x y top x1 x2 dy left goRight | peeker _ BitBlt current bitPeekerFromForm: self. poker _ BitBlt current bitPokerToForm: self. stack _ OrderedCollection new: 50. "read old pixel value" old _ peeker pixelAt: interiorPoint. "compute new value" new _ self pixelValueFor: aColor. old = new ifTrue:[^self]. "no point, is there?!!" x _ interiorPoint x. y _ interiorPoint y. (y >= 0 and:[y < height]) ifTrue:[ stack addLast: {y. x. x. 1}. "y, left, right, dy" stack addLast: {y+1. x. x. -1}]. [stack isEmpty] whileFalse:[ top _ stack removeLast. y _ top at: 1. x1 _ top at: 2. x2 _ top at: 3. dy _ top at: 4. y _ y + dy. "Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled. Now explore adjacent pixels in scanline y." x _ x1. [x >= 0 and:[(peeker pixelAt: x@y) = old]] whileTrue:[ poker pixelAt: x@y put: new. x _ x - 1]. goRight _ x < x1. left _ x+1. (left < x1 and:[y-dy >= 0 and:[y-dy < height]]) ifTrue:[stack addLast: {y. left. x1-1. 0-dy}]. goRight ifTrue:[x _ x1 + 1]. [ goRight ifTrue:[ [x < width and:[(peeker pixelAt: x@y) = old]] whileTrue:[ poker pixelAt: x@y put: new. x _ x + 1]. (y+dy >= 0 and:[y+dy < height]) ifTrue:[stack addLast: {y. left. x-1. dy}]. (x > (x2+1) and:[y-dy >= 0 and:[y-dy >= 0]]) ifTrue:[stack addLast: {y. x2+1. x-1. 0-dy}]]. [(x _ x + 1) <= x2 and:[(peeker pixelAt: x@y) ~= old]] whileTrue. left _ x. goRight _ true. x <= x2] whileTrue. ]. ! ! !Form methodsFor: 'filling' stamp: 'ar 5/14/2001 23:46'! isTransparentAt: aPoint "Return true if the receiver is transparent at the given point." depth = 1 ifTrue: [^ false]. "no transparency at depth 1" ^ (self pixelValueAt: aPoint) = (self pixelValueFor: Color transparent) ! ! !Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:33'! flipBy: direction centerAt: aPoint "Return a copy of the receiver flipped either #vertical or #horizontal." | newForm quad | newForm _ self class extent: self extent depth: depth. quad _ self boundingBox innerCorners. quad _ (direction = #vertical ifTrue: [#(2 1 4 3)] ifFalse: [#(4 3 2 1)]) collect: [:i | quad at: i]. (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); combinationRule: 3; copyQuad: quad toRect: newForm boundingBox. newForm offset: (self offset flipBy: direction centerAt: aPoint). ^ newForm " [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) flipBy: #vertical centerAt: 0@0) display] " "Consistency test... | f f2 p | [Sensor anyButtonPressed] whileFalse: [f _ Form fromDisplay: ((p _ Sensor cursorPoint) extent: 31@41). Display fillBlack: (p extent: 31@41). f2 _ f flipBy: #vertical centerAt: 0@0. (f2 flipBy: #vertical centerAt: 0@0) displayAt: p] " ! ! !Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:33'! magnify: aRectangle by: scale smoothing: cellSize "Answer a Form created as a scaling of the receiver. Scale may be a Float, and may be greater or less than 1.0." | newForm | newForm _ self blankCopyOf: aRectangle scaledBy: scale. (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: 3; copyQuad: aRectangle innerCorners toRect: newForm boundingBox. ^ newForm "Dynamic test... [Sensor anyButtonPressed] whileFalse: [(Display magnify: (Sensor cursorPoint extent: 131@81) by: 0.5 smoothing: 2) display] " "Scaling test... | f cp | f _ Form fromDisplay: (Rectangle originFromUser: 100@100). Display restoreAfter: [Sensor waitNoButton. [Sensor anyButtonPressed] whileFalse: [cp _ Sensor cursorPoint. (f magnify: f boundingBox by: (cp x asFloat@cp y asFloat)/f extent smoothing: 2) display]] "! ! !Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:33'! rotateBy: direction centerAt: aPoint "Return a rotated copy of the receiver. direction = #none, #right, #left, or #pi" | newForm quad rot | direction == #none ifTrue: [^ self]. newForm _ self class extent: (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) depth: depth. quad _ self boundingBox innerCorners. rot _ #(right pi left) indexOf: direction. (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); combinationRule: 3; copyQuad: ((1+rot to: 4+rot) collect: [:i | quad atWrap: i]) toRect: newForm boundingBox. newForm offset: (self offset rotateBy: direction centerAt: aPoint). ^ newForm " [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) rotateBy: #left centerAt: 0@0) display] " "Consistency test... | f f2 p | [Sensor anyButtonPressed] whileFalse: [f _ Form fromDisplay: ((p _ Sensor cursorPoint) extent: 31@41). Display fillBlack: (p extent: 31@41). f2 _ f rotateBy: #left centerAt: 0@0. (f2 rotateBy: #right centerAt: 0@0) displayAt: p] " ! ! !Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:33'! rotateBy: deg magnify: scale smoothing: cellSize "Rotate the receiver by the indicated number of degrees and magnify. " "rot is the destination form, big enough for any angle." | side rot warp r1 pts p bigSide | side _ 1 + ((width*width) + (height*height)) asFloat sqrt asInteger. bigSide _ (side * scale) rounded. rot _ Form extent: bigSide@bigSide depth: self depth. warp _ (WarpBlt current toForm: rot) sourceForm: self; colorMap: (self colormapIfNeededFor: rot); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: Form paint. r1 _ (0@0 extent: side@side) align: (side@side)//2 with: self boundingBox center. "Rotate the corners of the source rectangle." pts _ r1 innerCorners collect: [:pt | p _ pt - r1 center. (r1 center x asFloat + (p x asFloat*deg degreeCos) + (p y asFloat*deg degreeSin)) @ (r1 center y asFloat - (p x asFloat*deg degreeSin) + (p y asFloat*deg degreeCos))]. warp copyQuad: pts toRect: rot boundingBox. ^ rot " | a f | f _ Form fromDisplay: (0@0 extent: 200@200). a _ 0. [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) rotateBy: (a _ a+5) magnify: 0.75 smoothing: 2) display]. f display "! ! !Form methodsFor: 'scaling, rotation' stamp: 'ar 5/14/2001 23:34'! rotateBy: deg smoothing: cellSize "Rotate the receiver by the indicated number of degrees." "rot is the destination form, bit enough for any angle." | side rot warp r1 pts p center | side _ 1 + ((width*width) + (height*height)) asFloat sqrt asInteger. rot _ Form extent: side@side depth: self depth. center _ rot extent // 2. "Now compute the sin and cos constants for the rotation angle." warp _ (WarpBlt current toForm: rot) sourceForm: self; colorMap: (self colormapIfNeededFor: rot); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: Form over. r1 _ rot boundingBox align: center with: self boundingBox center. pts _ r1 innerCorners collect: [:pt | p _ pt - r1 center. (r1 center x asFloat + (p x asFloat*deg degreeCos) + (p y asFloat*deg degreeSin)) @ (r1 center y asFloat - (p x asFloat*deg degreeSin) + (p y asFloat*deg degreeCos))]. warp copyQuad: pts toRect: rot boundingBox. ^ rot " | a f | f _ Form fromDisplay: (0@0 extent: 200@200). a _ 0. [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) rotateBy: (a _ a+5) smoothing: 2) display]. f display "! ! !Form methodsFor: 'converting' stamp: 'ar 5/14/2001 23:33'! asTexture | newForm | newForm _ B3DTexture extent: self extent depth: 32. (BitBlt current toForm: newForm) colorMap: (self colormapIfNeededFor: newForm); copy: (self boundingBox) from: 0@0 in: self fillColor: nil rule: Form over. newForm interpolate: false. newForm wrap: false. newForm envMode: 0. ^newForm! ! !Form methodsFor: 'color mapping' stamp: 'ar 5/16/2001 22:23'! colormapIfNeededFor: destForm "Return a ColorMap mapping from the receiver to destForm." (self hasNonStandardPalette or:[destForm hasNonStandardPalette]) ifTrue:[^self colormapFromARGB mappingTo: destForm colormapFromARGB] ifFalse:[^self colormapIfNeededForDepth: destForm depth]! ! !ColorForm methodsFor: 'displaying' stamp: 'ar 5/14/2001 23:32'! displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: rule fillColor: aForm aDisplayMedium copyBits: self boundingBox from: self at: aDisplayPoint + self offset clippingBox: clipRectangle rule: rule fillColor: aForm map: (self colormapIfNeededFor: aDisplayMedium). ! ! !ColorForm methodsFor: 'color mapping' stamp: 'ar 5/16/2001 22:24'! colormapIfNeededFor: destForm | newMap color pv | (self hasNonStandardPalette or:[destForm hasNonStandardPalette]) ifFalse:[ ^self colormapIfNeededForDepth: destForm depth. ]. colors == nil ifTrue: [ "use the standard colormap" ^ super colormapIfNeededFor: destForm]. (destForm depth = cachedDepth and:[cachedColormap isColormap]) ifTrue: [^ cachedColormap]. newMap _ WordArray new: (1 bitShift: depth). 1 to: colors size do: [:i | color _ colors at: i. pv _ destForm pixelValueFor: color. (pv = 0 and:[color isTransparent not]) ifTrue:[pv _ 1]. newMap at: i put: pv]. cachedDepth _ destForm depth. ^cachedColormap _ ColorMap shifts: nil masks: nil colors: newMap.! ! !FormCanvas methodsFor: 'drawing' stamp: 'ar 5/14/2001 23:34'! line: pt1 to: pt2 brushForm: brush | offset | offset _ origin. self setPaintColor: Color black. port sourceForm: brush; fillColor: nil; sourceRect: brush boundingBox; colorMap: (brush colormapIfNeededFor: form); drawFrom: (pt1 + offset) to: (pt2 + offset)! ! !FormCanvas methodsFor: 'private' stamp: 'ar 5/14/2001 23:49'! setClearColor: aColor "Install a new clear color - e.g., a color is used for clearing the background" | clearColor | port isFXBlt ifTrue:[port sourceMap: nil; destMap: nil; colorMap: nil; sourceKey: nil]. clearColor _ aColor ifNil:[Color transparent]. clearColor isColor ifFalse:[ (clearColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color']. ^port fillPattern: clearColor; combinationRule: Form over]. "Okay, so clearColor really *is* a color" port sourceForm: nil. port combinationRule: Form over. port fillPattern: clearColor. self depth = 8 ifTrue:[ "Use a stipple pattern" port fillColor: (form balancedPatternFor: clearColor)]. ! ! !FormCanvas methodsFor: 'private' stamp: 'ar 5/14/2001 23:49'! setFillColor: aColor "Install a new color used for filling." | screen patternWord fillColor | port isFXBlt ifTrue:[port sourceMap: nil; destMap: nil; colorMap: nil; sourceKey: nil]. fillColor _ self shadowColor ifNil:[aColor]. fillColor ifNil:[fillColor _ Color transparent]. fillColor isColor ifFalse:[ (fillColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color']. ^port fillPattern: fillColor; combinationRule: Form over]. "Okay, so fillColor really *is* a color" port sourceForm: nil. fillColor isTranslucent ifFalse:[ port combinationRule: Form over. port fillPattern: fillColor. self depth = 8 ifTrue:[ "In 8 bit depth it's usually a good idea to use a stipple pattern" port fillColor: (form balancedPatternFor: fillColor)]. ^self]. "fillColor is some translucent color" (port isFXBlt and:[self depth >= 8]) ifTrue:[ "FXBlt setup for full alpha mapped transfer" port fillColor: (fillColor bitPatternForDepth: 32). port destMap: form colormapToARGB. port colorMap: form colormapFromARGB. ^port combinationRule: Form blend]. self depth > 8 ifTrue:[ "BitBlt setup for alpha masked transfer" port fillPattern: fillColor. self depth = 16 ifTrue:[port alphaBits: fillColor privateAlpha; combinationRule: 30] ifFalse:[port combinationRule: Form blend]. ^self]. "Can't represent actual transparency -- use stipple pattern" screen _ Color translucentMaskFor: fillColor alpha depth: self depth. patternWord _ form pixelWordFor: fillColor. port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]). port combinationRule: Form paint. ! ! !FormCanvas methodsFor: 'private' stamp: 'ar 5/14/2001 23:49'! setPaintColor: aColor "Install a new color used for filling." | paintColor screen patternWord | port isFXBlt ifTrue:[port sourceMap: nil; destMap: nil; colorMap: nil; sourceKey: nil]. paintColor _ self shadowColor ifNil:[aColor]. paintColor ifNil:[paintColor _ Color transparent]. paintColor isColor ifFalse:[ (paintColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color']. ^port fillPattern: paintColor; combinationRule: Form paint]. "Okay, so paintColor really *is* a color" port sourceForm: nil. (paintColor isTranslucent) ifFalse:[ port fillPattern: paintColor. port combinationRule: Form paint. self depth = 8 ifTrue:[ port fillColor: (form balancedPatternFor: paintColor)]. ^self]. "paintColor is translucent color" (port isFXBlt and:[self depth >= 8]) ifTrue:[ "FXBlt setup for alpha mapped transfer" port fillPattern: paintColor. port fillColor: (paintColor bitPatternForDepth: 32). port destMap: form colormapToARGB. port colorMap: form colormapFromARGB. port combinationRule: Form blend. ^self]. self depth > 8 ifTrue:[ "BitBlt setup for alpha mapped transfer" port fillPattern: paintColor. self depth = 16 ifTrue:[port alphaBits: paintColor privateAlpha; combinationRule: 31] ifFalse:[port combinationRule: Form blend]. ^self]. "Can't represent actual transparency -- use stipple pattern" screen _ Color translucentMaskFor: paintColor alpha depth: self depth. patternWord _ form pixelWordFor: paintColor. port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]). port combinationRule: Form paint ! ! !FormCanvas methodsFor: 'private' stamp: 'ar 5/14/2001 23:39'! setStencilColor: aColor form: sourceForm "Install a new color used for stenciling through FXBlt. Stenciling in general is done mapping all colors of source form to the stencil color and installing the appropriate source key. However, due to possible transparency we may have to install the color map as source map so that sourceForm gets mapped to a 32bit ARGB pixel value before the color combination is done. If we don't need translucency we can just use the regular color map (faster!!)" | stencilColor screen patternWord | port isFXBlt ifFalse:[^self]. "Not appropriate for BitBlt" port sourceMap: nil; destMap: nil; colorMap: nil; sourceKey: nil. stencilColor _ self shadowColor ifNil:[aColor]. stencilColor isColor ifFalse:[^self]. "No way" (stencilColor isTranslucent) ifFalse:[ "If the paint color is not translucent we can use a simpler transformation going through a single color map." port sourceKey: 0. "The transparent source key" port fillPattern: stencilColor. port colorMap: (ColorMap colors: port fillColor). port fillColor: nil. ^port combinationRule: Form over]. (self depth >= 8) ifTrue:[ "For transparent stenciling, things are more complicated. We need to install the transparent stencil color as source map so that all colors are mapped to the stencil color and afterwards blended with the destination." port sourceKey: 0. "The transparent source key" port fillPattern: stencilColor. port destMap: form colormapToARGB. port colorMap: form colormapFromARGB. port sourceMap: (ColorMap colors: (stencilColor bitPatternForDepth: 32)). port fillColor: nil. port combinationRule: Form blend. ^self]. "Translucent stenciling in < 8bit depth requires three parts, a color map, a fill pattern and the appropriate combination rule." port colorMap: (ColorMap colors: (Color maskingMap: form depth)). screen _ Color translucentMaskFor: stencilColor alpha depth: self depth. patternWord _ form pixelWordFor: stencilColor. port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]). port combinationRule: Form paint! ! !FormCanvas methodsFor: 'drawing-images' stamp: 'ar 5/14/2001 23:34'! image: aForm at: aPoint sourceRect: sourceRect rule: rule "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule." port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil. port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule.! ! !InfiniteForm methodsFor: 'displaying' stamp: 'ar 5/14/2001 23:34'! 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 isKindOf: Form) 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: 'ar 5/14/2001 23:35'! 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 isKindOf: Form) 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: 'ar 5/14/2001 23:35'! 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 isKindOf: Form) 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. ! ! !Pen class methodsFor: 'tablet drawing examples' stamp: 'ar 5/14/2001 23:35'! feltTip: width cellSize: cellSize "Warning: This example potentially uses a large amount of memory--it creates a Form with cellSize squared bits for every Display pixel." "In this example, all drawing is done into a large, monochrome Form and then scaled down onto the Display using smoothing. The larger the cell size, the more possible shades of gray can be generated, and the smoother the resulting line appears. A cell size of 8 yields 64 possible grays, while a cell size of 16 gives 256 levels, which is about the maximum number of grays that the human visual system can distinguish. The width parameter determines the maximum line thickness. Requires the optional tablet support primitives which may not be supported on all platforms. Works best in full screen mode. Shift-mouse to exit." "Pen feltTip: 2.7 cellSize: 8" | tabletScale bitForm pen warp p srcR dstR nibSize startP r | tabletScale _ self tabletScaleFactor. bitForm _ Form extent: Display extent * cellSize depth: 1. pen _ Pen newOnForm: bitForm. pen color: Color black. warp _ (WarpBlt current toForm: Display) sourceForm: bitForm; colorMap: (bitForm colormapIfNeededFor: Display); cellSize: cellSize; combinationRule: Form over. Display fillColor: Color white. Display restoreAfter: [ [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [ p _ (Sensor tabletPoint * cellSize * tabletScale) rounded. nibSize _ (Sensor tabletPressure * (cellSize * width)) rounded. nibSize > 0 ifTrue: [ pen squareNib: nibSize. startP _ pen location. pen goto: p. r _ startP rect: pen location. dstR _ (r origin // cellSize) corner: ((r corner + nibSize + (cellSize - 1)) // cellSize). srcR _ (dstR origin * cellSize) corner: (dstR corner * cellSize). warp copyQuad: srcR innerCorners toRect: dstR] ifFalse: [ pen place: p]]]. ! ! !PlayingCard methodsFor: 'all' stamp: 'ar 5/14/2001 23:39'! buildImage "(PlayingCard the: 12 of: #hearts) cardForm display" "World addMorph: (ImageMorph new image: (PlayingCard the: 12 of: #hearts) cardForm)" "PlayingCard test" | blt numForm suitForm spot face ace sloc colorMap fillColor | "Set up blt to copy in color for 1-bit forms" blt _ BitBlt current toForm: cardForm. fillColor _ self color. colorMap _ (((Array with: Color white with: fillColor) collect: [:c | cardForm pixelWordFor: c]) as: Bitmap). blt copy: cardForm boundingBox from: 0@0 in: self blankCard. "Start with a blank card image" numForm _ NumberForms at: cardNo. "Put number in topLeft" blt copyForm: numForm to: NumberLoc rule: Form over colorMap: colorMap. suitForm _ SuitForms at: suitNo*3-2. "Put small suit just below number" sloc _ SuitLoc. cardNo > 10 ifTrue: [suitForm _ SuitForms at: suitNo*3-1. "Smaller for face cards" sloc _ SuitLoc - (1@0)]. blt copyForm: suitForm to: sloc rule: Form over colorMap: colorMap. cardNo <= 10 ifTrue: ["Copy top-half spots to the number cards" spot _ SuitForms at: suitNo*3. "Large suit spots" (TopSpotLocs at: cardNo) do: [:loc | blt copyForm: spot to: loc rule: Form over colorMap: colorMap]] ifFalse: ["Copy top half of face cards" face _ FaceForms at: suitNo-1*3 + 14-cardNo. blt colorMap: self faceColorMap; copy: (FaceLoc extent: face extent) from: 0@0 in: face]. "Now copy top half to bottom" self copyTopToBottomHalf. cardNo <= 10 ifTrue: ["Copy middle spots to the number cards" (MidSpotLocs at: cardNo) do: [:loc | blt copyForm: spot to: loc rule: Form over colorMap: colorMap]]. (cardNo = 1 and: [suitNo = 4]) ifTrue: ["Special treatment for the ace of spades" ace _ FaceForms at: 13. blt colorMap: self faceColorMap; copy: (ASpadesLoc extent: ace extent) from: 0@0 in: ace] ! ! !Sonogram methodsFor: 'all' stamp: 'ar 5/14/2001 23:48'! extent: newExtent super image: (Form extent: newExtent depth: Display depth). lastX _ -1. columnForm _ Form extent: (32//image depth)@(image height) depth: image depth. pixValMap _ ((1 to: 256) collect: [:i | columnForm pixelValueFor: (Color gray: (256-i)/255.0)]) as: Bitmap. ! ! !StandardSystemView methodsFor: 'displaying' stamp: 'ar 5/14/2001 23:40'! displayRacingStripes "Display Racing Stripes in the label" | labelDisplayBox stripes top bottom left box right | labelDisplayBox _ self labelDisplayBox. top _ labelDisplayBox top + 3. bottom _ labelDisplayBox bottom - 3. stripes _ Bitmap with: (Display pixelWordFor: self labelColor) with: (Display pixelWordFor: Color black). top even ifFalse: [stripes swap: 1 with: 2]. left _ labelDisplayBox left + 3. box _ self closeBoxFrame. right _ box left - 2. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. left _ box right + 2. box _ self labelTextRegion. right _ box left - 3. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. left _ box right + 2. box _ self growBoxFrame. right _ box left - 2. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. left _ box right + 2. right _ labelDisplayBox right - 3. Display fill: (Rectangle left: left right: right top: top bottom: bottom) fillColor: stripes. ! ! !WarpBlt class methodsFor: 'form rotation' stamp: 'ar 5/14/2001 23:36'! 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 isKindOf: ColorForm) ifTrue: [ cellSize > 1 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 isKindOf: ColorForm) ifTrue: [dstForm colors: srcForm colors copy]. newCenter _ (center rotateBy: radians about: aPoint) truncated. ^ Array with: dstForm with: dstRect origin + (newCenter - center) ! ! !WebPageMorph methodsFor: 'other' stamp: 'ar 5/14/2001 23:36'! drawImage: aForm | aImage patternBox targetBox map | aImage _ Form extent: self extent depth: Display depth. patternBox _ aForm boundingBox. targetBox _ aImage boundingBox. map _ aForm colormapIfNeededFor: aImage. targetBox left to: targetBox right - 1 by: patternBox width do: [:x | targetBox top to: targetBox bottom - 1 by: patternBox height do: [:y | aImage copyBits: patternBox from: aForm at: x @ y colorMap: map ]]. ^aImage! !