tim Rowledge uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tpr.204.mcz
==================== Summary ====================
Name: Graphics-tpr.204
Author: tpr
Time: 25 March 2013, 2:11:52.527 pm
UUID: 47bc1ef2-4bb2-4c04-8e9b-6cbe3adba133
Ancestors: Graphics-cbc.203
Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment
=============== Diff against Graphics-cbc.203 ===============
Item was changed:
----- Method: BitBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for BitBlt"
+ ^self!
- ^Display defaultBitBltClass!
Item was changed:
----- Method: ColorForm>>copy: (in category 'copying') -----
copy: aRect
"Return a new ColorForm containing the portion of the receiver delineated by aRect."
| newForm |
newForm := self species extent: aRect extent depth: depth.
+ ((BitBlt
- ((BitBlt current
destForm: newForm
sourceForm: self
fillColor: nil
combinationRule: Form over
destOrigin: 0@0
sourceOrigin: aRect origin
extent: aRect extent
clipRect: newForm boundingBox)
colorMap: nil) copyBits.
colors ifNotNil: [newForm colors: colors copy].
^ newForm
!
Item was changed:
----- Method: ColorForm>>pixelValueAt: (in category 'pixel accessing') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color."
"Details: To get the raw pixel value, be sure the peeker's colorMap is nil."
+ ^ (BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
- ^ (BitBlt current bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
!
Item was changed:
----- Method: ColorForm>>twoToneFromDisplay:backgroundColor: (in category 'color manipulation') -----
twoToneFromDisplay: aRectangle backgroundColor: bgColor
"Copy one-bit deep ColorForm from the Display using a color map that maps all colors except the background color to black. Used for caching the contents of inactive MVC windows."
| map |
(width = aRectangle width and: [height = aRectangle height])
ifFalse: [self setExtent: aRectangle extent depth: depth].
"make a color map mapping the background color
to zero and all other colors to one"
map := Bitmap new: (1 bitShift: (Display depth min: 9)).
1 to: map size do: [:i | map at: i put: 16rFFFFFFFF].
map at: (bgColor indexInMap: map) put: 0.
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
destOrigin: 0@0;
sourceForm: Display;
sourceRect: aRectangle;
combinationRule: Form over;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: DisplayMedium>>fillShape:fillColor:at: (in category 'coloring') -----
fillShape: aShapeForm fillColor: aColor at: location
"Fill a region corresponding to 1 bits in aShapeForm with aColor"
+ ((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor
- ((BitBlt current destForm: self sourceForm: aShapeForm fillColor: aColor
combinationRule: Form paint
destOrigin: location + aShapeForm offset sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits!
Item was changed:
----- Method: DisplayObject>>follow:while:bitsBehind:startingLoc: (in category 'displaying-Display') -----
follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc
"Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value."
| location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects |
location := loc.
rect1 := location extent: self extent.
save1 := initialBitsBehind.
+ save1Blt := BitBlt toForm: save1.
- save1Blt := BitBlt current toForm: save1.
buffer := Form extent: self extent*2 depth: Display depth. "Holds overlapping region"
+ bufferBlt := BitBlt toForm: buffer.
- bufferBlt := BitBlt current toForm: buffer.
Display deferUpdates: true.
self displayOn: Display at: location rule: Form paint.
Display deferUpdates: false; forceToScreen: (location extent: self extent).
[durationBlock value] whileTrue: [
newLoc := locationBlock value.
newLoc ~= location ifTrue: [
rect2 := newLoc extent: self extent.
bothRects := rect1 merge: rect2.
(rect1 intersects: rect2)
ifTrue: [ "when overlap, buffer background for both rectangles"
bufferBlt copyFrom: bothRects in: Display to: 0@0.
bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin.
"now buffer is clean background; get new bits for save1"
save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer.
self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint.
Display deferUpdates: true.
Display copy: bothRects from: 0@0 in: buffer rule: Form over.
Display deferUpdates: false; forceToScreen: bothRects]
ifFalse: [ "when no overlap, do the simple thing (both rects might be too big)"
Display deferUpdates: true.
Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over.
save1Blt copyFrom: rect2 in: Display to: 0@0.
self displayOn: Display at: newLoc rule: Form paint.
Display deferUpdates: false;
forceToScreen: (location extent: save1 extent);
forceToScreen: (newLoc extent: self extent)].
location := newLoc.
rect1 := rect2]].
^ save1 displayOn: Display at: location
!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) copyBits!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) colorMap: map) copyBits!
Item was changed:
----- Method: Form class>>dotOfSize: (in category 'instance creation') -----
dotOfSize: diameter
"Create a form which contains a round black dot."
| radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx |
radius := diameter//2.
form := self extent: diameter@diameter offset: (0@0) - (radius@radius).
+ bb := (BitBlt toForm: form)
- bb := (BitBlt current toForm: form)
sourceX: 0; sourceY: 0;
combinationRule: Form over;
fillColor: Color black.
rect := form boundingBox.
centerX := rect center x.
centerY := rect center y.
centerYBias := rect height odd ifTrue: [0] ifFalse: [1].
centerXBias := rect width odd ifTrue: [0] ifFalse: [1].
radiusSquared := (rect height asFloat / 2.0) squared - 0.01.
xOverY := rect width asFloat / rect height asFloat.
maxy := rect height - 1 // 2.
"First do the inner fill, and collect x values"
0 to: maxy do:
[:dy |
dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated.
bb destX: centerX - centerXBias - dx
destY: centerY - centerYBias - dy
width: dx + dx + centerXBias + 1
height: 1;
copyBits.
bb destY: centerY + dy;
copyBits].
^ form
"
Time millisecondsToRun:
[1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]]
"!
Item was changed:
----- Method: Form class>>toothpaste: (in category 'examples') -----
toothpaste: diam "Display restoreAfter: [Form toothpaste: 30]"
"Draws wormlike lines by laying down images of spheres.
See Ken Knowlton, Computer Graphics, vol. 15 no. 4 p352.
Draw with mouse button down; terminate by option-click."
| facade ball filter point queue port color q colors colr colr2 |
colors := Display depth = 1
ifTrue: [Array with: Color black]
ifFalse: [Color red wheel: 12].
facade := Form extent: diam@diam offset: (diam // -2) asPoint.
(Form dotOfSize: diam) displayOn: facade
at: (diam // 2) asPoint clippingBox: facade boundingBox
rule: Form under fillColor: Color white.
#(1 2 3) do:
[:x | "simulate facade by circles of gray"
(Form dotOfSize: x * diam // 5) displayOn: facade
at: (diam * 2 // 5) asPoint clippingBox: facade boundingBox
rule: Form under
fillColor: (Color perform:
(#(black gray lightGray) at: x)).
"facade displayAt: 50*x@50"].
ball := Form dotOfSize: diam.
color := 8.
+ [port := BitBlt toForm: Display.
- [port := BitBlt current toForm: Display.
"Expand 1-bit forms to any pixel depth"
port colorMap: (Bitmap with: 0 with: 16rFFFFFFFF).
queue := OrderedCollection new: 32.
16 timesRepeat: [queue addLast: -20 @ -20].
Sensor waitButton.
Sensor yellowButtonPressed ifTrue: [^ self].
filter := Sensor cursorPoint.
colr := colors atWrap: (color := color + 5). "choose increment relatively prime to colors size"
colr2 := colr alphaMixed: 0.3 with: Color white.
[Sensor redButtonPressed or: [queue size > 0]] whileTrue:
[filter := filter * 4 + Sensor cursorPoint // 5.
point := Sensor redButtonPressed
ifTrue: [filter] ifFalse: [-20 @ -20].
port copyForm: ball to: point rule: Form paint fillColor: colr.
(q := queue removeFirst) == nil ifTrue: [^ self]. "exit"
Display depth = 1
ifTrue: [port copyForm: facade to: q rule: Form erase]
ifFalse: [port copyForm: facade to: q rule: Form paint fillColor: colr2].
Sensor redButtonPressed ifTrue: [queue addLast: point]]] repeat.
!
Item was changed:
----- Method: Form>>asFormOfDepth: (in category 'converting') -----
asFormOfDepth: d
| newForm |
d = self depth ifTrue:[^self].
newForm := Form extent: self extent depth: d.
+ (BitBlt toForm: newForm)
- (BitBlt current toForm: newForm)
colorMap: (self colormapIfNeededFor: newForm);
copy: (self boundingBox)
from: 0@0 in: self
fillColor: nil rule: Form over.
"Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation."
(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
^newForm!
Item was changed:
----- Method: Form>>asGrayScale (in category 'converting') -----
asGrayScale
"Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)"
| f32 srcForm result map bb grays |
self depth = 32 ifFalse: [
f32 := Form extent: width@height depth: 32.
self displayOn: f32.
^ f32 asGrayScale].
self unhibernate.
srcForm := Form extent: (width * 4)@height depth: 8.
srcForm bits: bits.
result := ColorForm extent: width@height depth: 8.
map := Bitmap new: 256.
2 to: 256 do: [:i | map at: i put: i - 1].
map at: 1 put: 1. "map zero pixel values to near-black"
+ bb := (BitBlt toForm: result)
- bb := (BitBlt current toForm: result)
sourceForm: srcForm;
combinationRule: Form over;
colorMap: map.
0 to: width - 1 do: [:dstX |
bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height);
destOrigin: dstX@0;
copyBits].
"final BitBlt to zero-out pixels that were truely transparent in the original"
map := Bitmap new: 512.
map at: 1 put: 16rFF.
+ (BitBlt toForm: result)
- (BitBlt current toForm: result)
sourceForm: self;
sourceRect: self boundingBox;
destOrigin: 0@0;
combinationRule: Form erase;
colorMap: map;
copyBits.
grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0].
grays at: 1 put: Color transparent.
result colors: grays.
^ result
!
Item was changed:
----- Method: Form>>border:width:rule:fillColor: (in category 'bordering') -----
border: rect width: borderWidth rule: rule fillColor: fillColor
"Paint a border whose rectangular area is defined by rect. The
width of the border of each side is borderWidth. Uses fillColor for drawing
the border."
| blt |
+ blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor.
- blt := (BitBlt current toForm: self) combinationRule: rule; fillColor: fillColor.
blt sourceOrigin: 0@0.
blt destOrigin: rect origin.
blt width: rect width; height: borderWidth; copyBits.
blt destY: rect corner y - borderWidth; copyBits.
blt destY: rect origin y + borderWidth.
blt height: rect height - borderWidth - borderWidth; width:
borderWidth; copyBits.
blt destX: rect corner x - borderWidth; copyBits!
Item was changed:
----- Method: Form>>borderFormOfWidth:sharpCorners: (in category 'bordering') -----
borderFormOfWidth: borderWidth sharpCorners: sharpen
"Smear this form around and then subtract the original to produce
an outline. If sharpen is true, then cause right angles to be outlined
by right angles (takes an additional diagonal smears ANDed with both
horizontal and vertical smears)."
| smearForm bigForm smearPort all cornerForm cornerPort nbrs |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
bigForm := self deepCopy.
all := bigForm boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
sharpen ifTrue:
[cornerForm := Form extent: self extent.
+ cornerPort := BitBlt toForm: cornerForm].
- cornerPort := BitBlt current toForm: cornerForm].
nbrs := (0@0) fourNeighbors.
1 to: borderWidth do:
[:i | "Iterate to get several layers of 'skin'"
nbrs do:
[:d | "Smear the self in 4 directions to grow each layer of skin"
smearPort copyForm: bigForm to: d rule: Form under].
sharpen ifTrue:
["Special treatment to smear sharp corners"
nbrs with: ((2 to: 5) collect: [:i2 | nbrs atWrap: i2]) do:
[:d1 :d2 |
"Copy corner points diagonally"
cornerPort copyForm: bigForm to: d1+d2 rule: Form over.
"But only preserve if there were dots on either side"
cornerPort copyForm: bigForm to: d1+d1+d2 rule: Form and.
cornerPort copyForm: bigForm to: d1+d2+d2 rule: Form and.
smearPort copyForm: cornerForm to: 0@0 rule: Form under].
].
bigForm copy: all from: 0@0 in: smearForm rule: Form over.
].
"Now erase the original shape to obtain the outline"
bigForm copy: all from: 0@0 in: self rule: Form erase.
^ bigForm!
Item was changed:
----- Method: Form>>copy:from:in:rule: (in category 'copying') -----
copy: destRectangle from: sourcePt in: sourceForm rule: rule
"Make up a BitBlt table and copy the bits."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: destRectangle
from: sourcePt in: sourceForm
fillColor: nil rule: rule!
Item was changed:
----- Method: Form>>copyBits:at:translucent: (in category 'copying') -----
copyBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 30
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm
"Make up a BitBlt table and copy the bits."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map
"Make up a BitBlt table and copy the bits. Use a colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:colorMap: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map
"Make up a BitBlt table and copy the bits with the given colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: Form over
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: self boundingBox) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>displayInterpolatedIn:on: (in category 'displaying') -----
displayInterpolatedIn: aRectangle on: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine adjustedR |
self extent = aRectangle extent ifTrue:[^self displayOn: aForm at: aRectangle origin].
engine := Smalltalk at: #B3DRenderEngine
ifPresent: [:engineClass | (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aRectangle;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
"there seems to be a slight bug in B3D which the following adjusts for"
adjustedR := (aRectangle withRight: aRectangle right + 1) translateBy: 0@1.
engine viewport: adjustedR.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayInterpolatedOn: (in category 'displaying') -----
displayInterpolatedOn: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine
ifPresent:[:engineClass| (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
engine viewport: aForm boundingBox.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayResourceFormOn: (in category 'displaying') -----
displayResourceFormOn: aForm
"a special display method for blowing up resource thumbnails"
| engine tx cmap blitter |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine ifPresent:
[:engineClass | engineClass defaultForPlatformOn: aForm].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
tx := self asTexture.
+ (blitter := BitBlt toForm: tx)
- (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: (self 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 toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form and;
colorMap: (Color maskingMap: self depth);
warpBits.!
Item was changed:
----- Method: Form>>displayScaledOn: (in category 'displaying') -----
displayScaledOn: aForm
"Display the receiver on aForm, scaling if necessary.
Form fromUser displayScaledOn: Display.
"
self extent = aForm extent ifTrue:[^self displayOn: aForm].
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form paint;
cellSize: 2;
warpBits.!
Item was changed:
----- Method: Form>>drawLine:from:to:clippingBox:rule:fillColor: (in category 'displaying') -----
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm
"Refer to the comment in
DisplayMedium|drawLine:from:to:clippingBox:rule:mask:."
| dotSetter |
"set up an instance of BitBlt for display"
+ dotSetter := BitBlt
- dotSetter := BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: anInteger
destOrigin: beginPoint
sourceOrigin: 0 @ 0
extent: sourceForm extent
clipRect: clipRect.
dotSetter drawFrom: beginPoint to: endPoint!
Item was changed:
----- Method: Form>>eraseShape: (in category 'filling') -----
eraseShape: bwForm
"use bwForm as a mask to clear all pixels where bwForm has 1's"
+ ((BitBlt destForm: self sourceForm: bwForm
- ((BitBlt current destForm: self sourceForm: bwForm
fillColor: nil
combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask"
destOrigin: bwForm offset
sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits.
!
Item was changed:
----- Method: Form>>fill:rule:fillColor: (in category 'filling') -----
fill: aRectangle rule: anInteger fillColor: aForm
"Replace a rectangular area of the receiver with the pattern described by aForm
according to the rule anInteger."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: aRectangle
from: 0@0 in: nil
fillColor: aForm rule: anInteger!
Item was changed:
----- Method: Form>>fillFromXYColorBlock: (in category 'filling') -----
fillFromXYColorBlock: colorBlock
"General Gradient Fill.
Supply relative x and y in [0.0 ... 1.0] to colorBlock,
and paint each pixel with the color that comes back"
| poker yRel xRel |
+ poker := BitBlt bitPokerToForm: self.
- poker := BitBlt current bitPokerToForm: self.
0 to: height-1 do:
[:y | yRel := y asFloat / (height-1) asFloat.
0 to: width-1 do:
[:x | xRel := x asFloat / (width-1) asFloat.
poker pixelAt: x@y
put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]]
"
| d |
((Form extent: 100@20 depth: Display depth)
fillFromXYColorBlock:
[:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs.
Color r: d g: 0 b: 1.0-d]) display
"!
Item was changed:
----- Method: Form>>findShapeAroundSeedBlock: (in category 'filling') -----
findShapeAroundSeedBlock: seedBlock
"Build a shape that is black in any region marked by seedBlock.
SeedBlock will be supplied a form, in which to blacken various
pixels as 'seeds'. Then the seeds are smeared until
there is no change in the smear when it fills the region, ie,
when smearing hits a black border and thus goes no further."
| smearForm previousSmear all count smearPort |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
all := self boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
seedBlock value: smearForm. "Blacken seeds to be smeared"
smearPort copyForm: self to: 0 @ 0 rule: Form erase. "Clear any in black"
previousSmear := smearForm deepCopy.
count := 1.
[count = 10 and: "check for no change every 10 smears"
[count := 1.
previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse.
previousSmear isAllWhite]]
whileFalse:
[smearPort copyForm: smearForm to: 1 @ 0 rule: Form under.
smearPort copyForm: smearForm to: -1 @ 0 rule: Form under.
"After horiz smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
smearPort copyForm: smearForm to: 0 @ 1 rule: Form under.
smearPort copyForm: smearForm to: 0 @ -1 rule: Form under.
"After vert smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
count := count + 1.
count = 9 ifTrue: "Save penultimate smear for comparison"
[previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]].
"Now paint the filled region in me with aHalftone"
^ smearForm!
Item was changed:
----- Method: Form>>flipBy:centerAt: (in category 'scaling, rotation') -----
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.
- newForm := self species 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 toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>floodFill2:at: (in category 'filling') -----
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 bitPeekerFromForm: self.
+ poker := BitBlt bitPokerToForm: self.
- 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.
].
!
Item was changed:
----- Method: Form>>floodFill:at:tolerance: (in category 'filling') -----
floodFill: aColor at: interiorPoint tolerance: tolerance
"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 (ar): This variant has been heavily optimized to prevent the overhead of repeated calls to BitBlt. Usually this is a really big winner but the runtime now depends a bit on the complexity of the shape to be filled. For extremely complex shapes (say, a Hilbert curve) with very few pixels to fill it can be slower than #floodFill2:at: since it needs to repeatedly read the source bits. However, in all practical cases I found this variant to be 15-20 times faster than anything else.
Further note (di): I have added a feature that allows this routine to fill areas of approximately constant color (such as photos, scans, and jpegs). It does this by computing a color map for the peeker that maps all colors close to 'old' into colors identical to old. This mild colorblindness achieves the desired effect with no further change or degradation of the algorithm. tolerance should be 0 (exact match), or a value corresponding to those returned by Color>>diff:, with 0.1 being a reasonable starting choice."
| peeker poker stack old new x y top x1 x2 dy left goRight span spanBits w box debug |
debug := false. "set it to true to see the filling process"
box := interiorPoint extent: 1@1.
span := Form extent: width@1 depth: 32.
spanBits := span bits.
+ peeker := BitBlt toForm: span.
- peeker := BitBlt current toForm: span.
peeker
sourceForm: self;
combinationRule: 3;
width: width;
height: 1.
"read old pixel value"
peeker sourceOrigin: interiorPoint; destOrigin: interiorPoint x @ 0; width: 1; copyBits.
old := spanBits at: interiorPoint x + 1.
"compute new value (take care since the algorithm will fail if old = new)"
new := self privateFloodFillValue: aColor.
old = new ifTrue: [^ box].
tolerance > 0 ifTrue:
["Set up color map for approximate fills"
peeker colorMap: (self floodFillMapFrom: self to: span mappingColorsWithin: tolerance to: old)].
+ poker := BitBlt toForm: self.
- poker := BitBlt current toForm: self.
poker
fillColor: aColor;
combinationRule: 3;
width: width;
height: 1.
stack := OrderedCollection new: 50.
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:[
debug ifTrue:[self displayOn: Display].
top := stack removeLast.
y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4.
y := y + dy.
debug ifTrue:[
Display
drawLine: (Form extent: 1@1 depth: 8) fillWhite
from: (x1-1)@y to: (x2+1)@y
clippingBox: Display boundingBox
rule: Form over fillColor: nil].
"Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled.
Now explore adjacent pixels in scanline y."
peeker sourceOrigin: 0@y; destOrigin: 0@0; width: width; copyBits.
"Note: above is necessary since we don't know where we'll end up filling"
x := x1.
w := 0.
[x >= 0 and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x - 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: x+1@y; width: w; copyBits.
box := box quickMerge: ((x+1@y) extent: w@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:[
w := 0.
[x < width and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x + 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: (x-w)@y; width: w; copyBits.
box := box quickMerge: ((x-w@y) extent: w@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:[(spanBits at: x+1) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
^box!
Item was changed:
----- Method: Form>>magnify:by:smoothing: (in category 'scaling, rotation') -----
magnify: aRectangle by: scale smoothing: cellSize
"Answer a Form created as a scaling of the receiver.
Scale may be a Float or even a Point, and may be greater or less than 1.0."
| newForm |
newForm := self blankCopyOf: aRectangle scaledBy: scale.
+ (WarpBlt toForm: newForm)
- (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]]
"!
Item was changed:
----- Method: Form>>mapColor:to: (in category 'color mapping') -----
mapColor: oldColor to: newColor
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
map := (Color cachedColormapFrom: self depth to: self depth) copy.
map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth).
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>mapColors:to: (in category 'color mapping') -----
mapColors: oldColorBitsCollection to: newColorBits
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
self depth < 16
ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy]
ifFalse: [
"use maximum resolution color map"
"source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component"
map := Color computeRGBColormapFor: self depth bitsPerColor: 5].
oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits].
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>pageWarp:at:forward: (in category 'transitions') -----
pageWarp: otherImage at: topLeft forward: forward
"Produce a page-turning illusion that gradually reveals otherImage
located at topLeft in this form.
forward == true means turn pages toward you, else away. [ignored for now]"
| pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d |
pageRect := otherImage boundingBox.
oldPage := self copy: (pageRect translateBy: topLeft).
(forward ifTrue: [oldPage] ifFalse: [otherImage])
border: pageRect
widthRectangle: (Rectangle
left: 0
right: 2
top: 1
bottom: 1)
rule: Form over
fillColor: Color black.
oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))).
nSteps := 8.
buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth.
d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight.
1 to: nSteps-1 do:
[:i | forward
ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
p := pageRect topRight + (d * i // nSteps)]
ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over.
p := pageRect topRight + (d * (nSteps-i) // nSteps)].
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y).
sourceQuad := Array with: pageRect topLeft
with: pageRect bottomLeft + (0@p y)
with: pageRect bottomRight
with: pageRect topRight - (0@p y).
+ warp := (WarpBlt toForm: buffer)
- warp := (WarpBlt current toForm: buffer)
clipRect: leafRect;
sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]);
combinationRule: Form paint.
warp copyQuad: sourceQuad toRect: leafRect.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate].
buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate.
"
1 to: 4 do: [:corner | Display pageWarp:
(Form fromDisplay: (10@10 extent: 200@300)) reverse
at: 10@10 forward: false]
"
!
Item was changed:
----- Method: Form>>paintBits:at:translucent: (in category 'displaying') -----
paintBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt destForm: self
- (BitBlt current destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 31
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent.
f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>pixelCompare:with:at: (in category 'analyzing') -----
pixelCompare: aRect with: otherForm at: otherLoc
"Compare the selected bits of this form (those within aRect) against
those in a similar rectangle of otherFrom. Return the sum of the
absolute value of the differences of the color values of every pixel.
Obviously, this is most useful for rgb (16- or 32-bit) pixels but,
in the case of 8-bits or less, this will return the sum of the differing
bits of the corresponding pixel values (somewhat less useful)"
| pixPerWord temp |
pixPerWord := 32//self depth.
(aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue:
["If word-aligned, use on-the-fly difference"
+ ^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm
- ^ (BitBlt current toForm: self) copy: aRect from: otherLoc in: otherForm
fillColor: nil rule: 32].
"Otherwise, combine in a word-sized form and then compute difference"
temp := self copy: aRect.
temp copy: aRect from: otherLoc in: otherForm rule: 21.
+ ^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil
- ^ (BitBlt current toForm: temp) copy: aRect from: otherLoc in: nil
fillColor: (Bitmap with: 0) rule: 32
" Dumb example prints zero only when you move over the original rectangle...
| f diff | f := Form fromUser.
[Sensor anyButtonPressed] whileFalse:
[diff := f pixelCompare: f boundingBox
with: Display at: Sensor cursorPoint.
diff printString , ' ' displayAt: 0@0]
"!
Item was changed:
----- Method: Form>>pixelValueAt: (in category 'pixel access') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+ ^ (BitBlt bitPeekerFromForm: self) pixelAt: aPoint
- ^ (BitBlt current bitPeekerFromForm: self) pixelAt: aPoint
!
Item was changed:
----- Method: Form>>pixelValueAt:put: (in category 'pixel access') -----
pixelValueAt: aPoint put: pixelValue
"Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. "
+ (BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
- (BitBlt current bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
!
Item was changed:
----- Method: Form>>primCountBits (in category 'analyzing') -----
primCountBits
"Count the non-zero pixels of this form."
self depth > 8 ifTrue:
[^(self asFormOfDepth: 8) primCountBits].
+ ^ (BitBlt toForm: self)
- ^ (BitBlt current toForm: self)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: width@height);
combinationRule: 32;
copyBits!
Item was added:
+ ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') -----
+ primPixelValueAtX: x y: y
+ "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+
+ <primitive: 'primitivePixelValueAt' module:'PixelValuePeekPlugin'>
+ ^(BitBlt bitPeekerFromForm: self) pixelAtX: x y: y!
Item was changed:
----- Method: Form>>rectangleEnclosingPixelsNotOfColor: (in category 'analyzing') -----
rectangleEnclosingPixelsNotOfColor: aColor
"Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background."
| cm slice copyBlt countBlt top bottom newH left right |
"map the specified color to 1 and all others to 0"
cm := Bitmap new: (1 bitShift: (self depth min: 15)).
cm primFill: 1.
cm at: (aColor indexInMap: cm) put: 0.
"build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest"
slice := Form extent: width@1 depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: 1;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from top and bottom"
top := (0 to: height)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0]
ifNone: [^ 0@0 extent: 0@0].
bottom := (height - 1 to: top by: -1)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0].
"build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest"
newH := bottom - top + 1.
slice := Form extent: 1@newH depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: 1 height: newH;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from left and right"
left := (0 to: width)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
right := (width - 1 to: left by: -1)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
^ left@top corner: (right + 1)@(bottom + 1)
!
Item was changed:
----- Method: Form>>replaceColor:withColor: (in category 'image manipulation') -----
replaceColor: oldColor withColor: newColor
"Replace one color with another everywhere is this form"
| cm newInd target ff |
self depth = 32
ifTrue: [cm := (Color cachedColormapFrom: 16 to: 32) copy]
ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)).
1 to: cm size do: [:i | cm at: i put: i - 1]].
newInd := newColor pixelValueForDepth: self depth.
cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd.
target := newColor isTransparent
ifTrue: [ff := Form extent: self extent depth: depth.
ff fillWithColor: newColor. ff]
ifFalse: [self].
+ (BitBlt toForm: target)
- (BitBlt current toForm: target)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form paint;
destX: 0 destY: 0 width: width height: height;
colorMap: cm;
copyBits.
newColor = Color transparent
ifTrue: [target displayOn: self].!
Item was changed:
----- Method: Form>>rotateBy:centerAt: (in category 'scaling, rotation') -----
rotateBy: direction centerAt: aPoint
"Return a rotated copy of the receiver.
direction = #none, #right, #left, or #pi"
| newForm quad rot scale |
direction == #none ifTrue: [^ self].
scale := (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent .
newForm := self blankCopyOf: self boundingBox scaledBy: scale.
quad := self boundingBox innerCorners.
rot := #(right pi left) indexOf: direction.
+ (WarpBlt toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') -----
rotateBy: deg magnify: scale smoothing: cellSize
"Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
"rot is the destination form, big enough for any angle."
| side rot warp r1 pts bigSide |
side := 1 + self extent r asInteger.
bigSide := (side asPoint * scale) rounded.
rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
+ warp := (WarpBlt toForm: rot)
- 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 |
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@2 smoothing: 2) display].
f display
"!
Item was changed:
----- Method: Form>>smear:distance: (in category 'image manipulation') -----
smear: dir distance: dist
"Smear any black pixels in this form in the direction dir in Log N steps"
| skew bb |
+ bb := BitBlt destForm: self sourceForm: self fillColor: nil
- bb := BitBlt current destForm: self sourceForm: self fillColor: nil
combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox.
skew := 1.
[skew < dist] whileTrue:
[bb destOrigin: dir*skew; copyBits.
skew := skew+skew]!
Item was changed:
----- Method: Form>>tallyPixelValuesInRect:into: (in category 'analyzing') -----
tallyPixelValuesInRect: destRect into: valueTable
"Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self; "src must be given for color map ops"
sourceOrigin: 0@0;
tallyMap: valueTable;
combinationRule: 33;
destRect: destRect;
copyBits.
^ valueTable
"
Move a little rectangle around the screen and print its tallies...
| r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
[r := Sensor cursorPoint extent: 10@10.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
tallies := (Display copy: r) tallyPixelValues.
nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
thenCollect: [:i | (tallies at: i) -> (i-1)].
nonZero printString , ' ' displayAt: 0@0.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"!
Item was changed:
----- Method: Form>>xTallyPixelValue:orNot: (in category 'analyzing') -----
xTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by x-value.
Note that if not is true, then this will tally those different from pv."
| cm slice countBlt copyBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: 1@height.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: width-1) collect:
[:x |
copyBlt sourceOrigin: x@0; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: Form>>yTallyPixelValue:orNot: (in category 'analyzing') -----
yTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by y-value.
Note that if not is true, then this will tally those different from pv."
| cm slice copyBlt countBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: width@1.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: height-1) collect:
[:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: InfiniteForm>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') -----
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 destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm
- 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]]!
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'].
residuals := WordArray new: 3.
sosSeen := false.
self parseFirstMarker.
[sosSeen] whileFalse: [self parseNextMarker].
form := Form extent: (width @ height) depth: depth.
+ bb := BitBlt toForm: form.
- bb := BitBlt current 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 changed:
----- Method: PNGReadWriter>>copyPixelsGray: (in category 'pixel copies') -----
copyPixelsGray: y
"Handle non-interlaced grayscale color mode (colorType = 0)"
| base bits bytesLeft word |
bitsPerChannel = 16 ifTrue: [
"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
| blitter |
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
0 to: width - 1 do: [ :x |
blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ].
^self ].
"Just copy the bits"
"This Smalltalk version might be easier to understand than the others below."
base := y * (form width * bitsPerChannel + 31 // 32) + 1.
bits := form bits.
0 to: thisScanline size // 4 - 1 do: [ :i |
| ii |
ii := i * 4.
"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:)
is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
word :=
(((thisScanline at: ii + 1) * 256 +
(thisScanline at: ii + 2) * 256 +
(thisScanline at: ii + 3)) bitShift: 8) bitOr:
(thisScanline at: ii + 4).
bits at: base + i put: word ].
(bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [
word := 0.
thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii |
word := word * 256 + (thisScanline at: ii) ].
word := word bitShift: 8 * (4 - bytesLeft).
bits at: base + (thisScanline size // 4) put: word ].
"This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones"
"^self copyPixelsGrayWeirdBitBltHack: y ".
"It uses the following method:
PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y
""Handle non-interlaced black and white color mode (colorType = 0)
By Andreas Raab""
| source dest cmap |
source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
cmap := Smalltalk isLittleEndian
ifTrue:[ColorMap
shifts: #(-24 -8 8 24)
masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
(BitBlt toForm: dest)
sourceForm: source;
destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
colorMap: cmap;
combinationRule: 3;
copyBits."
"This interesting technique (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones"
"form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)".
"It uses the following method:
BitMap >> copyFromByteArray2: byteArray to: i
""This method should work with either byte orderings""
| myHack byteHack |
myHack := Form new hackBits: self.
byteHack := Form new hackBits: byteArray.
Smalltalk isLittleEndian ifTrue: [byteHack swapEndianness].
byteHack displayOn: myHack at: 0@i"!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') -----
copyPixelsGray: y at: startX by: incX
"Handle interlaced grayscale color mode (colorType = 0)"
| offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
bitsPerChannel = 16
ifTrue: [
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
startX to: width-1 by: incX do: [ :x |
b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1).
].
^ self
].
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8 ifTrue: [
startX to: width-1 by: incX do: [ :x | | w |
w := offset + (x>>2).
b := 3- (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
].
^ self
].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y
"Handle non-interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
0 to: width-1 do: [ :x |
i := (x << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
0 to: width-1 do: [ :x |
i := (x << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha:at:by: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y at: startX by: incX
"Handle interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') -----
copyPixelsIndexed: y at: startX by: incX
"Handle interlaced indexed color mode (colorType = 3)"
| offset bits pixPerByte shifts blitter pixel mask pixelNumber |
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x | | b w |
w := offset + (x>>2).
b := 3 - (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)].
^ self ].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') -----
nextPutGray: aForm
| myType peeker val |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
"stream position: 0."
aForm depth = 1 ifTrue:[myType := $4] ifFalse:[myType := $5].
self writeHeader: myType.
+ peeker := BitBlt bitPeekerFromForm: aForm.
- peeker := BitBlt current bitPeekerFromForm: aForm.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
val := peeker pixelAt: x@y.
stream nextPut: val.
]
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') -----
nextPutRGB: aForm
| myType peeker f shift mask |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
f := aForm.
depth < 16 ifTrue:[
f := aForm asFormOfDepth: 32.
depth := 32.
].
myType := $6.
"stream position: 0."
self writeHeader: myType.
depth = 32 ifTrue:[shift := 8. mask := 16rFF] ifFalse:[shift := 5. mask := 16r1F].
+ peeker := BitBlt bitPeekerFromForm: f.
- peeker := BitBlt current bitPeekerFromForm: f.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x | | p r g b |
p := peeker pixelAt: x@y.
b := p bitAnd: mask. p := p >> shift.
g := p bitAnd: mask. p := p >> shift.
r := p bitAnd: mask.
stream nextPut: r.
stream nextPut: g.
stream nextPut: b.
]
].
!
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 > 8 bits not supported in Squeak'].
stream binary.
form := ColorForm extent: cols@rows depth: depth.
form colors: nil.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
|val|
val := stream next.
poker pixelAt: x@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>>readPlainBW (in category 'reading') -----
readPlainBW
"plain BW"
| val form poker |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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'].
].
poker pixelAt: x@y put: (val asInteger).
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readPlainGray (in category 'reading') -----
readPlainGray
"plain gray"
| val form poker aux tokens |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
tokens := OrderedCollection new.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
aux := self getTokenPbm: tokens.
val := aux at: 1. tokens := aux at: 2.
poker pixelAt: x@y put: val.
]
].
^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 > 32 bits not supported in Squeak'].
form := Form extent: cols@rows depth: 32.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@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 > 32 bits not supported in Squeak'].
stream binary.
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@y put: val.
]
].
^form
!
Item was changed:
----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') -----
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 |
tabletScale := self tabletScaleFactor.
bitForm := Form extent: Display extent * cellSize depth: 1.
pen := Pen newOnForm: bitForm.
pen color: Color black.
+ warp := (WarpBlt toForm: Display)
- warp := (WarpBlt current toForm: Display)
sourceForm: bitForm;
colorMap: (bitForm colormapIfNeededFor: Display);
cellSize: cellSize;
combinationRule: Form over.
Display fillColor: Color white.
Display restoreAfter: [ | p r nibSize srcR startP dstR |
[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]]].
!
Item was changed:
----- Method: Pen>>print:withFont: (in category 'operations') -----
print: str withFont: font
"Print the given string in the given font at the current heading"
| lineStart scale wasDown |
scale := sourceForm width.
wasDown := penDown.
lineStart := location.
str do:
[:char |
char = Character cr ifTrue:
[self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
ifFalse:
[ | charStart pix rowStart form bb backgroundCode |
form := font characterFormAt: char.
backgroundCode := 1<< (form depth // 3 * 3) - 1.
charStart := location.
wasDown ifTrue: [
self up; turn: -90; go: font descent*scale; turn: 90; down.
0 to: form height-1 do:
[:y |
rowStart := location.
+ bb := BitBlt bitPeekerFromForm: form.
- bb := BitBlt current bitPeekerFromForm: form.
pix := RunArray newFrom:
((0 to: form width-1) collect: [:x | bb pixelAt: x@y]).
pix runs with: pix values do:
[:run :value |
value = backgroundCode
ifTrue: [self up; go: run*scale; down]
ifFalse: [self go: run*scale]].
self place: rowStart; up; turn: 90; go: scale; turn: -90; down].
].
self place: charStart; up; go: form width*scale; down].
].
wasDown ifFalse: [self up]
"
Display restoreAfter:
[Pen new squareNib: 2; color: Color red; turn: 45;
print: 'The owl and the pussycat went to sea
in a beautiful pea green boat.' withFont: TextStyle defaultFont]
"!
Item was changed:
----- Method: StrikeFont>>bonk:with: (in category 'emphasis') -----
bonk: glyphForm with: bonkForm
"Bonking means to run through the glyphs clearing out black pixels
between characters to prevent them from straying into an adjacent
character as a result of, eg, bolding or italicizing"
"Uses the bonkForm to erase at every character boundary in glyphs."
| bb offset x |
offset := bonkForm offset x.
+ bb := BitBlt toForm: glyphForm.
- bb := BitBlt current toForm: glyphForm.
bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox;
combinationRule: Form erase; destY: 0.
x := self xTable.
(x isMemberOf: SparseLargeTable) ifTrue: [
x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
] ifFalse: [
1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
].
!
Item was changed:
----- Method: StrikeFont>>displayLine:at: (in category 'displaying') -----
displayLine: aString at: aPoint
"Display the characters in aString, starting at position aPoint."
self characters: (1 to: aString size)
in: aString
displayAt: aPoint
clippedBy: Display boundingBox
rule: Form over
fillColor: nil
kernDelta: 0
+ on: (BitBlt toForm: Display).
- on: (BitBlt current toForm: Display).
!
Item was changed:
----- Method: WarpBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for WarpBlt"
+ ^self!
- ^Display defaultWarpBltClass!
Item was changed:
----- Method: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') -----
warpBitsSmoothing: n sourceMap: sourceMap
| deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps |
<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
"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 bitPeekerFromForm: sourceForm.
+ poker := BitBlt bitPokerToForm: destForm.
- 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]!
1
0
tim Rowledge uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tpr.204.mcz
==================== Summary ====================
Name: Graphics-tpr.204
Author: tpr
Time: 25 March 2013, 2:11:52.527 pm
UUID: 47bc1ef2-4bb2-4c04-8e9b-6cbe3adba133
Ancestors: Graphics-cbc.203
Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment
=============== Diff against Graphics-cbc.203 ===============
Item was changed:
----- Method: BitBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for BitBlt"
+ ^self!
- ^Display defaultBitBltClass!
Item was changed:
----- Method: ColorForm>>copy: (in category 'copying') -----
copy: aRect
"Return a new ColorForm containing the portion of the receiver delineated by aRect."
| newForm |
newForm := self species extent: aRect extent depth: depth.
+ ((BitBlt
- ((BitBlt current
destForm: newForm
sourceForm: self
fillColor: nil
combinationRule: Form over
destOrigin: 0@0
sourceOrigin: aRect origin
extent: aRect extent
clipRect: newForm boundingBox)
colorMap: nil) copyBits.
colors ifNotNil: [newForm colors: colors copy].
^ newForm
!
Item was changed:
----- Method: ColorForm>>pixelValueAt: (in category 'pixel accessing') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color."
"Details: To get the raw pixel value, be sure the peeker's colorMap is nil."
+ ^ (BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
- ^ (BitBlt current bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
!
Item was changed:
----- Method: ColorForm>>twoToneFromDisplay:backgroundColor: (in category 'color manipulation') -----
twoToneFromDisplay: aRectangle backgroundColor: bgColor
"Copy one-bit deep ColorForm from the Display using a color map that maps all colors except the background color to black. Used for caching the contents of inactive MVC windows."
| map |
(width = aRectangle width and: [height = aRectangle height])
ifFalse: [self setExtent: aRectangle extent depth: depth].
"make a color map mapping the background color
to zero and all other colors to one"
map := Bitmap new: (1 bitShift: (Display depth min: 9)).
1 to: map size do: [:i | map at: i put: 16rFFFFFFFF].
map at: (bgColor indexInMap: map) put: 0.
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
destOrigin: 0@0;
sourceForm: Display;
sourceRect: aRectangle;
combinationRule: Form over;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: DisplayMedium>>fillShape:fillColor:at: (in category 'coloring') -----
fillShape: aShapeForm fillColor: aColor at: location
"Fill a region corresponding to 1 bits in aShapeForm with aColor"
+ ((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor
- ((BitBlt current destForm: self sourceForm: aShapeForm fillColor: aColor
combinationRule: Form paint
destOrigin: location + aShapeForm offset sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits!
Item was changed:
----- Method: DisplayObject>>follow:while:bitsBehind:startingLoc: (in category 'displaying-Display') -----
follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc
"Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value."
| location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects |
location := loc.
rect1 := location extent: self extent.
save1 := initialBitsBehind.
+ save1Blt := BitBlt toForm: save1.
- save1Blt := BitBlt current toForm: save1.
buffer := Form extent: self extent*2 depth: Display depth. "Holds overlapping region"
+ bufferBlt := BitBlt toForm: buffer.
- bufferBlt := BitBlt current toForm: buffer.
Display deferUpdates: true.
self displayOn: Display at: location rule: Form paint.
Display deferUpdates: false; forceToScreen: (location extent: self extent).
[durationBlock value] whileTrue: [
newLoc := locationBlock value.
newLoc ~= location ifTrue: [
rect2 := newLoc extent: self extent.
bothRects := rect1 merge: rect2.
(rect1 intersects: rect2)
ifTrue: [ "when overlap, buffer background for both rectangles"
bufferBlt copyFrom: bothRects in: Display to: 0@0.
bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin.
"now buffer is clean background; get new bits for save1"
save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer.
self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint.
Display deferUpdates: true.
Display copy: bothRects from: 0@0 in: buffer rule: Form over.
Display deferUpdates: false; forceToScreen: bothRects]
ifFalse: [ "when no overlap, do the simple thing (both rects might be too big)"
Display deferUpdates: true.
Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over.
save1Blt copyFrom: rect2 in: Display to: 0@0.
self displayOn: Display at: newLoc rule: Form paint.
Display deferUpdates: false;
forceToScreen: (location extent: save1 extent);
forceToScreen: (newLoc extent: self extent)].
location := newLoc.
rect1 := rect2]].
^ save1 displayOn: Display at: location
!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) copyBits!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) colorMap: map) copyBits!
Item was changed:
----- Method: Form class>>dotOfSize: (in category 'instance creation') -----
dotOfSize: diameter
"Create a form which contains a round black dot."
| radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx |
radius := diameter//2.
form := self extent: diameter@diameter offset: (0@0) - (radius@radius).
+ bb := (BitBlt toForm: form)
- bb := (BitBlt current toForm: form)
sourceX: 0; sourceY: 0;
combinationRule: Form over;
fillColor: Color black.
rect := form boundingBox.
centerX := rect center x.
centerY := rect center y.
centerYBias := rect height odd ifTrue: [0] ifFalse: [1].
centerXBias := rect width odd ifTrue: [0] ifFalse: [1].
radiusSquared := (rect height asFloat / 2.0) squared - 0.01.
xOverY := rect width asFloat / rect height asFloat.
maxy := rect height - 1 // 2.
"First do the inner fill, and collect x values"
0 to: maxy do:
[:dy |
dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated.
bb destX: centerX - centerXBias - dx
destY: centerY - centerYBias - dy
width: dx + dx + centerXBias + 1
height: 1;
copyBits.
bb destY: centerY + dy;
copyBits].
^ form
"
Time millisecondsToRun:
[1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]]
"!
Item was changed:
----- Method: Form class>>toothpaste: (in category 'examples') -----
toothpaste: diam "Display restoreAfter: [Form toothpaste: 30]"
"Draws wormlike lines by laying down images of spheres.
See Ken Knowlton, Computer Graphics, vol. 15 no. 4 p352.
Draw with mouse button down; terminate by option-click."
| facade ball filter point queue port color q colors colr colr2 |
colors := Display depth = 1
ifTrue: [Array with: Color black]
ifFalse: [Color red wheel: 12].
facade := Form extent: diam@diam offset: (diam // -2) asPoint.
(Form dotOfSize: diam) displayOn: facade
at: (diam // 2) asPoint clippingBox: facade boundingBox
rule: Form under fillColor: Color white.
#(1 2 3) do:
[:x | "simulate facade by circles of gray"
(Form dotOfSize: x * diam // 5) displayOn: facade
at: (diam * 2 // 5) asPoint clippingBox: facade boundingBox
rule: Form under
fillColor: (Color perform:
(#(black gray lightGray) at: x)).
"facade displayAt: 50*x@50"].
ball := Form dotOfSize: diam.
color := 8.
+ [port := BitBlt toForm: Display.
- [port := BitBlt current toForm: Display.
"Expand 1-bit forms to any pixel depth"
port colorMap: (Bitmap with: 0 with: 16rFFFFFFFF).
queue := OrderedCollection new: 32.
16 timesRepeat: [queue addLast: -20 @ -20].
Sensor waitButton.
Sensor yellowButtonPressed ifTrue: [^ self].
filter := Sensor cursorPoint.
colr := colors atWrap: (color := color + 5). "choose increment relatively prime to colors size"
colr2 := colr alphaMixed: 0.3 with: Color white.
[Sensor redButtonPressed or: [queue size > 0]] whileTrue:
[filter := filter * 4 + Sensor cursorPoint // 5.
point := Sensor redButtonPressed
ifTrue: [filter] ifFalse: [-20 @ -20].
port copyForm: ball to: point rule: Form paint fillColor: colr.
(q := queue removeFirst) == nil ifTrue: [^ self]. "exit"
Display depth = 1
ifTrue: [port copyForm: facade to: q rule: Form erase]
ifFalse: [port copyForm: facade to: q rule: Form paint fillColor: colr2].
Sensor redButtonPressed ifTrue: [queue addLast: point]]] repeat.
!
Item was changed:
----- Method: Form>>asFormOfDepth: (in category 'converting') -----
asFormOfDepth: d
| newForm |
d = self depth ifTrue:[^self].
newForm := Form extent: self extent depth: d.
+ (BitBlt toForm: newForm)
- (BitBlt current toForm: newForm)
colorMap: (self colormapIfNeededFor: newForm);
copy: (self boundingBox)
from: 0@0 in: self
fillColor: nil rule: Form over.
"Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation."
(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
^newForm!
Item was changed:
----- Method: Form>>asGrayScale (in category 'converting') -----
asGrayScale
"Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)"
| f32 srcForm result map bb grays |
self depth = 32 ifFalse: [
f32 := Form extent: width@height depth: 32.
self displayOn: f32.
^ f32 asGrayScale].
self unhibernate.
srcForm := Form extent: (width * 4)@height depth: 8.
srcForm bits: bits.
result := ColorForm extent: width@height depth: 8.
map := Bitmap new: 256.
2 to: 256 do: [:i | map at: i put: i - 1].
map at: 1 put: 1. "map zero pixel values to near-black"
+ bb := (BitBlt toForm: result)
- bb := (BitBlt current toForm: result)
sourceForm: srcForm;
combinationRule: Form over;
colorMap: map.
0 to: width - 1 do: [:dstX |
bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height);
destOrigin: dstX@0;
copyBits].
"final BitBlt to zero-out pixels that were truely transparent in the original"
map := Bitmap new: 512.
map at: 1 put: 16rFF.
+ (BitBlt toForm: result)
- (BitBlt current toForm: result)
sourceForm: self;
sourceRect: self boundingBox;
destOrigin: 0@0;
combinationRule: Form erase;
colorMap: map;
copyBits.
grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0].
grays at: 1 put: Color transparent.
result colors: grays.
^ result
!
Item was changed:
----- Method: Form>>border:width:rule:fillColor: (in category 'bordering') -----
border: rect width: borderWidth rule: rule fillColor: fillColor
"Paint a border whose rectangular area is defined by rect. The
width of the border of each side is borderWidth. Uses fillColor for drawing
the border."
| blt |
+ blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor.
- blt := (BitBlt current toForm: self) combinationRule: rule; fillColor: fillColor.
blt sourceOrigin: 0@0.
blt destOrigin: rect origin.
blt width: rect width; height: borderWidth; copyBits.
blt destY: rect corner y - borderWidth; copyBits.
blt destY: rect origin y + borderWidth.
blt height: rect height - borderWidth - borderWidth; width:
borderWidth; copyBits.
blt destX: rect corner x - borderWidth; copyBits!
Item was changed:
----- Method: Form>>borderFormOfWidth:sharpCorners: (in category 'bordering') -----
borderFormOfWidth: borderWidth sharpCorners: sharpen
"Smear this form around and then subtract the original to produce
an outline. If sharpen is true, then cause right angles to be outlined
by right angles (takes an additional diagonal smears ANDed with both
horizontal and vertical smears)."
| smearForm bigForm smearPort all cornerForm cornerPort nbrs |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
bigForm := self deepCopy.
all := bigForm boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
sharpen ifTrue:
[cornerForm := Form extent: self extent.
+ cornerPort := BitBlt toForm: cornerForm].
- cornerPort := BitBlt current toForm: cornerForm].
nbrs := (0@0) fourNeighbors.
1 to: borderWidth do:
[:i | "Iterate to get several layers of 'skin'"
nbrs do:
[:d | "Smear the self in 4 directions to grow each layer of skin"
smearPort copyForm: bigForm to: d rule: Form under].
sharpen ifTrue:
["Special treatment to smear sharp corners"
nbrs with: ((2 to: 5) collect: [:i2 | nbrs atWrap: i2]) do:
[:d1 :d2 |
"Copy corner points diagonally"
cornerPort copyForm: bigForm to: d1+d2 rule: Form over.
"But only preserve if there were dots on either side"
cornerPort copyForm: bigForm to: d1+d1+d2 rule: Form and.
cornerPort copyForm: bigForm to: d1+d2+d2 rule: Form and.
smearPort copyForm: cornerForm to: 0@0 rule: Form under].
].
bigForm copy: all from: 0@0 in: smearForm rule: Form over.
].
"Now erase the original shape to obtain the outline"
bigForm copy: all from: 0@0 in: self rule: Form erase.
^ bigForm!
Item was changed:
----- Method: Form>>copy:from:in:rule: (in category 'copying') -----
copy: destRectangle from: sourcePt in: sourceForm rule: rule
"Make up a BitBlt table and copy the bits."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: destRectangle
from: sourcePt in: sourceForm
fillColor: nil rule: rule!
Item was changed:
----- Method: Form>>copyBits:at:translucent: (in category 'copying') -----
copyBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 30
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm
"Make up a BitBlt table and copy the bits."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map
"Make up a BitBlt table and copy the bits. Use a colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:colorMap: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map
"Make up a BitBlt table and copy the bits with the given colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: Form over
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: self boundingBox) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>displayInterpolatedIn:on: (in category 'displaying') -----
displayInterpolatedIn: aRectangle on: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine adjustedR |
self extent = aRectangle extent ifTrue:[^self displayOn: aForm at: aRectangle origin].
engine := Smalltalk at: #B3DRenderEngine
ifPresent: [:engineClass | (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aRectangle;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
"there seems to be a slight bug in B3D which the following adjusts for"
adjustedR := (aRectangle withRight: aRectangle right + 1) translateBy: 0@1.
engine viewport: adjustedR.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayInterpolatedOn: (in category 'displaying') -----
displayInterpolatedOn: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine
ifPresent:[:engineClass| (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
engine viewport: aForm boundingBox.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayResourceFormOn: (in category 'displaying') -----
displayResourceFormOn: aForm
"a special display method for blowing up resource thumbnails"
| engine tx cmap blitter |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine ifPresent:
[:engineClass | engineClass defaultForPlatformOn: aForm].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
tx := self asTexture.
+ (blitter := BitBlt toForm: tx)
- (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: (self 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 toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form and;
colorMap: (Color maskingMap: self depth);
warpBits.!
Item was changed:
----- Method: Form>>displayScaledOn: (in category 'displaying') -----
displayScaledOn: aForm
"Display the receiver on aForm, scaling if necessary.
Form fromUser displayScaledOn: Display.
"
self extent = aForm extent ifTrue:[^self displayOn: aForm].
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form paint;
cellSize: 2;
warpBits.!
Item was changed:
----- Method: Form>>drawLine:from:to:clippingBox:rule:fillColor: (in category 'displaying') -----
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm
"Refer to the comment in
DisplayMedium|drawLine:from:to:clippingBox:rule:mask:."
| dotSetter |
"set up an instance of BitBlt for display"
+ dotSetter := BitBlt
- dotSetter := BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: anInteger
destOrigin: beginPoint
sourceOrigin: 0 @ 0
extent: sourceForm extent
clipRect: clipRect.
dotSetter drawFrom: beginPoint to: endPoint!
Item was changed:
----- Method: Form>>eraseShape: (in category 'filling') -----
eraseShape: bwForm
"use bwForm as a mask to clear all pixels where bwForm has 1's"
+ ((BitBlt destForm: self sourceForm: bwForm
- ((BitBlt current destForm: self sourceForm: bwForm
fillColor: nil
combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask"
destOrigin: bwForm offset
sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits.
!
Item was changed:
----- Method: Form>>fill:rule:fillColor: (in category 'filling') -----
fill: aRectangle rule: anInteger fillColor: aForm
"Replace a rectangular area of the receiver with the pattern described by aForm
according to the rule anInteger."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: aRectangle
from: 0@0 in: nil
fillColor: aForm rule: anInteger!
Item was changed:
----- Method: Form>>fillFromXYColorBlock: (in category 'filling') -----
fillFromXYColorBlock: colorBlock
"General Gradient Fill.
Supply relative x and y in [0.0 ... 1.0] to colorBlock,
and paint each pixel with the color that comes back"
| poker yRel xRel |
+ poker := BitBlt bitPokerToForm: self.
- poker := BitBlt current bitPokerToForm: self.
0 to: height-1 do:
[:y | yRel := y asFloat / (height-1) asFloat.
0 to: width-1 do:
[:x | xRel := x asFloat / (width-1) asFloat.
poker pixelAt: x@y
put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]]
"
| d |
((Form extent: 100@20 depth: Display depth)
fillFromXYColorBlock:
[:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs.
Color r: d g: 0 b: 1.0-d]) display
"!
Item was changed:
----- Method: Form>>findShapeAroundSeedBlock: (in category 'filling') -----
findShapeAroundSeedBlock: seedBlock
"Build a shape that is black in any region marked by seedBlock.
SeedBlock will be supplied a form, in which to blacken various
pixels as 'seeds'. Then the seeds are smeared until
there is no change in the smear when it fills the region, ie,
when smearing hits a black border and thus goes no further."
| smearForm previousSmear all count smearPort |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
all := self boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
seedBlock value: smearForm. "Blacken seeds to be smeared"
smearPort copyForm: self to: 0 @ 0 rule: Form erase. "Clear any in black"
previousSmear := smearForm deepCopy.
count := 1.
[count = 10 and: "check for no change every 10 smears"
[count := 1.
previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse.
previousSmear isAllWhite]]
whileFalse:
[smearPort copyForm: smearForm to: 1 @ 0 rule: Form under.
smearPort copyForm: smearForm to: -1 @ 0 rule: Form under.
"After horiz smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
smearPort copyForm: smearForm to: 0 @ 1 rule: Form under.
smearPort copyForm: smearForm to: 0 @ -1 rule: Form under.
"After vert smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
count := count + 1.
count = 9 ifTrue: "Save penultimate smear for comparison"
[previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]].
"Now paint the filled region in me with aHalftone"
^ smearForm!
Item was changed:
----- Method: Form>>flipBy:centerAt: (in category 'scaling, rotation') -----
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.
- newForm := self species 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 toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>floodFill2:at: (in category 'filling') -----
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 bitPeekerFromForm: self.
+ poker := BitBlt bitPokerToForm: self.
- 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.
].
!
Item was changed:
----- Method: Form>>floodFill:at:tolerance: (in category 'filling') -----
floodFill: aColor at: interiorPoint tolerance: tolerance
"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 (ar): This variant has been heavily optimized to prevent the overhead of repeated calls to BitBlt. Usually this is a really big winner but the runtime now depends a bit on the complexity of the shape to be filled. For extremely complex shapes (say, a Hilbert curve) with very few pixels to fill it can be slower than #floodFill2:at: since it needs to repeatedly read the source bits. However, in all practical cases I found this variant to be 15-20 times faster than anything else.
Further note (di): I have added a feature that allows this routine to fill areas of approximately constant color (such as photos, scans, and jpegs). It does this by computing a color map for the peeker that maps all colors close to 'old' into colors identical to old. This mild colorblindness achieves the desired effect with no further change or degradation of the algorithm. tolerance should be 0 (exact match), or a value corresponding to those returned by Color>>diff:, with 0.1 being a reasonable starting choice."
| peeker poker stack old new x y top x1 x2 dy left goRight span spanBits w box debug |
debug := false. "set it to true to see the filling process"
box := interiorPoint extent: 1@1.
span := Form extent: width@1 depth: 32.
spanBits := span bits.
+ peeker := BitBlt toForm: span.
- peeker := BitBlt current toForm: span.
peeker
sourceForm: self;
combinationRule: 3;
width: width;
height: 1.
"read old pixel value"
peeker sourceOrigin: interiorPoint; destOrigin: interiorPoint x @ 0; width: 1; copyBits.
old := spanBits at: interiorPoint x + 1.
"compute new value (take care since the algorithm will fail if old = new)"
new := self privateFloodFillValue: aColor.
old = new ifTrue: [^ box].
tolerance > 0 ifTrue:
["Set up color map for approximate fills"
peeker colorMap: (self floodFillMapFrom: self to: span mappingColorsWithin: tolerance to: old)].
+ poker := BitBlt toForm: self.
- poker := BitBlt current toForm: self.
poker
fillColor: aColor;
combinationRule: 3;
width: width;
height: 1.
stack := OrderedCollection new: 50.
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:[
debug ifTrue:[self displayOn: Display].
top := stack removeLast.
y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4.
y := y + dy.
debug ifTrue:[
Display
drawLine: (Form extent: 1@1 depth: 8) fillWhite
from: (x1-1)@y to: (x2+1)@y
clippingBox: Display boundingBox
rule: Form over fillColor: nil].
"Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled.
Now explore adjacent pixels in scanline y."
peeker sourceOrigin: 0@y; destOrigin: 0@0; width: width; copyBits.
"Note: above is necessary since we don't know where we'll end up filling"
x := x1.
w := 0.
[x >= 0 and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x - 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: x+1@y; width: w; copyBits.
box := box quickMerge: ((x+1@y) extent: w@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:[
w := 0.
[x < width and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x + 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: (x-w)@y; width: w; copyBits.
box := box quickMerge: ((x-w@y) extent: w@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:[(spanBits at: x+1) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
^box!
Item was changed:
----- Method: Form>>magnify:by:smoothing: (in category 'scaling, rotation') -----
magnify: aRectangle by: scale smoothing: cellSize
"Answer a Form created as a scaling of the receiver.
Scale may be a Float or even a Point, and may be greater or less than 1.0."
| newForm |
newForm := self blankCopyOf: aRectangle scaledBy: scale.
+ (WarpBlt toForm: newForm)
- (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]]
"!
Item was changed:
----- Method: Form>>mapColor:to: (in category 'color mapping') -----
mapColor: oldColor to: newColor
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
map := (Color cachedColormapFrom: self depth to: self depth) copy.
map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth).
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>mapColors:to: (in category 'color mapping') -----
mapColors: oldColorBitsCollection to: newColorBits
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
self depth < 16
ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy]
ifFalse: [
"use maximum resolution color map"
"source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component"
map := Color computeRGBColormapFor: self depth bitsPerColor: 5].
oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits].
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>pageWarp:at:forward: (in category 'transitions') -----
pageWarp: otherImage at: topLeft forward: forward
"Produce a page-turning illusion that gradually reveals otherImage
located at topLeft in this form.
forward == true means turn pages toward you, else away. [ignored for now]"
| pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d |
pageRect := otherImage boundingBox.
oldPage := self copy: (pageRect translateBy: topLeft).
(forward ifTrue: [oldPage] ifFalse: [otherImage])
border: pageRect
widthRectangle: (Rectangle
left: 0
right: 2
top: 1
bottom: 1)
rule: Form over
fillColor: Color black.
oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))).
nSteps := 8.
buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth.
d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight.
1 to: nSteps-1 do:
[:i | forward
ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
p := pageRect topRight + (d * i // nSteps)]
ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over.
p := pageRect topRight + (d * (nSteps-i) // nSteps)].
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y).
sourceQuad := Array with: pageRect topLeft
with: pageRect bottomLeft + (0@p y)
with: pageRect bottomRight
with: pageRect topRight - (0@p y).
+ warp := (WarpBlt toForm: buffer)
- warp := (WarpBlt current toForm: buffer)
clipRect: leafRect;
sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]);
combinationRule: Form paint.
warp copyQuad: sourceQuad toRect: leafRect.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate].
buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate.
"
1 to: 4 do: [:corner | Display pageWarp:
(Form fromDisplay: (10@10 extent: 200@300)) reverse
at: 10@10 forward: false]
"
!
Item was changed:
----- Method: Form>>paintBits:at:translucent: (in category 'displaying') -----
paintBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt destForm: self
- (BitBlt current destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 31
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent.
f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>pixelCompare:with:at: (in category 'analyzing') -----
pixelCompare: aRect with: otherForm at: otherLoc
"Compare the selected bits of this form (those within aRect) against
those in a similar rectangle of otherFrom. Return the sum of the
absolute value of the differences of the color values of every pixel.
Obviously, this is most useful for rgb (16- or 32-bit) pixels but,
in the case of 8-bits or less, this will return the sum of the differing
bits of the corresponding pixel values (somewhat less useful)"
| pixPerWord temp |
pixPerWord := 32//self depth.
(aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue:
["If word-aligned, use on-the-fly difference"
+ ^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm
- ^ (BitBlt current toForm: self) copy: aRect from: otherLoc in: otherForm
fillColor: nil rule: 32].
"Otherwise, combine in a word-sized form and then compute difference"
temp := self copy: aRect.
temp copy: aRect from: otherLoc in: otherForm rule: 21.
+ ^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil
- ^ (BitBlt current toForm: temp) copy: aRect from: otherLoc in: nil
fillColor: (Bitmap with: 0) rule: 32
" Dumb example prints zero only when you move over the original rectangle...
| f diff | f := Form fromUser.
[Sensor anyButtonPressed] whileFalse:
[diff := f pixelCompare: f boundingBox
with: Display at: Sensor cursorPoint.
diff printString , ' ' displayAt: 0@0]
"!
Item was changed:
----- Method: Form>>pixelValueAt: (in category 'pixel access') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+ ^ (BitBlt bitPeekerFromForm: self) pixelAt: aPoint
- ^ (BitBlt current bitPeekerFromForm: self) pixelAt: aPoint
!
Item was changed:
----- Method: Form>>pixelValueAt:put: (in category 'pixel access') -----
pixelValueAt: aPoint put: pixelValue
"Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. "
+ (BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
- (BitBlt current bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
!
Item was changed:
----- Method: Form>>primCountBits (in category 'analyzing') -----
primCountBits
"Count the non-zero pixels of this form."
self depth > 8 ifTrue:
[^(self asFormOfDepth: 8) primCountBits].
+ ^ (BitBlt toForm: self)
- ^ (BitBlt current toForm: self)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: width@height);
combinationRule: 32;
copyBits!
Item was added:
+ ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') -----
+ primPixelValueAtX: x y: y
+ "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+
+ <primitive: 'primitivePixelValueAt' module:'PixelValuePeekPlugin'>
+ ^(BitBlt bitPeekerFromForm: self) pixelAtX: x y: y!
Item was changed:
----- Method: Form>>rectangleEnclosingPixelsNotOfColor: (in category 'analyzing') -----
rectangleEnclosingPixelsNotOfColor: aColor
"Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background."
| cm slice copyBlt countBlt top bottom newH left right |
"map the specified color to 1 and all others to 0"
cm := Bitmap new: (1 bitShift: (self depth min: 15)).
cm primFill: 1.
cm at: (aColor indexInMap: cm) put: 0.
"build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest"
slice := Form extent: width@1 depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: 1;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from top and bottom"
top := (0 to: height)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0]
ifNone: [^ 0@0 extent: 0@0].
bottom := (height - 1 to: top by: -1)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0].
"build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest"
newH := bottom - top + 1.
slice := Form extent: 1@newH depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: 1 height: newH;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from left and right"
left := (0 to: width)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
right := (width - 1 to: left by: -1)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
^ left@top corner: (right + 1)@(bottom + 1)
!
Item was changed:
----- Method: Form>>replaceColor:withColor: (in category 'image manipulation') -----
replaceColor: oldColor withColor: newColor
"Replace one color with another everywhere is this form"
| cm newInd target ff |
self depth = 32
ifTrue: [cm := (Color cachedColormapFrom: 16 to: 32) copy]
ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)).
1 to: cm size do: [:i | cm at: i put: i - 1]].
newInd := newColor pixelValueForDepth: self depth.
cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd.
target := newColor isTransparent
ifTrue: [ff := Form extent: self extent depth: depth.
ff fillWithColor: newColor. ff]
ifFalse: [self].
+ (BitBlt toForm: target)
- (BitBlt current toForm: target)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form paint;
destX: 0 destY: 0 width: width height: height;
colorMap: cm;
copyBits.
newColor = Color transparent
ifTrue: [target displayOn: self].!
Item was changed:
----- Method: Form>>rotateBy:centerAt: (in category 'scaling, rotation') -----
rotateBy: direction centerAt: aPoint
"Return a rotated copy of the receiver.
direction = #none, #right, #left, or #pi"
| newForm quad rot scale |
direction == #none ifTrue: [^ self].
scale := (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent .
newForm := self blankCopyOf: self boundingBox scaledBy: scale.
quad := self boundingBox innerCorners.
rot := #(right pi left) indexOf: direction.
+ (WarpBlt toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') -----
rotateBy: deg magnify: scale smoothing: cellSize
"Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
"rot is the destination form, big enough for any angle."
| side rot warp r1 pts bigSide |
side := 1 + self extent r asInteger.
bigSide := (side asPoint * scale) rounded.
rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
+ warp := (WarpBlt toForm: rot)
- 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 |
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@2 smoothing: 2) display].
f display
"!
Item was changed:
----- Method: Form>>smear:distance: (in category 'image manipulation') -----
smear: dir distance: dist
"Smear any black pixels in this form in the direction dir in Log N steps"
| skew bb |
+ bb := BitBlt destForm: self sourceForm: self fillColor: nil
- bb := BitBlt current destForm: self sourceForm: self fillColor: nil
combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox.
skew := 1.
[skew < dist] whileTrue:
[bb destOrigin: dir*skew; copyBits.
skew := skew+skew]!
Item was changed:
----- Method: Form>>tallyPixelValuesInRect:into: (in category 'analyzing') -----
tallyPixelValuesInRect: destRect into: valueTable
"Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self; "src must be given for color map ops"
sourceOrigin: 0@0;
tallyMap: valueTable;
combinationRule: 33;
destRect: destRect;
copyBits.
^ valueTable
"
Move a little rectangle around the screen and print its tallies...
| r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
[r := Sensor cursorPoint extent: 10@10.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
tallies := (Display copy: r) tallyPixelValues.
nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
thenCollect: [:i | (tallies at: i) -> (i-1)].
nonZero printString , ' ' displayAt: 0@0.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"!
Item was changed:
----- Method: Form>>xTallyPixelValue:orNot: (in category 'analyzing') -----
xTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by x-value.
Note that if not is true, then this will tally those different from pv."
| cm slice countBlt copyBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: 1@height.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: width-1) collect:
[:x |
copyBlt sourceOrigin: x@0; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: Form>>yTallyPixelValue:orNot: (in category 'analyzing') -----
yTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by y-value.
Note that if not is true, then this will tally those different from pv."
| cm slice copyBlt countBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: width@1.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: height-1) collect:
[:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: InfiniteForm>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') -----
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 destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm
- 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]]!
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'].
residuals := WordArray new: 3.
sosSeen := false.
self parseFirstMarker.
[sosSeen] whileFalse: [self parseNextMarker].
form := Form extent: (width @ height) depth: depth.
+ bb := BitBlt toForm: form.
- bb := BitBlt current 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 changed:
----- Method: PNGReadWriter>>copyPixelsGray: (in category 'pixel copies') -----
copyPixelsGray: y
"Handle non-interlaced grayscale color mode (colorType = 0)"
| base bits bytesLeft word |
bitsPerChannel = 16 ifTrue: [
"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
| blitter |
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
0 to: width - 1 do: [ :x |
blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ].
^self ].
"Just copy the bits"
"This Smalltalk version might be easier to understand than the others below."
base := y * (form width * bitsPerChannel + 31 // 32) + 1.
bits := form bits.
0 to: thisScanline size // 4 - 1 do: [ :i |
| ii |
ii := i * 4.
"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:)
is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
word :=
(((thisScanline at: ii + 1) * 256 +
(thisScanline at: ii + 2) * 256 +
(thisScanline at: ii + 3)) bitShift: 8) bitOr:
(thisScanline at: ii + 4).
bits at: base + i put: word ].
(bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [
word := 0.
thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii |
word := word * 256 + (thisScanline at: ii) ].
word := word bitShift: 8 * (4 - bytesLeft).
bits at: base + (thisScanline size // 4) put: word ].
"This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones"
"^self copyPixelsGrayWeirdBitBltHack: y ".
"It uses the following method:
PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y
""Handle non-interlaced black and white color mode (colorType = 0)
By Andreas Raab""
| source dest cmap |
source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
cmap := Smalltalk isLittleEndian
ifTrue:[ColorMap
shifts: #(-24 -8 8 24)
masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
(BitBlt toForm: dest)
sourceForm: source;
destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
colorMap: cmap;
combinationRule: 3;
copyBits."
"This interesting technique (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones"
"form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)".
"It uses the following method:
BitMap >> copyFromByteArray2: byteArray to: i
""This method should work with either byte orderings""
| myHack byteHack |
myHack := Form new hackBits: self.
byteHack := Form new hackBits: byteArray.
Smalltalk isLittleEndian ifTrue: [byteHack swapEndianness].
byteHack displayOn: myHack at: 0@i"!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') -----
copyPixelsGray: y at: startX by: incX
"Handle interlaced grayscale color mode (colorType = 0)"
| offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
bitsPerChannel = 16
ifTrue: [
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
startX to: width-1 by: incX do: [ :x |
b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1).
].
^ self
].
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8 ifTrue: [
startX to: width-1 by: incX do: [ :x | | w |
w := offset + (x>>2).
b := 3- (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
].
^ self
].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y
"Handle non-interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
0 to: width-1 do: [ :x |
i := (x << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
0 to: width-1 do: [ :x |
i := (x << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha:at:by: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y at: startX by: incX
"Handle interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') -----
copyPixelsIndexed: y at: startX by: incX
"Handle interlaced indexed color mode (colorType = 3)"
| offset bits pixPerByte shifts blitter pixel mask pixelNumber |
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x | | b w |
w := offset + (x>>2).
b := 3 - (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)].
^ self ].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') -----
nextPutGray: aForm
| myType peeker val |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
"stream position: 0."
aForm depth = 1 ifTrue:[myType := $4] ifFalse:[myType := $5].
self writeHeader: myType.
+ peeker := BitBlt bitPeekerFromForm: aForm.
- peeker := BitBlt current bitPeekerFromForm: aForm.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
val := peeker pixelAt: x@y.
stream nextPut: val.
]
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') -----
nextPutRGB: aForm
| myType peeker f shift mask |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
f := aForm.
depth < 16 ifTrue:[
f := aForm asFormOfDepth: 32.
depth := 32.
].
myType := $6.
"stream position: 0."
self writeHeader: myType.
depth = 32 ifTrue:[shift := 8. mask := 16rFF] ifFalse:[shift := 5. mask := 16r1F].
+ peeker := BitBlt bitPeekerFromForm: f.
- peeker := BitBlt current bitPeekerFromForm: f.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x | | p r g b |
p := peeker pixelAt: x@y.
b := p bitAnd: mask. p := p >> shift.
g := p bitAnd: mask. p := p >> shift.
r := p bitAnd: mask.
stream nextPut: r.
stream nextPut: g.
stream nextPut: b.
]
].
!
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 > 8 bits not supported in Squeak'].
stream binary.
form := ColorForm extent: cols@rows depth: depth.
form colors: nil.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
|val|
val := stream next.
poker pixelAt: x@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>>readPlainBW (in category 'reading') -----
readPlainBW
"plain BW"
| val form poker |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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'].
].
poker pixelAt: x@y put: (val asInteger).
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readPlainGray (in category 'reading') -----
readPlainGray
"plain gray"
| val form poker aux tokens |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
tokens := OrderedCollection new.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
aux := self getTokenPbm: tokens.
val := aux at: 1. tokens := aux at: 2.
poker pixelAt: x@y put: val.
]
].
^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 > 32 bits not supported in Squeak'].
form := Form extent: cols@rows depth: 32.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@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 > 32 bits not supported in Squeak'].
stream binary.
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@y put: val.
]
].
^form
!
Item was changed:
----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') -----
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 |
tabletScale := self tabletScaleFactor.
bitForm := Form extent: Display extent * cellSize depth: 1.
pen := Pen newOnForm: bitForm.
pen color: Color black.
+ warp := (WarpBlt toForm: Display)
- warp := (WarpBlt current toForm: Display)
sourceForm: bitForm;
colorMap: (bitForm colormapIfNeededFor: Display);
cellSize: cellSize;
combinationRule: Form over.
Display fillColor: Color white.
Display restoreAfter: [ | p r nibSize srcR startP dstR |
[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]]].
!
Item was changed:
----- Method: Pen>>print:withFont: (in category 'operations') -----
print: str withFont: font
"Print the given string in the given font at the current heading"
| lineStart scale wasDown |
scale := sourceForm width.
wasDown := penDown.
lineStart := location.
str do:
[:char |
char = Character cr ifTrue:
[self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
ifFalse:
[ | charStart pix rowStart form bb backgroundCode |
form := font characterFormAt: char.
backgroundCode := 1<< (form depth // 3 * 3) - 1.
charStart := location.
wasDown ifTrue: [
self up; turn: -90; go: font descent*scale; turn: 90; down.
0 to: form height-1 do:
[:y |
rowStart := location.
+ bb := BitBlt bitPeekerFromForm: form.
- bb := BitBlt current bitPeekerFromForm: form.
pix := RunArray newFrom:
((0 to: form width-1) collect: [:x | bb pixelAt: x@y]).
pix runs with: pix values do:
[:run :value |
value = backgroundCode
ifTrue: [self up; go: run*scale; down]
ifFalse: [self go: run*scale]].
self place: rowStart; up; turn: 90; go: scale; turn: -90; down].
].
self place: charStart; up; go: form width*scale; down].
].
wasDown ifFalse: [self up]
"
Display restoreAfter:
[Pen new squareNib: 2; color: Color red; turn: 45;
print: 'The owl and the pussycat went to sea
in a beautiful pea green boat.' withFont: TextStyle defaultFont]
"!
Item was changed:
----- Method: StrikeFont>>bonk:with: (in category 'emphasis') -----
bonk: glyphForm with: bonkForm
"Bonking means to run through the glyphs clearing out black pixels
between characters to prevent them from straying into an adjacent
character as a result of, eg, bolding or italicizing"
"Uses the bonkForm to erase at every character boundary in glyphs."
| bb offset x |
offset := bonkForm offset x.
+ bb := BitBlt toForm: glyphForm.
- bb := BitBlt current toForm: glyphForm.
bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox;
combinationRule: Form erase; destY: 0.
x := self xTable.
(x isMemberOf: SparseLargeTable) ifTrue: [
x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
] ifFalse: [
1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
].
!
Item was changed:
----- Method: StrikeFont>>displayLine:at: (in category 'displaying') -----
displayLine: aString at: aPoint
"Display the characters in aString, starting at position aPoint."
self characters: (1 to: aString size)
in: aString
displayAt: aPoint
clippedBy: Display boundingBox
rule: Form over
fillColor: nil
kernDelta: 0
+ on: (BitBlt toForm: Display).
- on: (BitBlt current toForm: Display).
!
Item was changed:
----- Method: WarpBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for WarpBlt"
+ ^self!
- ^Display defaultWarpBltClass!
Item was changed:
----- Method: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') -----
warpBitsSmoothing: n sourceMap: sourceMap
| deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps |
<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
"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 bitPeekerFromForm: sourceForm.
+ poker := BitBlt bitPokerToForm: destForm.
- 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]!
1
0
tim Rowledge uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-tpr.511.mcz
==================== Summary ====================
Name: Collections-tpr.511
Author: tpr
Time: 25 March 2013, 2:10:42.848 pm
UUID: 028a2dce-fd27-49ab-adc5-933eb24e0bdb
Ancestors: Collections-tpr.510
Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment
=============== Diff against Collections-nice.509 ===============
Item was changed:
----- Method: PositionableStream>>nextWordsInto: (in category 'accessing') -----
nextWordsInto: aBitmap
"Fill the word based buffer from my collection.
Stored on stream as Big Endian. Optimized for speed.
Read in BigEndian, then restoreEndianness."
| blt pos source byteSize |
collection class isBytes
ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1].
byteSize := aBitmap byteSize.
"is the test on collection basicSize \\ 4 necessary?"
((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
ifTrue: [source := collection.
pos := self position.
self skip: byteSize]
ifFalse: ["forced to copy it into a buffer"
source := self next: byteSize.
pos := 0].
"Now use BitBlt to copy the bytes to the bitmap."
+ blt := (BitBlt
- blt := (BitBlt current
toForm: (Form new hackBits: aBitmap))
sourceForm: (Form new hackBits: source).
blt combinationRule: Form over. "store"
blt sourceX: 0;
sourceY: pos // 4;
height: byteSize // 4;
width: 4.
blt destX: 0;
destY: 0.
blt copyBits.
"And do whatever the bitmap needs to do to convert from big-endian order."
aBitmap restoreEndianness.
^ aBitmap "May be WordArray, ColorArray, etc"
!
1
0
tim Rowledge uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-tpr.511.mcz
==================== Summary ====================
Name: Collections-tpr.511
Author: tpr
Time: 25 March 2013, 2:10:42.848 pm
UUID: 028a2dce-fd27-49ab-adc5-933eb24e0bdb
Ancestors: Collections-tpr.510
Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment
=============== Diff against Collections-nice.509 ===============
Item was changed:
----- Method: PositionableStream>>nextWordsInto: (in category 'accessing') -----
nextWordsInto: aBitmap
"Fill the word based buffer from my collection.
Stored on stream as Big Endian. Optimized for speed.
Read in BigEndian, then restoreEndianness."
| blt pos source byteSize |
collection class isBytes
ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1].
byteSize := aBitmap byteSize.
"is the test on collection basicSize \\ 4 necessary?"
((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
ifTrue: [source := collection.
pos := self position.
self skip: byteSize]
ifFalse: ["forced to copy it into a buffer"
source := self next: byteSize.
pos := 0].
"Now use BitBlt to copy the bytes to the bitmap."
+ blt := (BitBlt
- blt := (BitBlt current
toForm: (Form new hackBits: aBitmap))
sourceForm: (Form new hackBits: source).
blt combinationRule: Form over. "store"
blt sourceX: 0;
sourceY: pos // 4;
height: byteSize // 4;
width: 4.
blt destX: 0;
destY: 0.
blt copyBits.
"And do whatever the bitmap needs to do to convert from big-endian order."
aBitmap restoreEndianness.
^ aBitmap "May be WordArray, ColorArray, etc"
!
1
0
tim Rowledge uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-tpr.511.mcz
==================== Summary ====================
Name: Collections-tpr.511
Author: tpr
Time: 25 March 2013, 2:10:42.848 pm
UUID: 028a2dce-fd27-49ab-adc5-933eb24e0bdb
Ancestors: Collections-tpr.510
Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment
=============== Diff against Collections-nice.509 ===============
Item was changed:
----- Method: PositionableStream>>nextWordsInto: (in category 'accessing') -----
nextWordsInto: aBitmap
"Fill the word based buffer from my collection.
Stored on stream as Big Endian. Optimized for speed.
Read in BigEndian, then restoreEndianness."
| blt pos source byteSize |
collection class isBytes
ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1].
byteSize := aBitmap byteSize.
"is the test on collection basicSize \\ 4 necessary?"
((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
ifTrue: [source := collection.
pos := self position.
self skip: byteSize]
ifFalse: ["forced to copy it into a buffer"
source := self next: byteSize.
pos := 0].
"Now use BitBlt to copy the bytes to the bitmap."
+ blt := (BitBlt
- blt := (BitBlt current
toForm: (Form new hackBits: aBitmap))
sourceForm: (Form new hackBits: source).
blt combinationRule: Form over. "store"
blt sourceX: 0;
sourceY: pos // 4;
height: byteSize // 4;
width: 4.
blt destX: 0;
destY: 0.
blt copyBits.
"And do whatever the bitmap needs to do to convert from big-endian order."
aBitmap restoreEndianness.
^ aBitmap "May be WordArray, ColorArray, etc"
!
1
0
Bert Freudenberg uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-bf.534.mcz
==================== Summary ====================
Name: Monticello-bf.534
Author: bf
Time: 25 March 2013, 4:04:22.764 pm
UUID: c45273fb-83e7-4fa8-b8e7-6c12120c0c49
Ancestors: Monticello-nice.533, Monticello-cg.529
Merge Monticello-cg.529:
allow colons and slashes in a package's name (MCVersion generated an invalid filename for those).
Needed to be able to load monticello packages as written by ST/X. (Does not affect squeak/pharo operation, as those packages do not normally contain such characters)
=============== Diff against Monticello-nice.533 ===============
Item was changed:
----- Method: MCVersion>>fileName (in category 'accessing') -----
fileName
+ |rawName cookedName|
+
+ rawName := info name.
+ "care for invalid filename characters"
+ cookedName := rawName copy
+ replaceAll: $/ with: $_;
+ replaceAll: $: with: $_..
+ ^ (cookedName, '.', self writerClass extension) asMCVersionName!
- ^ (info name, '.', self writerClass extension) asMCVersionName!
1
0
Bert Freudenberg uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-bf.534.mcz
==================== Summary ====================
Name: Monticello-bf.534
Author: bf
Time: 25 March 2013, 4:04:22.764 pm
UUID: c45273fb-83e7-4fa8-b8e7-6c12120c0c49
Ancestors: Monticello-nice.533, Monticello-cg.529
Merge Monticello-cg.529:
allow colons and slashes in a package's name (MCVersion generated an invalid filename for those).
Needed to be able to load monticello packages as written by ST/X. (Does not affect squeak/pharo operation, as those packages do not normally contain such characters)
=============== Diff against Monticello-nice.533 ===============
Item was changed:
----- Method: MCVersion>>fileName (in category 'accessing') -----
fileName
+ |rawName cookedName|
+
+ rawName := info name.
+ "care for invalid filename characters"
+ cookedName := rawName copy
+ replaceAll: $/ with: $_;
+ replaceAll: $: with: $_..
+ ^ (cookedName, '.', self writerClass extension) asMCVersionName!
- ^ (info name, '.', self writerClass extension) asMCVersionName!
1
0
Bert Freudenberg uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-bf.534.mcz
==================== Summary ====================
Name: Monticello-bf.534
Author: bf
Time: 25 March 2013, 4:04:22.764 pm
UUID: c45273fb-83e7-4fa8-b8e7-6c12120c0c49
Ancestors: Monticello-nice.533, Monticello-cg.529
Merge Monticello-cg.529:
allow colons and slashes in a package's name (MCVersion generated an invalid filename for those).
Needed to be able to load monticello packages as written by ST/X. (Does not affect squeak/pharo operation, as those packages do not normally contain such characters)
=============== Diff against Monticello-nice.533 ===============
Item was changed:
----- Method: MCVersion>>fileName (in category 'accessing') -----
fileName
+ |rawName cookedName|
+
+ rawName := info name.
+ "care for invalid filename characters"
+ cookedName := rawName copy
+ replaceAll: $/ with: $_;
+ replaceAll: $: with: $_..
+ ^ (cookedName, '.', self writerClass extension) asMCVersionName!
- ^ (info name, '.', self writerClass extension) asMCVersionName!
1
0
tim Rowledge uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tpr.205.mcz
==================== Summary ====================
Name: Graphics-tpr.205
Author: tpr
Time: 23 March 2013, 10:32:54.898 pm
UUID: a16cf25b-36b7-4a5e-b3e9-3786b5f7c92d
Ancestors: Graphics-tpr.204
A somewhat involved pile of changes that I'm not 10% sure my use of MC has correctly caught; revert this if you find bugs!
For example, MC claims that AbstractFont is very different but visual inspection says not.
Get rid of the idiom 'BitBLt current'.
Add support for the pixelVaueAt: primitive
And yes, I had to try twice , again
=============== Diff against Graphics-cbc.203 ===============
Item was added:
+ (PackageInfo named: 'Graphics') postscriptOfRemoval: 'nil'!
Item was removed:
- ----- Method: AbstractFont>>displayStrikeoutOn:from:to: (in category 'displaying') -----
- displayStrikeoutOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
- "display the strikeout if appropriate for the receiver"!
Item was removed:
- ----- Method: AbstractFont>>displayUnderlineOn:from:to: (in category 'displaying') -----
- displayUnderlineOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
- "display the underline if appropriate for the receiver"!
Item was removed:
- ----- Method: AbstractFont>>emphasisString (in category 'accessing') -----
- emphasisString
- "Answer a translated string that represents the receiver's emphasis."
-
- ^self emphasisStringFor: self emphasis!
Item was removed:
- ----- Method: AbstractFont>>emphasisStringFor: (in category 'accessing') -----
- emphasisStringFor: emphasisCode
- "Answer a translated string that represents the attributes given in emphasisCode."
-
- ^self class emphasisStringFor: emphasisCode!
Item was removed:
- ----- Method: AbstractFont>>hasDistinctGlyphsForAll: (in category 'testing') -----
- hasDistinctGlyphsForAll: asciiString
- "Answer true if the receiver has glyphs for all the characters
- in asciiString and no single glyph is shared by more than one character, false otherwise.
- The default behaviour is to answer true, but subclasses may reimplement"
-
- ^true!
Item was removed:
- ----- Method: AbstractFont>>hasGlyphsForAll: (in category 'testing') -----
- hasGlyphsForAll: asciiString
- "Answer true if the receiver has glyphs for all the characters
- in asciiString, false otherwise.
- The default behaviour is to answer true, but subclasses may reimplement"
-
- ^true!
Item was removed:
- ----- Method: AbstractFont>>isSubPixelPositioned (in category 'testing') -----
- isSubPixelPositioned
- "Answer true if the receiver is currently using subpixel positioned
- glyphs, false otherwise. This affects how padded space sizes are calculated
- when composing text.
- Currently, only FreeTypeFonts are subPixelPositioned, and only when not
- Hinted"
-
- ^false !
Item was removed:
- ----- Method: AbstractFont>>isSymbolFont (in category 'testing') -----
- isSymbolFont
- "Answer true if the receiver is a Symbol font, false otherwise.
- The default is to answer false, subclasses can reimplement"
-
- ^false!
Item was removed:
- ----- Method: AbstractFont>>kerningLeft:right: (in category 'kerning') -----
- kerningLeft: leftChar right: rightChar
- ^0!
Item was removed:
- ----- Method: AbstractFont>>linearWidthOf: (in category 'measuring') -----
- linearWidthOf: aCharacter
- "This is the scaled, unrounded advance width."
- ^self widthOf: aCharacter!
Item was removed:
- ----- Method: AbstractFont>>widthAndKernedWidthOfLeft:right:into: (in category 'kerning') -----
- widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray
- "Set the first element of aTwoElementArray to the width of leftCharacter and
- the second element to the width of left character when kerned with
- rightCharacterOrNil. Answer aTwoElementArray"
- | w k |
- w := self widthOf: leftCharacter.
- rightCharacterOrNil isNil
- ifTrue:[
- aTwoElementArray
- at: 1 put: w;
- at: 2 put: w]
- ifFalse:[
- k := self kerningLeft: leftCharacter right: rightCharacterOrNil.
- aTwoElementArray
- at: 1 put: w;
- at: 2 put: w+k].
- ^aTwoElementArray
- !
Item was changed:
----- Method: BitBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for BitBlt"
+ ^self!
- ^Display defaultBitBltClass!
Item was removed:
- ----- Method: BitBlt>>combinationRule (in category 'accessing') -----
- combinationRule
- "Answer the receiver's combinationRule"
-
- ^combinationRule!
Item was changed:
----- Method: ColorForm>>copy: (in category 'copying') -----
copy: aRect
"Return a new ColorForm containing the portion of the receiver delineated by aRect."
| newForm |
newForm := self species extent: aRect extent depth: depth.
+ ((BitBlt
- ((BitBlt current
destForm: newForm
sourceForm: self
fillColor: nil
combinationRule: Form over
destOrigin: 0@0
sourceOrigin: aRect origin
extent: aRect extent
clipRect: newForm boundingBox)
colorMap: nil) copyBits.
colors ifNotNil: [newForm colors: colors copy].
^ newForm
!
Item was removed:
- ----- Method: ColorForm>>pixelValueAt: (in category 'pixel accessing') -----
- pixelValueAt: aPoint
- "Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color."
- "Details: To get the raw pixel value, be sure the peeker's colorMap is nil."
-
- ^ (BitBlt current bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
- !
Item was changed:
----- Method: ColorForm>>twoToneFromDisplay:backgroundColor: (in category 'color manipulation') -----
twoToneFromDisplay: aRectangle backgroundColor: bgColor
"Copy one-bit deep ColorForm from the Display using a color map that maps all colors except the background color to black. Used for caching the contents of inactive MVC windows."
| map |
(width = aRectangle width and: [height = aRectangle height])
ifFalse: [self setExtent: aRectangle extent depth: depth].
"make a color map mapping the background color
to zero and all other colors to one"
map := Bitmap new: (1 bitShift: (Display depth min: 9)).
1 to: map size do: [:i | map at: i put: 16rFFFFFFFF].
map at: (bgColor indexInMap: map) put: 0.
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
destOrigin: 0@0;
sourceForm: Display;
sourceRect: aRectangle;
combinationRule: Form over;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: DisplayMedium>>fillShape:fillColor:at: (in category 'coloring') -----
fillShape: aShapeForm fillColor: aColor at: location
"Fill a region corresponding to 1 bits in aShapeForm with aColor"
+ ((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor
- ((BitBlt current destForm: self sourceForm: aShapeForm fillColor: aColor
combinationRule: Form paint
destOrigin: location + aShapeForm offset sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits!
Item was changed:
----- Method: DisplayObject>>follow:while:bitsBehind:startingLoc: (in category 'displaying-Display') -----
follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc
"Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value."
| location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects |
location := loc.
rect1 := location extent: self extent.
save1 := initialBitsBehind.
+ save1Blt := BitBlt toForm: save1.
- save1Blt := BitBlt current toForm: save1.
buffer := Form extent: self extent*2 depth: Display depth. "Holds overlapping region"
+ bufferBlt := BitBlt toForm: buffer.
- bufferBlt := BitBlt current toForm: buffer.
Display deferUpdates: true.
self displayOn: Display at: location rule: Form paint.
Display deferUpdates: false; forceToScreen: (location extent: self extent).
[durationBlock value] whileTrue: [
newLoc := locationBlock value.
newLoc ~= location ifTrue: [
rect2 := newLoc extent: self extent.
bothRects := rect1 merge: rect2.
(rect1 intersects: rect2)
ifTrue: [ "when overlap, buffer background for both rectangles"
bufferBlt copyFrom: bothRects in: Display to: 0@0.
bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin.
"now buffer is clean background; get new bits for save1"
save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer.
self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint.
Display deferUpdates: true.
Display copy: bothRects from: 0@0 in: buffer rule: Form over.
Display deferUpdates: false; forceToScreen: bothRects]
ifFalse: [ "when no overlap, do the simple thing (both rects might be too big)"
Display deferUpdates: true.
Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over.
save1Blt copyFrom: rect2 in: Display to: 0@0.
self displayOn: Display at: newLoc rule: Form paint.
Display deferUpdates: false;
forceToScreen: (location extent: save1 extent);
forceToScreen: (newLoc extent: self extent)].
location := newLoc.
rect1 := rect2]].
^ save1 displayOn: Display at: location
!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) copyBits!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) colorMap: map) copyBits!
Item was removed:
- ----- Method: DisplayScreen>>defaultBitBltClass (in category 'blitter defaults') -----
- defaultBitBltClass
- "Return the BitBlt version to use when I am active"
- ^BitBlt!
Item was changed:
----- Method: Form class>>dotOfSize: (in category 'instance creation') -----
dotOfSize: diameter
"Create a form which contains a round black dot."
| radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx |
radius := diameter//2.
form := self extent: diameter@diameter offset: (0@0) - (radius@radius).
+ bb := (BitBlt toForm: form)
- bb := (BitBlt current toForm: form)
sourceX: 0; sourceY: 0;
combinationRule: Form over;
fillColor: Color black.
rect := form boundingBox.
centerX := rect center x.
centerY := rect center y.
centerYBias := rect height odd ifTrue: [0] ifFalse: [1].
centerXBias := rect width odd ifTrue: [0] ifFalse: [1].
radiusSquared := (rect height asFloat / 2.0) squared - 0.01.
xOverY := rect width asFloat / rect height asFloat.
maxy := rect height - 1 // 2.
"First do the inner fill, and collect x values"
0 to: maxy do:
[:dy |
dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated.
bb destX: centerX - centerXBias - dx
destY: centerY - centerYBias - dy
width: dx + dx + centerXBias + 1
height: 1;
copyBits.
bb destY: centerY + dy;
copyBits].
^ form
"
Time millisecondsToRun:
[1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]]
"!
Item was changed:
----- Method: Form class>>toothpaste: (in category 'examples') -----
toothpaste: diam "Display restoreAfter: [Form toothpaste: 30]"
"Draws wormlike lines by laying down images of spheres.
See Ken Knowlton, Computer Graphics, vol. 15 no. 4 p352.
Draw with mouse button down; terminate by option-click."
| facade ball filter point queue port color q colors colr colr2 |
colors := Display depth = 1
ifTrue: [Array with: Color black]
ifFalse: [Color red wheel: 12].
facade := Form extent: diam@diam offset: (diam // -2) asPoint.
(Form dotOfSize: diam) displayOn: facade
at: (diam // 2) asPoint clippingBox: facade boundingBox
rule: Form under fillColor: Color white.
#(1 2 3) do:
[:x | "simulate facade by circles of gray"
(Form dotOfSize: x * diam // 5) displayOn: facade
at: (diam * 2 // 5) asPoint clippingBox: facade boundingBox
rule: Form under
fillColor: (Color perform:
(#(black gray lightGray) at: x)).
"facade displayAt: 50*x@50"].
ball := Form dotOfSize: diam.
color := 8.
+ [port := BitBlt toForm: Display.
- [port := BitBlt current toForm: Display.
"Expand 1-bit forms to any pixel depth"
port colorMap: (Bitmap with: 0 with: 16rFFFFFFFF).
queue := OrderedCollection new: 32.
16 timesRepeat: [queue addLast: -20 @ -20].
Sensor waitButton.
Sensor yellowButtonPressed ifTrue: [^ self].
filter := Sensor cursorPoint.
colr := colors atWrap: (color := color + 5). "choose increment relatively prime to colors size"
colr2 := colr alphaMixed: 0.3 with: Color white.
[Sensor redButtonPressed or: [queue size > 0]] whileTrue:
[filter := filter * 4 + Sensor cursorPoint // 5.
point := Sensor redButtonPressed
ifTrue: [filter] ifFalse: [-20 @ -20].
port copyForm: ball to: point rule: Form paint fillColor: colr.
(q := queue removeFirst) == nil ifTrue: [^ self]. "exit"
Display depth = 1
ifTrue: [port copyForm: facade to: q rule: Form erase]
ifFalse: [port copyForm: facade to: q rule: Form paint fillColor: colr2].
Sensor redButtonPressed ifTrue: [queue addLast: point]]] repeat.
!
Item was changed:
----- Method: Form>>asFormOfDepth: (in category 'converting') -----
asFormOfDepth: d
| newForm |
d = self depth ifTrue:[^self].
newForm := Form extent: self extent depth: d.
+ (BitBlt toForm: newForm)
- (BitBlt current toForm: newForm)
colorMap: (self colormapIfNeededFor: newForm);
copy: (self boundingBox)
from: 0@0 in: self
fillColor: nil rule: Form over.
"Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation."
(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
^newForm!
Item was changed:
----- Method: Form>>asGrayScale (in category 'converting') -----
asGrayScale
"Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)"
| f32 srcForm result map bb grays |
self depth = 32 ifFalse: [
f32 := Form extent: width@height depth: 32.
self displayOn: f32.
^ f32 asGrayScale].
self unhibernate.
srcForm := Form extent: (width * 4)@height depth: 8.
srcForm bits: bits.
result := ColorForm extent: width@height depth: 8.
map := Bitmap new: 256.
2 to: 256 do: [:i | map at: i put: i - 1].
map at: 1 put: 1. "map zero pixel values to near-black"
+ bb := (BitBlt toForm: result)
- bb := (BitBlt current toForm: result)
sourceForm: srcForm;
combinationRule: Form over;
colorMap: map.
0 to: width - 1 do: [:dstX |
bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height);
destOrigin: dstX@0;
copyBits].
"final BitBlt to zero-out pixels that were truely transparent in the original"
map := Bitmap new: 512.
map at: 1 put: 16rFF.
+ (BitBlt toForm: result)
- (BitBlt current toForm: result)
sourceForm: self;
sourceRect: self boundingBox;
destOrigin: 0@0;
combinationRule: Form erase;
colorMap: map;
copyBits.
grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0].
grays at: 1 put: Color transparent.
result colors: grays.
^ result
!
Item was changed:
----- Method: Form>>border:width:rule:fillColor: (in category 'bordering') -----
border: rect width: borderWidth rule: rule fillColor: fillColor
"Paint a border whose rectangular area is defined by rect. The
width of the border of each side is borderWidth. Uses fillColor for drawing
the border."
| blt |
+ blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor.
- blt := (BitBlt current toForm: self) combinationRule: rule; fillColor: fillColor.
blt sourceOrigin: 0@0.
blt destOrigin: rect origin.
blt width: rect width; height: borderWidth; copyBits.
blt destY: rect corner y - borderWidth; copyBits.
blt destY: rect origin y + borderWidth.
blt height: rect height - borderWidth - borderWidth; width:
borderWidth; copyBits.
blt destX: rect corner x - borderWidth; copyBits!
Item was changed:
----- Method: Form>>borderFormOfWidth:sharpCorners: (in category 'bordering') -----
borderFormOfWidth: borderWidth sharpCorners: sharpen
"Smear this form around and then subtract the original to produce
an outline. If sharpen is true, then cause right angles to be outlined
by right angles (takes an additional diagonal smears ANDed with both
horizontal and vertical smears)."
| smearForm bigForm smearPort all cornerForm cornerPort nbrs |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
bigForm := self deepCopy.
all := bigForm boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
sharpen ifTrue:
[cornerForm := Form extent: self extent.
+ cornerPort := BitBlt toForm: cornerForm].
- cornerPort := BitBlt current toForm: cornerForm].
nbrs := (0@0) fourNeighbors.
1 to: borderWidth do:
[:i | "Iterate to get several layers of 'skin'"
nbrs do:
[:d | "Smear the self in 4 directions to grow each layer of skin"
smearPort copyForm: bigForm to: d rule: Form under].
sharpen ifTrue:
["Special treatment to smear sharp corners"
nbrs with: ((2 to: 5) collect: [:i2 | nbrs atWrap: i2]) do:
[:d1 :d2 |
"Copy corner points diagonally"
cornerPort copyForm: bigForm to: d1+d2 rule: Form over.
"But only preserve if there were dots on either side"
cornerPort copyForm: bigForm to: d1+d1+d2 rule: Form and.
cornerPort copyForm: bigForm to: d1+d2+d2 rule: Form and.
smearPort copyForm: cornerForm to: 0@0 rule: Form under].
].
bigForm copy: all from: 0@0 in: smearForm rule: Form over.
].
"Now erase the original shape to obtain the outline"
bigForm copy: all from: 0@0 in: self rule: Form erase.
^ bigForm!
Item was changed:
----- Method: Form>>copy:from:in:rule: (in category 'copying') -----
copy: destRectangle from: sourcePt in: sourceForm rule: rule
"Make up a BitBlt table and copy the bits."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: destRectangle
from: sourcePt in: sourceForm
fillColor: nil rule: rule!
Item was changed:
----- Method: Form>>copyBits:at:translucent: (in category 'copying') -----
copyBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 30
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm
"Make up a BitBlt table and copy the bits."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map
"Make up a BitBlt table and copy the bits. Use a colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:colorMap: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map
"Make up a BitBlt table and copy the bits with the given colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: Form over
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: self boundingBox) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>displayInterpolatedIn:on: (in category 'displaying') -----
displayInterpolatedIn: aRectangle on: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine adjustedR |
self extent = aRectangle extent ifTrue:[^self displayOn: aForm at: aRectangle origin].
engine := Smalltalk at: #B3DRenderEngine
ifPresent: [:engineClass | (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aRectangle;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
"there seems to be a slight bug in B3D which the following adjusts for"
adjustedR := (aRectangle withRight: aRectangle right + 1) translateBy: 0@1.
engine viewport: adjustedR.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayInterpolatedOn: (in category 'displaying') -----
displayInterpolatedOn: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine
ifPresent:[:engineClass| (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
engine viewport: aForm boundingBox.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayResourceFormOn: (in category 'displaying') -----
displayResourceFormOn: aForm
"a special display method for blowing up resource thumbnails"
| engine tx cmap blitter |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine ifPresent:
[:engineClass | engineClass defaultForPlatformOn: aForm].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
tx := self asTexture.
+ (blitter := BitBlt toForm: tx)
- (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: (self 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 toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form and;
colorMap: (Color maskingMap: self depth);
warpBits.!
Item was changed:
----- Method: Form>>displayScaledOn: (in category 'displaying') -----
displayScaledOn: aForm
"Display the receiver on aForm, scaling if necessary.
Form fromUser displayScaledOn: Display.
"
self extent = aForm extent ifTrue:[^self displayOn: aForm].
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form paint;
cellSize: 2;
warpBits.!
Item was changed:
----- Method: Form>>drawLine:from:to:clippingBox:rule:fillColor: (in category 'displaying') -----
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm
"Refer to the comment in
DisplayMedium|drawLine:from:to:clippingBox:rule:mask:."
| dotSetter |
"set up an instance of BitBlt for display"
+ dotSetter := BitBlt
- dotSetter := BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: anInteger
destOrigin: beginPoint
sourceOrigin: 0 @ 0
extent: sourceForm extent
clipRect: clipRect.
dotSetter drawFrom: beginPoint to: endPoint!
Item was changed:
----- Method: Form>>eraseShape: (in category 'filling') -----
eraseShape: bwForm
"use bwForm as a mask to clear all pixels where bwForm has 1's"
+ ((BitBlt destForm: self sourceForm: bwForm
- ((BitBlt current destForm: self sourceForm: bwForm
fillColor: nil
combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask"
destOrigin: bwForm offset
sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits.
!
Item was changed:
----- Method: Form>>fill:rule:fillColor: (in category 'filling') -----
fill: aRectangle rule: anInteger fillColor: aForm
"Replace a rectangular area of the receiver with the pattern described by aForm
according to the rule anInteger."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: aRectangle
from: 0@0 in: nil
fillColor: aForm rule: anInteger!
Item was changed:
----- Method: Form>>fillFromXYColorBlock: (in category 'filling') -----
fillFromXYColorBlock: colorBlock
"General Gradient Fill.
Supply relative x and y in [0.0 ... 1.0] to colorBlock,
and paint each pixel with the color that comes back"
| poker yRel xRel |
+ poker := BitBlt bitPokerToForm: self.
- poker := BitBlt current bitPokerToForm: self.
0 to: height-1 do:
[:y | yRel := y asFloat / (height-1) asFloat.
0 to: width-1 do:
[:x | xRel := x asFloat / (width-1) asFloat.
poker pixelAt: x@y
put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]]
"
| d |
((Form extent: 100@20 depth: Display depth)
fillFromXYColorBlock:
[:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs.
Color r: d g: 0 b: 1.0-d]) display
"!
Item was changed:
----- Method: Form>>findShapeAroundSeedBlock: (in category 'filling') -----
findShapeAroundSeedBlock: seedBlock
"Build a shape that is black in any region marked by seedBlock.
SeedBlock will be supplied a form, in which to blacken various
pixels as 'seeds'. Then the seeds are smeared until
there is no change in the smear when it fills the region, ie,
when smearing hits a black border and thus goes no further."
| smearForm previousSmear all count smearPort |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
all := self boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
seedBlock value: smearForm. "Blacken seeds to be smeared"
smearPort copyForm: self to: 0 @ 0 rule: Form erase. "Clear any in black"
previousSmear := smearForm deepCopy.
count := 1.
[count = 10 and: "check for no change every 10 smears"
[count := 1.
previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse.
previousSmear isAllWhite]]
whileFalse:
[smearPort copyForm: smearForm to: 1 @ 0 rule: Form under.
smearPort copyForm: smearForm to: -1 @ 0 rule: Form under.
"After horiz smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
smearPort copyForm: smearForm to: 0 @ 1 rule: Form under.
smearPort copyForm: smearForm to: 0 @ -1 rule: Form under.
"After vert smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
count := count + 1.
count = 9 ifTrue: "Save penultimate smear for comparison"
[previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]].
"Now paint the filled region in me with aHalftone"
^ smearForm!
Item was changed:
----- Method: Form>>flipBy:centerAt: (in category 'scaling, rotation') -----
flipBy: direction centerAt: aPoint
"Return a copy of the receiver flipped either #vertical or #horizontal."
| newForm quad |
newForm := self species 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 toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>floodFill2:at: (in category 'filling') -----
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."
+ | poker stack old new x y top x1 x2 dy left goRight |
+ poker := BitBlt bitPokerToForm: self.
- | 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 := self pixelAt: interiorPoint.
- 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:[(self pixelAt: x@y) = old]] whileTrue:[
- [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:[(self pixelAt: x@y) = old]] whileTrue:[
- [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:[(self pixelAt: x@y) ~= old]] whileTrue.
- [(x := x + 1) <= x2 and:[(peeker pixelAt: x@y) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
!
Item was changed:
----- Method: Form>>floodFill:at:tolerance: (in category 'filling') -----
floodFill: aColor at: interiorPoint tolerance: tolerance
"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 (ar): This variant has been heavily optimized to prevent the overhead of repeated calls to BitBlt. Usually this is a really big winner but the runtime now depends a bit on the complexity of the shape to be filled. For extremely complex shapes (say, a Hilbert curve) with very few pixels to fill it can be slower than #floodFill2:at: since it needs to repeatedly read the source bits. However, in all practical cases I found this variant to be 15-20 times faster than anything else.
Further note (di): I have added a feature that allows this routine to fill areas of approximately constant color (such as photos, scans, and jpegs). It does this by computing a color map for the peeker that maps all colors close to 'old' into colors identical to old. This mild colorblindness achieves the desired effect with no further change or degradation of the algorithm. tolerance should be 0 (exact match), or a value corresponding to those returned by Color>>diff:, with 0.1 being a reasonable starting choice."
| peeker poker stack old new x y top x1 x2 dy left goRight span spanBits w box debug |
debug := false. "set it to true to see the filling process"
box := interiorPoint extent: 1@1.
span := Form extent: width@1 depth: 32.
spanBits := span bits.
+ peeker := BitBlt toForm: span.
- peeker := BitBlt current toForm: span.
peeker
sourceForm: self;
combinationRule: 3;
width: width;
height: 1.
"read old pixel value"
peeker sourceOrigin: interiorPoint; destOrigin: interiorPoint x @ 0; width: 1; copyBits.
old := spanBits at: interiorPoint x + 1.
"compute new value (take care since the algorithm will fail if old = new)"
new := self privateFloodFillValue: aColor.
old = new ifTrue: [^ box].
tolerance > 0 ifTrue:
["Set up color map for approximate fills"
peeker colorMap: (self floodFillMapFrom: self to: span mappingColorsWithin: tolerance to: old)].
+ poker := BitBlt toForm: self.
- poker := BitBlt current toForm: self.
poker
fillColor: aColor;
combinationRule: 3;
width: width;
height: 1.
stack := OrderedCollection new: 50.
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:[
debug ifTrue:[self displayOn: Display].
top := stack removeLast.
y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4.
y := y + dy.
debug ifTrue:[
Display
drawLine: (Form extent: 1@1 depth: 8) fillWhite
from: (x1-1)@y to: (x2+1)@y
clippingBox: Display boundingBox
rule: Form over fillColor: nil].
"Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled.
Now explore adjacent pixels in scanline y."
peeker sourceOrigin: 0@y; destOrigin: 0@0; width: width; copyBits.
"Note: above is necessary since we don't know where we'll end up filling"
x := x1.
w := 0.
[x >= 0 and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x - 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: x+1@y; width: w; copyBits.
box := box quickMerge: ((x+1@y) extent: w@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:[
w := 0.
[x < width and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x + 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: (x-w)@y; width: w; copyBits.
box := box quickMerge: ((x-w@y) extent: w@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:[(spanBits at: x+1) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
^box!
Item was changed:
----- Method: Form>>magnify:by:smoothing: (in category 'scaling, rotation') -----
magnify: aRectangle by: scale smoothing: cellSize
"Answer a Form created as a scaling of the receiver.
Scale may be a Float or even a Point, and may be greater or less than 1.0."
| newForm |
newForm := self blankCopyOf: aRectangle scaledBy: scale.
+ (WarpBlt toForm: newForm)
- (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]]
"!
Item was changed:
----- Method: Form>>mapColor:to: (in category 'color mapping') -----
mapColor: oldColor to: newColor
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
map := (Color cachedColormapFrom: self depth to: self depth) copy.
map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth).
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>mapColors:to: (in category 'color mapping') -----
mapColors: oldColorBitsCollection to: newColorBits
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
self depth < 16
ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy]
ifFalse: [
"use maximum resolution color map"
"source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component"
map := Color computeRGBColormapFor: self depth bitsPerColor: 5].
oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits].
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>pageWarp:at:forward: (in category 'transitions') -----
pageWarp: otherImage at: topLeft forward: forward
"Produce a page-turning illusion that gradually reveals otherImage
located at topLeft in this form.
forward == true means turn pages toward you, else away. [ignored for now]"
| pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d |
pageRect := otherImage boundingBox.
oldPage := self copy: (pageRect translateBy: topLeft).
(forward ifTrue: [oldPage] ifFalse: [otherImage])
border: pageRect
widthRectangle: (Rectangle
left: 0
right: 2
top: 1
bottom: 1)
rule: Form over
fillColor: Color black.
oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))).
nSteps := 8.
buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth.
d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight.
1 to: nSteps-1 do:
[:i | forward
ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
p := pageRect topRight + (d * i // nSteps)]
ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over.
p := pageRect topRight + (d * (nSteps-i) // nSteps)].
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y).
sourceQuad := Array with: pageRect topLeft
with: pageRect bottomLeft + (0@p y)
with: pageRect bottomRight
with: pageRect topRight - (0@p y).
+ warp := (WarpBlt toForm: buffer)
- warp := (WarpBlt current toForm: buffer)
clipRect: leafRect;
sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]);
combinationRule: Form paint.
warp copyQuad: sourceQuad toRect: leafRect.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate].
buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate.
"
1 to: 4 do: [:corner | Display pageWarp:
(Form fromDisplay: (10@10 extent: 200@300)) reverse
at: 10@10 forward: false]
"
!
Item was changed:
----- Method: Form>>paintBits:at:translucent: (in category 'displaying') -----
paintBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt destForm: self
- (BitBlt current destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 31
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent.
f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>pixelCompare:with:at: (in category 'analyzing') -----
pixelCompare: aRect with: otherForm at: otherLoc
"Compare the selected bits of this form (those within aRect) against
those in a similar rectangle of otherFrom. Return the sum of the
absolute value of the differences of the color values of every pixel.
Obviously, this is most useful for rgb (16- or 32-bit) pixels but,
in the case of 8-bits or less, this will return the sum of the differing
bits of the corresponding pixel values (somewhat less useful)"
| pixPerWord temp |
pixPerWord := 32//self depth.
(aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue:
["If word-aligned, use on-the-fly difference"
+ ^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm
- ^ (BitBlt current toForm: self) copy: aRect from: otherLoc in: otherForm
fillColor: nil rule: 32].
"Otherwise, combine in a word-sized form and then compute difference"
temp := self copy: aRect.
temp copy: aRect from: otherLoc in: otherForm rule: 21.
+ ^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil
- ^ (BitBlt current toForm: temp) copy: aRect from: otherLoc in: nil
fillColor: (Bitmap with: 0) rule: 32
" Dumb example prints zero only when you move over the original rectangle...
| f diff | f := Form fromUser.
[Sensor anyButtonPressed] whileFalse:
[diff := f pixelCompare: f boundingBox
with: Display at: Sensor cursorPoint.
diff printString , ' ' displayAt: 0@0]
"!
Item was changed:
----- Method: Form>>pixelValueAt: (in category 'pixel access') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+ ^ self primPixelValueAtX: aPoint x y: aPoint y!
- ^ (BitBlt current bitPeekerFromForm: self) pixelAt: aPoint
- !
Item was changed:
----- Method: Form>>pixelValueAt:put: (in category 'pixel access') -----
pixelValueAt: aPoint put: pixelValue
"Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. "
+ (BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
- (BitBlt current bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
!
Item was changed:
----- Method: Form>>primCountBits (in category 'analyzing') -----
primCountBits
"Count the non-zero pixels of this form."
self depth > 8 ifTrue:
[^(self asFormOfDepth: 8) primCountBits].
+ ^ (BitBlt toForm: self)
- ^ (BitBlt current toForm: self)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: width@height);
combinationRule: 32;
copyBits!
Item was added:
+ ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') -----
+ primPixelValueAtX: x y: y
+ "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. Make sure the colorMap is nil for ColorForms "
+
+ <primitive: 'primitivePixelValueAt' module:'BitBltPlugin'>
+ ^(BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: x@y!
Item was changed:
----- Method: Form>>rectangleEnclosingPixelsNotOfColor: (in category 'analyzing') -----
rectangleEnclosingPixelsNotOfColor: aColor
"Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background."
| cm slice copyBlt countBlt top bottom newH left right |
"map the specified color to 1 and all others to 0"
cm := Bitmap new: (1 bitShift: (self depth min: 15)).
cm primFill: 1.
cm at: (aColor indexInMap: cm) put: 0.
"build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest"
slice := Form extent: width@1 depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: 1;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from top and bottom"
top := (0 to: height)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0]
ifNone: [^ 0@0 extent: 0@0].
bottom := (height - 1 to: top by: -1)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0].
"build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest"
newH := bottom - top + 1.
slice := Form extent: 1@newH depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: 1 height: newH;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from left and right"
left := (0 to: width)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
right := (width - 1 to: left by: -1)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
^ left@top corner: (right + 1)@(bottom + 1)
!
Item was changed:
----- Method: Form>>replaceColor:withColor: (in category 'image manipulation') -----
replaceColor: oldColor withColor: newColor
"Replace one color with another everywhere is this form"
| cm newInd target ff |
self depth = 32
ifTrue: [cm := (Color cachedColormapFrom: 16 to: 32) copy]
ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)).
1 to: cm size do: [:i | cm at: i put: i - 1]].
newInd := newColor pixelValueForDepth: self depth.
cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd.
target := newColor isTransparent
ifTrue: [ff := Form extent: self extent depth: depth.
ff fillWithColor: newColor. ff]
ifFalse: [self].
+ (BitBlt toForm: target)
- (BitBlt current toForm: target)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form paint;
destX: 0 destY: 0 width: width height: height;
colorMap: cm;
copyBits.
newColor = Color transparent
ifTrue: [target displayOn: self].!
Item was changed:
----- Method: Form>>rotateBy:centerAt: (in category 'scaling, rotation') -----
rotateBy: direction centerAt: aPoint
"Return a rotated copy of the receiver.
direction = #none, #right, #left, or #pi"
| newForm quad rot scale |
direction == #none ifTrue: [^ self].
scale := (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent .
newForm := self blankCopyOf: self boundingBox scaledBy: scale.
quad := self boundingBox innerCorners.
rot := #(right pi left) indexOf: direction.
+ (WarpBlt toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') -----
rotateBy: deg magnify: scale smoothing: cellSize
"Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
"rot is the destination form, big enough for any angle."
| side rot warp r1 pts bigSide |
side := 1 + self extent r asInteger.
bigSide := (side asPoint * scale) rounded.
rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
+ warp := (WarpBlt toForm: rot)
- 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 |
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@2 smoothing: 2) display].
f display
"!
Item was changed:
----- Method: Form>>smear:distance: (in category 'image manipulation') -----
smear: dir distance: dist
"Smear any black pixels in this form in the direction dir in Log N steps"
| skew bb |
+ bb := BitBlt destForm: self sourceForm: self fillColor: nil
- bb := BitBlt current destForm: self sourceForm: self fillColor: nil
combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox.
skew := 1.
[skew < dist] whileTrue:
[bb destOrigin: dir*skew; copyBits.
skew := skew+skew]!
Item was changed:
----- Method: Form>>tallyPixelValuesInRect:into: (in category 'analyzing') -----
tallyPixelValuesInRect: destRect into: valueTable
"Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self; "src must be given for color map ops"
sourceOrigin: 0@0;
tallyMap: valueTable;
combinationRule: 33;
destRect: destRect;
copyBits.
^ valueTable
"
Move a little rectangle around the screen and print its tallies...
| r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
[r := Sensor cursorPoint extent: 10@10.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
tallies := (Display copy: r) tallyPixelValues.
nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
thenCollect: [:i | (tallies at: i) -> (i-1)].
nonZero printString , ' ' displayAt: 0@0.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"!
Item was changed:
----- Method: Form>>xTallyPixelValue:orNot: (in category 'analyzing') -----
xTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by x-value.
Note that if not is true, then this will tally those different from pv."
| cm slice countBlt copyBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: 1@height.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: width-1) collect:
[:x |
copyBlt sourceOrigin: x@0; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: Form>>yTallyPixelValue:orNot: (in category 'analyzing') -----
yTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by y-value.
Note that if not is true, then this will tally those different from pv."
| cm slice copyBlt countBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: width@1.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: height-1) collect:
[:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: InfiniteForm>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') -----
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 destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm
- 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]]!
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'].
residuals := WordArray new: 3.
sosSeen := false.
self parseFirstMarker.
[sosSeen] whileFalse: [self parseNextMarker].
form := Form extent: (width @ height) depth: depth.
+ bb := BitBlt toForm: form.
- bb := BitBlt current 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 changed:
----- Method: PNGReadWriter>>copyPixelsGray: (in category 'pixel copies') -----
copyPixelsGray: y
"Handle non-interlaced grayscale color mode (colorType = 0)"
| base bits bytesLeft word |
bitsPerChannel = 16 ifTrue: [
"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
| blitter |
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
0 to: width - 1 do: [ :x |
blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ].
^self ].
"Just copy the bits"
"This Smalltalk version might be easier to understand than the others below."
base := y * (form width * bitsPerChannel + 31 // 32) + 1.
bits := form bits.
0 to: thisScanline size // 4 - 1 do: [ :i |
| ii |
ii := i * 4.
"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:)
is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
word :=
(((thisScanline at: ii + 1) * 256 +
(thisScanline at: ii + 2) * 256 +
(thisScanline at: ii + 3)) bitShift: 8) bitOr:
(thisScanline at: ii + 4).
bits at: base + i put: word ].
(bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [
word := 0.
thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii |
word := word * 256 + (thisScanline at: ii) ].
word := word bitShift: 8 * (4 - bytesLeft).
bits at: base + (thisScanline size // 4) put: word ].
"This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones"
"^self copyPixelsGrayWeirdBitBltHack: y ".
"It uses the following method:
PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y
""Handle non-interlaced black and white color mode (colorType = 0)
By Andreas Raab""
| source dest cmap |
source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
cmap := Smalltalk isLittleEndian
ifTrue:[ColorMap
shifts: #(-24 -8 8 24)
masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
(BitBlt toForm: dest)
sourceForm: source;
destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
colorMap: cmap;
combinationRule: 3;
copyBits."
"This interesting technique (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones"
"form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)".
"It uses the following method:
BitMap >> copyFromByteArray2: byteArray to: i
""This method should work with either byte orderings""
| myHack byteHack |
myHack := Form new hackBits: self.
byteHack := Form new hackBits: byteArray.
Smalltalk isLittleEndian ifTrue: [byteHack swapEndianness].
byteHack displayOn: myHack at: 0@i"!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') -----
copyPixelsGray: y at: startX by: incX
"Handle interlaced grayscale color mode (colorType = 0)"
| offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
bitsPerChannel = 16
ifTrue: [
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
startX to: width-1 by: incX do: [ :x |
b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1).
].
^ self
].
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8 ifTrue: [
startX to: width-1 by: incX do: [ :x | | w |
w := offset + (x>>2).
b := 3- (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
].
^ self
].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y
"Handle non-interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
0 to: width-1 do: [ :x |
i := (x << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
0 to: width-1 do: [ :x |
i := (x << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha:at:by: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y at: startX by: incX
"Handle interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') -----
copyPixelsIndexed: y at: startX by: incX
"Handle interlaced indexed color mode (colorType = 3)"
| offset bits pixPerByte shifts blitter pixel mask pixelNumber |
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x | | b w |
w := offset + (x>>2).
b := 3 - (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)].
^ self ].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') -----
nextPutGray: aForm
+ | myType val |
- | myType peeker val |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
"stream position: 0."
aForm depth = 1 ifTrue:[myType := $4] ifFalse:[myType := $5].
self writeHeader: myType.
- peeker := BitBlt current bitPeekerFromForm: aForm.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
+ val := aForm pixelAt: x@y.
- val := peeker pixelAt: x@y.
stream nextPut: val.
]
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') -----
nextPutRGB: aForm
+ | myType f shift mask |
- | myType peeker f shift mask |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
f := aForm.
depth < 16 ifTrue:[
f := aForm asFormOfDepth: 32.
depth := 32.
].
myType := $6.
"stream position: 0."
self writeHeader: myType.
depth = 32 ifTrue:[shift := 8. mask := 16rFF] ifFalse:[shift := 5. mask := 16r1F].
- peeker := BitBlt current bitPeekerFromForm: f.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x | | p r g b |
+ p := f pixelAt: x@y.
- p := peeker pixelAt: x@y.
b := p bitAnd: mask. p := p >> shift.
g := p bitAnd: mask. p := p >> shift.
r := p bitAnd: mask.
stream nextPut: r.
stream nextPut: g.
stream nextPut: b.
]
].
!
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 > 8 bits not supported in Squeak'].
stream binary.
form := ColorForm extent: cols@rows depth: depth.
form colors: nil.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
|val|
val := stream next.
poker pixelAt: x@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>>readPlainBW (in category 'reading') -----
readPlainBW
"plain BW"
| val form poker |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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'].
].
poker pixelAt: x@y put: (val asInteger).
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readPlainGray (in category 'reading') -----
readPlainGray
"plain gray"
| val form poker aux tokens |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
tokens := OrderedCollection new.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
aux := self getTokenPbm: tokens.
val := aux at: 1. tokens := aux at: 2.
poker pixelAt: x@y put: val.
]
].
^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 > 32 bits not supported in Squeak'].
form := Form extent: cols@rows depth: 32.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@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 > 32 bits not supported in Squeak'].
stream binary.
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@y put: val.
]
].
^form
!
Item was changed:
----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') -----
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 |
tabletScale := self tabletScaleFactor.
bitForm := Form extent: Display extent * cellSize depth: 1.
pen := Pen newOnForm: bitForm.
pen color: Color black.
+ warp := (WarpBlt toForm: Display)
- warp := (WarpBlt current toForm: Display)
sourceForm: bitForm;
colorMap: (bitForm colormapIfNeededFor: Display);
cellSize: cellSize;
combinationRule: Form over.
Display fillColor: Color white.
Display restoreAfter: [ | p r nibSize srcR startP dstR |
[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]]].
!
Item was changed:
----- Method: Pen>>print:withFont: (in category 'operations') -----
print: str withFont: font
"Print the given string in the given font at the current heading"
| lineStart scale wasDown |
scale := sourceForm width.
wasDown := penDown.
lineStart := location.
str do:
[:char |
char = Character cr ifTrue:
[self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
ifFalse:
+ [ | charStart pix rowStart form backgroundCode |
- [ | charStart pix rowStart form bb backgroundCode |
form := font characterFormAt: char.
backgroundCode := 1<< (form depth // 3 * 3) - 1.
charStart := location.
wasDown ifTrue: [
self up; turn: -90; go: font descent*scale; turn: 90; down.
0 to: form height-1 do:
[:y |
rowStart := location.
- bb := BitBlt current bitPeekerFromForm: form.
pix := RunArray newFrom:
+ ((0 to: form width-1) collect: [:x | form pixelAt: x@y]).
- ((0 to: form width-1) collect: [:x | bb pixelAt: x@y]).
pix runs with: pix values do:
[:run :value |
value = backgroundCode
ifTrue: [self up; go: run*scale; down]
ifFalse: [self go: run*scale]].
self place: rowStart; up; turn: 90; go: scale; turn: -90; down].
].
self place: charStart; up; go: form width*scale; down].
].
wasDown ifFalse: [self up]
"
Display restoreAfter:
[Pen new squareNib: 2; color: Color red; turn: 45;
print: 'The owl and the pussycat went to sea
in a beautiful pea green boat.' withFont: TextStyle defaultFont]
"!
Item was changed:
----- Method: StrikeFont>>bonk:with: (in category 'emphasis') -----
bonk: glyphForm with: bonkForm
"Bonking means to run through the glyphs clearing out black pixels
between characters to prevent them from straying into an adjacent
character as a result of, eg, bolding or italicizing"
"Uses the bonkForm to erase at every character boundary in glyphs."
| bb offset x |
offset := bonkForm offset x.
+ bb := BitBlt toForm: glyphForm.
- bb := BitBlt current toForm: glyphForm.
bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox;
combinationRule: Form erase; destY: 0.
x := self xTable.
(x isMemberOf: SparseLargeTable) ifTrue: [
x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
] ifFalse: [
1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
].
!
Item was changed:
----- Method: StrikeFont>>displayLine:at: (in category 'displaying') -----
displayLine: aString at: aPoint
"Display the characters in aString, starting at position aPoint."
self characters: (1 to: aString size)
in: aString
displayAt: aPoint
clippedBy: Display boundingBox
rule: Form over
fillColor: nil
kernDelta: 0
+ on: (BitBlt toForm: Display).
- on: (BitBlt current toForm: Display).
!
Item was removed:
- ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') -----
- justifiedPadFor: spaceIndex font: aFont
- "Compute the width of pad for a given space in a line of justified text."
-
- | pad |
- internalSpaces = 0 ifTrue: [^0].
- ^(aFont notNil and:[aFont isSubPixelPositioned])
- ifTrue:[paddingWidth * 1.0 / internalSpaces]
- ifFalse:[
- pad := paddingWidth // internalSpaces.
- spaceIndex <= (paddingWidth \\ internalSpaces)
- ifTrue: [pad + 1]
- ifFalse: [pad]]!
Item was changed:
----- Method: WarpBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for WarpBlt"
+ ^self!
- ^Display defaultWarpBltClass!
Item was changed:
----- Method: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') -----
warpBitsSmoothing: n sourceMap: sourceMap
+ | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne poker pix nSteps |
- | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps |
<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
"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).
+ poker := BitBlt bitPokerToForm: destForm.
- 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: (sourceForm pixelAt: sp // fixedPtOne asPoint)]
- 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:
+ (sourceForm pixelAt: sp
- (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]!
1
0
tim Rowledge uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tpr.205.mcz
==================== Summary ====================
Name: Graphics-tpr.205
Author: tpr
Time: 23 March 2013, 10:32:54.898 pm
UUID: a16cf25b-36b7-4a5e-b3e9-3786b5f7c92d
Ancestors: Graphics-tpr.204
A somewhat involved pile of changes that I'm not 10% sure my use of MC has correctly caught; revert this if you find bugs!
For example, MC claims that AbstractFont is very different but visual inspection says not.
Get rid of the idiom 'BitBLt current'.
Add support for the pixelVaueAt: primitive
And yes, I had to try twice , again
=============== Diff against Graphics-cbc.203 ===============
Item was added:
+ (PackageInfo named: 'Graphics') postscriptOfRemoval: 'nil'!
Item was removed:
- ----- Method: AbstractFont>>displayStrikeoutOn:from:to: (in category 'displaying') -----
- displayStrikeoutOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
- "display the strikeout if appropriate for the receiver"!
Item was removed:
- ----- Method: AbstractFont>>displayUnderlineOn:from:to: (in category 'displaying') -----
- displayUnderlineOn: aDisplayContext from: baselineStartPoint to: baselineEndPoint
- "display the underline if appropriate for the receiver"!
Item was removed:
- ----- Method: AbstractFont>>emphasisString (in category 'accessing') -----
- emphasisString
- "Answer a translated string that represents the receiver's emphasis."
-
- ^self emphasisStringFor: self emphasis!
Item was removed:
- ----- Method: AbstractFont>>emphasisStringFor: (in category 'accessing') -----
- emphasisStringFor: emphasisCode
- "Answer a translated string that represents the attributes given in emphasisCode."
-
- ^self class emphasisStringFor: emphasisCode!
Item was removed:
- ----- Method: AbstractFont>>hasDistinctGlyphsForAll: (in category 'testing') -----
- hasDistinctGlyphsForAll: asciiString
- "Answer true if the receiver has glyphs for all the characters
- in asciiString and no single glyph is shared by more than one character, false otherwise.
- The default behaviour is to answer true, but subclasses may reimplement"
-
- ^true!
Item was removed:
- ----- Method: AbstractFont>>hasGlyphsForAll: (in category 'testing') -----
- hasGlyphsForAll: asciiString
- "Answer true if the receiver has glyphs for all the characters
- in asciiString, false otherwise.
- The default behaviour is to answer true, but subclasses may reimplement"
-
- ^true!
Item was removed:
- ----- Method: AbstractFont>>isSubPixelPositioned (in category 'testing') -----
- isSubPixelPositioned
- "Answer true if the receiver is currently using subpixel positioned
- glyphs, false otherwise. This affects how padded space sizes are calculated
- when composing text.
- Currently, only FreeTypeFonts are subPixelPositioned, and only when not
- Hinted"
-
- ^false !
Item was removed:
- ----- Method: AbstractFont>>isSymbolFont (in category 'testing') -----
- isSymbolFont
- "Answer true if the receiver is a Symbol font, false otherwise.
- The default is to answer false, subclasses can reimplement"
-
- ^false!
Item was removed:
- ----- Method: AbstractFont>>kerningLeft:right: (in category 'kerning') -----
- kerningLeft: leftChar right: rightChar
- ^0!
Item was removed:
- ----- Method: AbstractFont>>linearWidthOf: (in category 'measuring') -----
- linearWidthOf: aCharacter
- "This is the scaled, unrounded advance width."
- ^self widthOf: aCharacter!
Item was removed:
- ----- Method: AbstractFont>>widthAndKernedWidthOfLeft:right:into: (in category 'kerning') -----
- widthAndKernedWidthOfLeft: leftCharacter right: rightCharacterOrNil into: aTwoElementArray
- "Set the first element of aTwoElementArray to the width of leftCharacter and
- the second element to the width of left character when kerned with
- rightCharacterOrNil. Answer aTwoElementArray"
- | w k |
- w := self widthOf: leftCharacter.
- rightCharacterOrNil isNil
- ifTrue:[
- aTwoElementArray
- at: 1 put: w;
- at: 2 put: w]
- ifFalse:[
- k := self kerningLeft: leftCharacter right: rightCharacterOrNil.
- aTwoElementArray
- at: 1 put: w;
- at: 2 put: w+k].
- ^aTwoElementArray
- !
Item was changed:
----- Method: BitBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for BitBlt"
+ ^self!
- ^Display defaultBitBltClass!
Item was removed:
- ----- Method: BitBlt>>combinationRule (in category 'accessing') -----
- combinationRule
- "Answer the receiver's combinationRule"
-
- ^combinationRule!
Item was changed:
----- Method: ColorForm>>copy: (in category 'copying') -----
copy: aRect
"Return a new ColorForm containing the portion of the receiver delineated by aRect."
| newForm |
newForm := self species extent: aRect extent depth: depth.
+ ((BitBlt
- ((BitBlt current
destForm: newForm
sourceForm: self
fillColor: nil
combinationRule: Form over
destOrigin: 0@0
sourceOrigin: aRect origin
extent: aRect extent
clipRect: newForm boundingBox)
colorMap: nil) copyBits.
colors ifNotNil: [newForm colors: colors copy].
^ newForm
!
Item was removed:
- ----- Method: ColorForm>>pixelValueAt: (in category 'pixel accessing') -----
- pixelValueAt: aPoint
- "Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color."
- "Details: To get the raw pixel value, be sure the peeker's colorMap is nil."
-
- ^ (BitBlt current bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint
- !
Item was changed:
----- Method: ColorForm>>twoToneFromDisplay:backgroundColor: (in category 'color manipulation') -----
twoToneFromDisplay: aRectangle backgroundColor: bgColor
"Copy one-bit deep ColorForm from the Display using a color map that maps all colors except the background color to black. Used for caching the contents of inactive MVC windows."
| map |
(width = aRectangle width and: [height = aRectangle height])
ifFalse: [self setExtent: aRectangle extent depth: depth].
"make a color map mapping the background color
to zero and all other colors to one"
map := Bitmap new: (1 bitShift: (Display depth min: 9)).
1 to: map size do: [:i | map at: i put: 16rFFFFFFFF].
map at: (bgColor indexInMap: map) put: 0.
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
destOrigin: 0@0;
sourceForm: Display;
sourceRect: aRectangle;
combinationRule: Form over;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: DisplayMedium>>fillShape:fillColor:at: (in category 'coloring') -----
fillShape: aShapeForm fillColor: aColor at: location
"Fill a region corresponding to 1 bits in aShapeForm with aColor"
+ ((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor
- ((BitBlt current destForm: self sourceForm: aShapeForm fillColor: aColor
combinationRule: Form paint
destOrigin: location + aShapeForm offset sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits!
Item was changed:
----- Method: DisplayObject>>follow:while:bitsBehind:startingLoc: (in category 'displaying-Display') -----
follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc
"Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value."
| location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects |
location := loc.
rect1 := location extent: self extent.
save1 := initialBitsBehind.
+ save1Blt := BitBlt toForm: save1.
- save1Blt := BitBlt current toForm: save1.
buffer := Form extent: self extent*2 depth: Display depth. "Holds overlapping region"
+ bufferBlt := BitBlt toForm: buffer.
- bufferBlt := BitBlt current toForm: buffer.
Display deferUpdates: true.
self displayOn: Display at: location rule: Form paint.
Display deferUpdates: false; forceToScreen: (location extent: self extent).
[durationBlock value] whileTrue: [
newLoc := locationBlock value.
newLoc ~= location ifTrue: [
rect2 := newLoc extent: self extent.
bothRects := rect1 merge: rect2.
(rect1 intersects: rect2)
ifTrue: [ "when overlap, buffer background for both rectangles"
bufferBlt copyFrom: bothRects in: Display to: 0@0.
bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin.
"now buffer is clean background; get new bits for save1"
save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer.
self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint.
Display deferUpdates: true.
Display copy: bothRects from: 0@0 in: buffer rule: Form over.
Display deferUpdates: false; forceToScreen: bothRects]
ifFalse: [ "when no overlap, do the simple thing (both rects might be too big)"
Display deferUpdates: true.
Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over.
save1Blt copyFrom: rect2 in: Display to: 0@0.
self displayOn: Display at: newLoc rule: Form paint.
Display deferUpdates: false;
forceToScreen: (location extent: save1 extent);
forceToScreen: (newLoc extent: self extent)].
location := newLoc.
rect1 := rect2]].
^ save1 displayOn: Display at: location
!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) copyBits!
Item was changed:
----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'displaying') -----
copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sf
fillColor: hf
combinationRule: cr
destOrigin: destOrigin
sourceOrigin: rect origin
extent: rect extent
clipRect: (clipRect intersect: clippingBox)) colorMap: map) copyBits!
Item was removed:
- ----- Method: DisplayScreen>>defaultBitBltClass (in category 'blitter defaults') -----
- defaultBitBltClass
- "Return the BitBlt version to use when I am active"
- ^BitBlt!
Item was changed:
----- Method: Form class>>dotOfSize: (in category 'instance creation') -----
dotOfSize: diameter
"Create a form which contains a round black dot."
| radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx |
radius := diameter//2.
form := self extent: diameter@diameter offset: (0@0) - (radius@radius).
+ bb := (BitBlt toForm: form)
- bb := (BitBlt current toForm: form)
sourceX: 0; sourceY: 0;
combinationRule: Form over;
fillColor: Color black.
rect := form boundingBox.
centerX := rect center x.
centerY := rect center y.
centerYBias := rect height odd ifTrue: [0] ifFalse: [1].
centerXBias := rect width odd ifTrue: [0] ifFalse: [1].
radiusSquared := (rect height asFloat / 2.0) squared - 0.01.
xOverY := rect width asFloat / rect height asFloat.
maxy := rect height - 1 // 2.
"First do the inner fill, and collect x values"
0 to: maxy do:
[:dy |
dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated.
bb destX: centerX - centerXBias - dx
destY: centerY - centerYBias - dy
width: dx + dx + centerXBias + 1
height: 1;
copyBits.
bb destY: centerY + dy;
copyBits].
^ form
"
Time millisecondsToRun:
[1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]]
"!
Item was changed:
----- Method: Form class>>toothpaste: (in category 'examples') -----
toothpaste: diam "Display restoreAfter: [Form toothpaste: 30]"
"Draws wormlike lines by laying down images of spheres.
See Ken Knowlton, Computer Graphics, vol. 15 no. 4 p352.
Draw with mouse button down; terminate by option-click."
| facade ball filter point queue port color q colors colr colr2 |
colors := Display depth = 1
ifTrue: [Array with: Color black]
ifFalse: [Color red wheel: 12].
facade := Form extent: diam@diam offset: (diam // -2) asPoint.
(Form dotOfSize: diam) displayOn: facade
at: (diam // 2) asPoint clippingBox: facade boundingBox
rule: Form under fillColor: Color white.
#(1 2 3) do:
[:x | "simulate facade by circles of gray"
(Form dotOfSize: x * diam // 5) displayOn: facade
at: (diam * 2 // 5) asPoint clippingBox: facade boundingBox
rule: Form under
fillColor: (Color perform:
(#(black gray lightGray) at: x)).
"facade displayAt: 50*x@50"].
ball := Form dotOfSize: diam.
color := 8.
+ [port := BitBlt toForm: Display.
- [port := BitBlt current toForm: Display.
"Expand 1-bit forms to any pixel depth"
port colorMap: (Bitmap with: 0 with: 16rFFFFFFFF).
queue := OrderedCollection new: 32.
16 timesRepeat: [queue addLast: -20 @ -20].
Sensor waitButton.
Sensor yellowButtonPressed ifTrue: [^ self].
filter := Sensor cursorPoint.
colr := colors atWrap: (color := color + 5). "choose increment relatively prime to colors size"
colr2 := colr alphaMixed: 0.3 with: Color white.
[Sensor redButtonPressed or: [queue size > 0]] whileTrue:
[filter := filter * 4 + Sensor cursorPoint // 5.
point := Sensor redButtonPressed
ifTrue: [filter] ifFalse: [-20 @ -20].
port copyForm: ball to: point rule: Form paint fillColor: colr.
(q := queue removeFirst) == nil ifTrue: [^ self]. "exit"
Display depth = 1
ifTrue: [port copyForm: facade to: q rule: Form erase]
ifFalse: [port copyForm: facade to: q rule: Form paint fillColor: colr2].
Sensor redButtonPressed ifTrue: [queue addLast: point]]] repeat.
!
Item was changed:
----- Method: Form>>asFormOfDepth: (in category 'converting') -----
asFormOfDepth: d
| newForm |
d = self depth ifTrue:[^self].
newForm := Form extent: self extent depth: d.
+ (BitBlt toForm: newForm)
- (BitBlt current toForm: newForm)
colorMap: (self colormapIfNeededFor: newForm);
copy: (self boundingBox)
from: 0@0 in: self
fillColor: nil rule: Form over.
"Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation."
(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
^newForm!
Item was changed:
----- Method: Form>>asGrayScale (in category 'converting') -----
asGrayScale
"Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)"
| f32 srcForm result map bb grays |
self depth = 32 ifFalse: [
f32 := Form extent: width@height depth: 32.
self displayOn: f32.
^ f32 asGrayScale].
self unhibernate.
srcForm := Form extent: (width * 4)@height depth: 8.
srcForm bits: bits.
result := ColorForm extent: width@height depth: 8.
map := Bitmap new: 256.
2 to: 256 do: [:i | map at: i put: i - 1].
map at: 1 put: 1. "map zero pixel values to near-black"
+ bb := (BitBlt toForm: result)
- bb := (BitBlt current toForm: result)
sourceForm: srcForm;
combinationRule: Form over;
colorMap: map.
0 to: width - 1 do: [:dstX |
bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height);
destOrigin: dstX@0;
copyBits].
"final BitBlt to zero-out pixels that were truely transparent in the original"
map := Bitmap new: 512.
map at: 1 put: 16rFF.
+ (BitBlt toForm: result)
- (BitBlt current toForm: result)
sourceForm: self;
sourceRect: self boundingBox;
destOrigin: 0@0;
combinationRule: Form erase;
colorMap: map;
copyBits.
grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0].
grays at: 1 put: Color transparent.
result colors: grays.
^ result
!
Item was changed:
----- Method: Form>>border:width:rule:fillColor: (in category 'bordering') -----
border: rect width: borderWidth rule: rule fillColor: fillColor
"Paint a border whose rectangular area is defined by rect. The
width of the border of each side is borderWidth. Uses fillColor for drawing
the border."
| blt |
+ blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor.
- blt := (BitBlt current toForm: self) combinationRule: rule; fillColor: fillColor.
blt sourceOrigin: 0@0.
blt destOrigin: rect origin.
blt width: rect width; height: borderWidth; copyBits.
blt destY: rect corner y - borderWidth; copyBits.
blt destY: rect origin y + borderWidth.
blt height: rect height - borderWidth - borderWidth; width:
borderWidth; copyBits.
blt destX: rect corner x - borderWidth; copyBits!
Item was changed:
----- Method: Form>>borderFormOfWidth:sharpCorners: (in category 'bordering') -----
borderFormOfWidth: borderWidth sharpCorners: sharpen
"Smear this form around and then subtract the original to produce
an outline. If sharpen is true, then cause right angles to be outlined
by right angles (takes an additional diagonal smears ANDed with both
horizontal and vertical smears)."
| smearForm bigForm smearPort all cornerForm cornerPort nbrs |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
bigForm := self deepCopy.
all := bigForm boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
sharpen ifTrue:
[cornerForm := Form extent: self extent.
+ cornerPort := BitBlt toForm: cornerForm].
- cornerPort := BitBlt current toForm: cornerForm].
nbrs := (0@0) fourNeighbors.
1 to: borderWidth do:
[:i | "Iterate to get several layers of 'skin'"
nbrs do:
[:d | "Smear the self in 4 directions to grow each layer of skin"
smearPort copyForm: bigForm to: d rule: Form under].
sharpen ifTrue:
["Special treatment to smear sharp corners"
nbrs with: ((2 to: 5) collect: [:i2 | nbrs atWrap: i2]) do:
[:d1 :d2 |
"Copy corner points diagonally"
cornerPort copyForm: bigForm to: d1+d2 rule: Form over.
"But only preserve if there were dots on either side"
cornerPort copyForm: bigForm to: d1+d1+d2 rule: Form and.
cornerPort copyForm: bigForm to: d1+d2+d2 rule: Form and.
smearPort copyForm: cornerForm to: 0@0 rule: Form under].
].
bigForm copy: all from: 0@0 in: smearForm rule: Form over.
].
"Now erase the original shape to obtain the outline"
bigForm copy: all from: 0@0 in: self rule: Form erase.
^ bigForm!
Item was changed:
----- Method: Form>>copy:from:in:rule: (in category 'copying') -----
copy: destRectangle from: sourcePt in: sourceForm rule: rule
"Make up a BitBlt table and copy the bits."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: destRectangle
from: sourcePt in: sourceForm
fillColor: nil rule: rule!
Item was changed:
----- Method: Form>>copyBits:at:translucent: (in category 'copying') -----
copyBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 30
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm
"Make up a BitBlt table and copy the bits."
+ (BitBlt
- (BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map
"Make up a BitBlt table and copy the bits. Use a colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: rule
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: clipRect) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>copyBits:from:at:colorMap: (in category 'copying') -----
copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map
"Make up a BitBlt table and copy the bits with the given colorMap."
+ ((BitBlt
- ((BitBlt current
destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: Form over
destOrigin: destOrigin
sourceOrigin: sourceRect origin
extent: sourceRect extent
clipRect: self boundingBox) colorMap: map) copyBits!
Item was changed:
----- Method: Form>>displayInterpolatedIn:on: (in category 'displaying') -----
displayInterpolatedIn: aRectangle on: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine adjustedR |
self extent = aRectangle extent ifTrue:[^self displayOn: aForm at: aRectangle origin].
engine := Smalltalk at: #B3DRenderEngine
ifPresent: [:engineClass | (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aRectangle;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
"there seems to be a slight bug in B3D which the following adjusts for"
adjustedR := (aRectangle withRight: aRectangle right + 1) translateBy: 0@1.
engine viewport: adjustedR.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayInterpolatedOn: (in category 'displaying') -----
displayInterpolatedOn: aForm
"Display the receiver on aForm, using interpolation if necessary.
Form fromUser displayInterpolatedOn: Display.
Note: When scaling we attempt to use bilinear interpolation based
on the 3D engine. If the engine is not there then we use WarpBlt.
"
| engine |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine
ifPresent:[:engineClass| (engineClass defaultForPlatformOn: aForm)].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
"Otherwise use the 3D engine for our purposes"
engine viewport: aForm boundingBox.
engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
engine texture: self.
engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
engine finish.!
Item was changed:
----- Method: Form>>displayResourceFormOn: (in category 'displaying') -----
displayResourceFormOn: aForm
"a special display method for blowing up resource thumbnails"
| engine tx cmap blitter |
self extent = aForm extent ifTrue:[^self displayOn: aForm].
engine := Smalltalk at: #B3DRenderEngine ifPresent:
[:engineClass | engineClass defaultForPlatformOn: aForm].
engine ifNil:[
"We've got no bilinear interpolation. Use WarpBlt instead"
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: 3;
cellSize: 2;
warpBits.
^self
].
tx := self asTexture.
+ (blitter := BitBlt toForm: tx)
- (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: (self 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 toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form and;
colorMap: (Color maskingMap: self depth);
warpBits.!
Item was changed:
----- Method: Form>>displayScaledOn: (in category 'displaying') -----
displayScaledOn: aForm
"Display the receiver on aForm, scaling if necessary.
Form fromUser displayScaledOn: Display.
"
self extent = aForm extent ifTrue:[^self displayOn: aForm].
+ (WarpBlt toForm: aForm)
- (WarpBlt current toForm: aForm)
sourceForm: self destRect: aForm boundingBox;
combinationRule: Form paint;
cellSize: 2;
warpBits.!
Item was changed:
----- Method: Form>>drawLine:from:to:clippingBox:rule:fillColor: (in category 'displaying') -----
drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm
"Refer to the comment in
DisplayMedium|drawLine:from:to:clippingBox:rule:mask:."
| dotSetter |
"set up an instance of BitBlt for display"
+ dotSetter := BitBlt
- dotSetter := BitBlt current
destForm: self
sourceForm: sourceForm
fillColor: aForm
combinationRule: anInteger
destOrigin: beginPoint
sourceOrigin: 0 @ 0
extent: sourceForm extent
clipRect: clipRect.
dotSetter drawFrom: beginPoint to: endPoint!
Item was changed:
----- Method: Form>>eraseShape: (in category 'filling') -----
eraseShape: bwForm
"use bwForm as a mask to clear all pixels where bwForm has 1's"
+ ((BitBlt destForm: self sourceForm: bwForm
- ((BitBlt current destForm: self sourceForm: bwForm
fillColor: nil
combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask"
destOrigin: bwForm offset
sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox)
colorMap: (Bitmap with: 0 with: 16rFFFFFFFF))
copyBits.
!
Item was changed:
----- Method: Form>>fill:rule:fillColor: (in category 'filling') -----
fill: aRectangle rule: anInteger fillColor: aForm
"Replace a rectangular area of the receiver with the pattern described by aForm
according to the rule anInteger."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
copy: aRectangle
from: 0@0 in: nil
fillColor: aForm rule: anInteger!
Item was changed:
----- Method: Form>>fillFromXYColorBlock: (in category 'filling') -----
fillFromXYColorBlock: colorBlock
"General Gradient Fill.
Supply relative x and y in [0.0 ... 1.0] to colorBlock,
and paint each pixel with the color that comes back"
| poker yRel xRel |
+ poker := BitBlt bitPokerToForm: self.
- poker := BitBlt current bitPokerToForm: self.
0 to: height-1 do:
[:y | yRel := y asFloat / (height-1) asFloat.
0 to: width-1 do:
[:x | xRel := x asFloat / (width-1) asFloat.
poker pixelAt: x@y
put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]]
"
| d |
((Form extent: 100@20 depth: Display depth)
fillFromXYColorBlock:
[:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs.
Color r: d g: 0 b: 1.0-d]) display
"!
Item was changed:
----- Method: Form>>findShapeAroundSeedBlock: (in category 'filling') -----
findShapeAroundSeedBlock: seedBlock
"Build a shape that is black in any region marked by seedBlock.
SeedBlock will be supplied a form, in which to blacken various
pixels as 'seeds'. Then the seeds are smeared until
there is no change in the smear when it fills the region, ie,
when smearing hits a black border and thus goes no further."
| smearForm previousSmear all count smearPort |
self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms."
all := self boundingBox.
smearForm := Form extent: self extent.
+ smearPort := BitBlt toForm: smearForm.
- smearPort := BitBlt current toForm: smearForm.
seedBlock value: smearForm. "Blacken seeds to be smeared"
smearPort copyForm: self to: 0 @ 0 rule: Form erase. "Clear any in black"
previousSmear := smearForm deepCopy.
count := 1.
[count = 10 and: "check for no change every 10 smears"
[count := 1.
previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse.
previousSmear isAllWhite]]
whileFalse:
[smearPort copyForm: smearForm to: 1 @ 0 rule: Form under.
smearPort copyForm: smearForm to: -1 @ 0 rule: Form under.
"After horiz smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
smearPort copyForm: smearForm to: 0 @ 1 rule: Form under.
smearPort copyForm: smearForm to: 0 @ -1 rule: Form under.
"After vert smear, trim around the region border"
smearPort copyForm: self to: 0 @ 0 rule: Form erase.
count := count + 1.
count = 9 ifTrue: "Save penultimate smear for comparison"
[previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]].
"Now paint the filled region in me with aHalftone"
^ smearForm!
Item was changed:
----- Method: Form>>flipBy:centerAt: (in category 'scaling, rotation') -----
flipBy: direction centerAt: aPoint
"Return a copy of the receiver flipped either #vertical or #horizontal."
| newForm quad |
newForm := self species 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 toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>floodFill2:at: (in category 'filling') -----
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."
+ | poker stack old new x y top x1 x2 dy left goRight |
+ poker := BitBlt bitPokerToForm: self.
- | 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 := self pixelAt: interiorPoint.
- 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:[(self pixelAt: x@y) = old]] whileTrue:[
- [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:[(self pixelAt: x@y) = old]] whileTrue:[
- [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:[(self pixelAt: x@y) ~= old]] whileTrue.
- [(x := x + 1) <= x2 and:[(peeker pixelAt: x@y) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
!
Item was changed:
----- Method: Form>>floodFill:at:tolerance: (in category 'filling') -----
floodFill: aColor at: interiorPoint tolerance: tolerance
"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 (ar): This variant has been heavily optimized to prevent the overhead of repeated calls to BitBlt. Usually this is a really big winner but the runtime now depends a bit on the complexity of the shape to be filled. For extremely complex shapes (say, a Hilbert curve) with very few pixels to fill it can be slower than #floodFill2:at: since it needs to repeatedly read the source bits. However, in all practical cases I found this variant to be 15-20 times faster than anything else.
Further note (di): I have added a feature that allows this routine to fill areas of approximately constant color (such as photos, scans, and jpegs). It does this by computing a color map for the peeker that maps all colors close to 'old' into colors identical to old. This mild colorblindness achieves the desired effect with no further change or degradation of the algorithm. tolerance should be 0 (exact match), or a value corresponding to those returned by Color>>diff:, with 0.1 being a reasonable starting choice."
| peeker poker stack old new x y top x1 x2 dy left goRight span spanBits w box debug |
debug := false. "set it to true to see the filling process"
box := interiorPoint extent: 1@1.
span := Form extent: width@1 depth: 32.
spanBits := span bits.
+ peeker := BitBlt toForm: span.
- peeker := BitBlt current toForm: span.
peeker
sourceForm: self;
combinationRule: 3;
width: width;
height: 1.
"read old pixel value"
peeker sourceOrigin: interiorPoint; destOrigin: interiorPoint x @ 0; width: 1; copyBits.
old := spanBits at: interiorPoint x + 1.
"compute new value (take care since the algorithm will fail if old = new)"
new := self privateFloodFillValue: aColor.
old = new ifTrue: [^ box].
tolerance > 0 ifTrue:
["Set up color map for approximate fills"
peeker colorMap: (self floodFillMapFrom: self to: span mappingColorsWithin: tolerance to: old)].
+ poker := BitBlt toForm: self.
- poker := BitBlt current toForm: self.
poker
fillColor: aColor;
combinationRule: 3;
width: width;
height: 1.
stack := OrderedCollection new: 50.
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:[
debug ifTrue:[self displayOn: Display].
top := stack removeLast.
y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4.
y := y + dy.
debug ifTrue:[
Display
drawLine: (Form extent: 1@1 depth: 8) fillWhite
from: (x1-1)@y to: (x2+1)@y
clippingBox: Display boundingBox
rule: Form over fillColor: nil].
"Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled.
Now explore adjacent pixels in scanline y."
peeker sourceOrigin: 0@y; destOrigin: 0@0; width: width; copyBits.
"Note: above is necessary since we don't know where we'll end up filling"
x := x1.
w := 0.
[x >= 0 and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x - 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: x+1@y; width: w; copyBits.
box := box quickMerge: ((x+1@y) extent: w@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:[
w := 0.
[x < width and:[(spanBits at: x+1) = old]] whileTrue:[
w := w + 1.
x := x + 1].
w > 0 ifTrue:[
"overwrite pixels"
poker destOrigin: (x-w)@y; width: w; copyBits.
box := box quickMerge: ((x-w@y) extent: w@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:[(spanBits at: x+1) ~= old]] whileTrue.
left := x.
goRight := true.
x <= x2] whileTrue.
].
^box!
Item was changed:
----- Method: Form>>magnify:by:smoothing: (in category 'scaling, rotation') -----
magnify: aRectangle by: scale smoothing: cellSize
"Answer a Form created as a scaling of the receiver.
Scale may be a Float or even a Point, and may be greater or less than 1.0."
| newForm |
newForm := self blankCopyOf: aRectangle scaledBy: scale.
+ (WarpBlt toForm: newForm)
- (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]]
"!
Item was changed:
----- Method: Form>>mapColor:to: (in category 'color mapping') -----
mapColor: oldColor to: newColor
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
map := (Color cachedColormapFrom: self depth to: self depth) copy.
map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth).
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>mapColors:to: (in category 'color mapping') -----
mapColors: oldColorBitsCollection to: newColorBits
"Make all pixels of the given color in this Form to the given new color."
"Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution."
| map |
self depth < 16
ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy]
ifFalse: [
"use maximum resolution color map"
"source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component"
map := Color computeRGBColormapFor: self depth bitsPerColor: 5].
oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits].
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: height;
colorMap: map;
copyBits.
!
Item was changed:
----- Method: Form>>pageWarp:at:forward: (in category 'transitions') -----
pageWarp: otherImage at: topLeft forward: forward
"Produce a page-turning illusion that gradually reveals otherImage
located at topLeft in this form.
forward == true means turn pages toward you, else away. [ignored for now]"
| pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d |
pageRect := otherImage boundingBox.
oldPage := self copy: (pageRect translateBy: topLeft).
(forward ifTrue: [oldPage] ifFalse: [otherImage])
border: pageRect
widthRectangle: (Rectangle
left: 0
right: 2
top: 1
bottom: 1)
rule: Form over
fillColor: Color black.
oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))).
nSteps := 8.
buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth.
d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight.
1 to: nSteps-1 do:
[:i | forward
ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
p := pageRect topRight + (d * i // nSteps)]
ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over.
p := pageRect topRight + (d * (nSteps-i) // nSteps)].
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y).
sourceQuad := Array with: pageRect topLeft
with: pageRect bottomLeft + (0@p y)
with: pageRect bottomRight
with: pageRect topRight - (0@p y).
+ warp := (WarpBlt toForm: buffer)
- warp := (WarpBlt current toForm: buffer)
clipRect: leafRect;
sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]);
combinationRule: Form paint.
warp copyQuad: sourceQuad toRect: leafRect.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate].
buffer copy: pageRect from: otherImage to: 0@0 rule: Form over.
buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over.
self copy: buffer boundingBox from: buffer to: topLeft rule: Form over.
Display forceDisplayUpdate.
"
1 to: 4 do: [:corner | Display pageWarp:
(Form fromDisplay: (10@10 extent: 200@300)) reverse
at: 10@10 forward: false]
"
!
Item was changed:
----- Method: Form>>paintBits:at:translucent: (in category 'displaying') -----
paintBits: sourceForm at: destOrigin translucent: factor
"Make up a BitBlt table and copy the bits with the given colorMap."
+ (BitBlt destForm: self
- (BitBlt current destForm: self
sourceForm: sourceForm
halftoneForm: nil
combinationRule: 31
destOrigin: destOrigin
sourceOrigin: 0@0
extent: sourceForm extent
clipRect: self boundingBox)
copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255)
"
| f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent.
f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy.
0.0 to: 1.0 by: 1.0/32 do:
[:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t.
f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait].
"!
Item was changed:
----- Method: Form>>pixelCompare:with:at: (in category 'analyzing') -----
pixelCompare: aRect with: otherForm at: otherLoc
"Compare the selected bits of this form (those within aRect) against
those in a similar rectangle of otherFrom. Return the sum of the
absolute value of the differences of the color values of every pixel.
Obviously, this is most useful for rgb (16- or 32-bit) pixels but,
in the case of 8-bits or less, this will return the sum of the differing
bits of the corresponding pixel values (somewhat less useful)"
| pixPerWord temp |
pixPerWord := 32//self depth.
(aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue:
["If word-aligned, use on-the-fly difference"
+ ^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm
- ^ (BitBlt current toForm: self) copy: aRect from: otherLoc in: otherForm
fillColor: nil rule: 32].
"Otherwise, combine in a word-sized form and then compute difference"
temp := self copy: aRect.
temp copy: aRect from: otherLoc in: otherForm rule: 21.
+ ^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil
- ^ (BitBlt current toForm: temp) copy: aRect from: otherLoc in: nil
fillColor: (Bitmap with: 0) rule: 32
" Dumb example prints zero only when you move over the original rectangle...
| f diff | f := Form fromUser.
[Sensor anyButtonPressed] whileFalse:
[diff := f pixelCompare: f boundingBox
with: Display at: Sensor cursorPoint.
diff printString , ' ' displayAt: 0@0]
"!
Item was changed:
----- Method: Form>>pixelValueAt: (in category 'pixel access') -----
pixelValueAt: aPoint
"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. "
+ ^ self primPixelValueAtX: aPoint x y: aPoint y!
- ^ (BitBlt current bitPeekerFromForm: self) pixelAt: aPoint
- !
Item was changed:
----- Method: Form>>pixelValueAt:put: (in category 'pixel access') -----
pixelValueAt: aPoint put: pixelValue
"Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. "
+ (BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
- (BitBlt current bitPokerToForm: self) pixelAt: aPoint put: pixelValue.
!
Item was changed:
----- Method: Form>>primCountBits (in category 'analyzing') -----
primCountBits
"Count the non-zero pixels of this form."
self depth > 8 ifTrue:
[^(self asFormOfDepth: 8) primCountBits].
+ ^ (BitBlt toForm: self)
- ^ (BitBlt current toForm: self)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: width@height);
combinationRule: 32;
copyBits!
Item was added:
+ ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') -----
+ primPixelValueAtX: x y: y
+ "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. Make sure the colorMap is nil for ColorForms "
+
+ <primitive: 'primitivePixelValueAt' module:'BitBltPlugin'>
+ ^(BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: x@y!
Item was changed:
----- Method: Form>>rectangleEnclosingPixelsNotOfColor: (in category 'analyzing') -----
rectangleEnclosingPixelsNotOfColor: aColor
"Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background."
| cm slice copyBlt countBlt top bottom newH left right |
"map the specified color to 1 and all others to 0"
cm := Bitmap new: (1 bitShift: (self depth min: 15)).
cm primFill: 1.
cm at: (aColor indexInMap: cm) put: 0.
"build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest"
slice := Form extent: width@1 depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: width height: 1;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from top and bottom"
top := (0 to: height)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0]
ifNone: [^ 0@0 extent: 0@0].
bottom := (height - 1 to: top by: -1)
detect: [:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits > 0].
"build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest"
newH := bottom - top + 1.
slice := Form extent: 1@newH depth: 1.
+ copyBlt := (BitBlt toForm: slice)
- copyBlt := (BitBlt current toForm: slice)
sourceForm: self;
combinationRule: Form over;
destX: 0 destY: 0 width: 1 height: newH;
colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
"scan in from left and right"
left := (0 to: width)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
right := (width - 1 to: left by: -1)
detect: [:x |
copyBlt sourceOrigin: x@top; copyBits.
countBlt copyBits > 0].
^ left@top corner: (right + 1)@(bottom + 1)
!
Item was changed:
----- Method: Form>>replaceColor:withColor: (in category 'image manipulation') -----
replaceColor: oldColor withColor: newColor
"Replace one color with another everywhere is this form"
| cm newInd target ff |
self depth = 32
ifTrue: [cm := (Color cachedColormapFrom: 16 to: 32) copy]
ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)).
1 to: cm size do: [:i | cm at: i put: i - 1]].
newInd := newColor pixelValueForDepth: self depth.
cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd.
target := newColor isTransparent
ifTrue: [ff := Form extent: self extent depth: depth.
ff fillWithColor: newColor. ff]
ifFalse: [self].
+ (BitBlt toForm: target)
- (BitBlt current toForm: target)
sourceForm: self;
sourceOrigin: 0@0;
combinationRule: Form paint;
destX: 0 destY: 0 width: width height: height;
colorMap: cm;
copyBits.
newColor = Color transparent
ifTrue: [target displayOn: self].!
Item was changed:
----- Method: Form>>rotateBy:centerAt: (in category 'scaling, rotation') -----
rotateBy: direction centerAt: aPoint
"Return a rotated copy of the receiver.
direction = #none, #right, #left, or #pi"
| newForm quad rot scale |
direction == #none ifTrue: [^ self].
scale := (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent .
newForm := self blankCopyOf: self boundingBox scaledBy: scale.
quad := self boundingBox innerCorners.
rot := #(right pi left) indexOf: direction.
+ (WarpBlt toForm: newForm)
- (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]
"
!
Item was changed:
----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') -----
rotateBy: deg magnify: scale smoothing: cellSize
"Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
"rot is the destination form, big enough for any angle."
| side rot warp r1 pts bigSide |
side := 1 + self extent r asInteger.
bigSide := (side asPoint * scale) rounded.
rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
+ warp := (WarpBlt toForm: rot)
- 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 |
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@2 smoothing: 2) display].
f display
"!
Item was changed:
----- Method: Form>>smear:distance: (in category 'image manipulation') -----
smear: dir distance: dist
"Smear any black pixels in this form in the direction dir in Log N steps"
| skew bb |
+ bb := BitBlt destForm: self sourceForm: self fillColor: nil
- bb := BitBlt current destForm: self sourceForm: self fillColor: nil
combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0
extent: self extent clipRect: self boundingBox.
skew := 1.
[skew < dist] whileTrue:
[bb destOrigin: dir*skew; copyBits.
skew := skew+skew]!
Item was changed:
----- Method: Form>>tallyPixelValuesInRect:into: (in category 'analyzing') -----
tallyPixelValuesInRect: destRect into: valueTable
"Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable."
+ (BitBlt toForm: self)
- (BitBlt current toForm: self)
sourceForm: self; "src must be given for color map ops"
sourceOrigin: 0@0;
tallyMap: valueTable;
combinationRule: 33;
destRect: destRect;
copyBits.
^ valueTable
"
Move a little rectangle around the screen and print its tallies...
| r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
[r := Sensor cursorPoint extent: 10@10.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
tallies := (Display copy: r) tallyPixelValues.
nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0]
thenCollect: [:i | (tallies at: i) -> (i-1)].
nonZero printString , ' ' displayAt: 0@0.
Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"!
Item was changed:
----- Method: Form>>xTallyPixelValue:orNot: (in category 'analyzing') -----
xTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by x-value.
Note that if not is true, then this will tally those different from pv."
| cm slice countBlt copyBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: 1@height.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: width-1) collect:
[:x |
copyBlt sourceOrigin: x@0; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: Form>>yTallyPixelValue:orNot: (in category 'analyzing') -----
yTallyPixelValue: pv orNot: not
"Return an array of the number of pixels with value pv by y-value.
Note that if not is true, then this will tally those different from pv."
| cm slice copyBlt countBlt |
cm := self newColorMap. "Map all colors but pv to zero"
not ifTrue: [cm atAllPut: 1]. "... or all but pv to one"
cm at: pv+1 put: 1 - (cm at: pv+1).
slice := Form extent: width@1.
+ copyBlt := (BitBlt destForm: slice sourceForm: self
- copyBlt := (BitBlt current destForm: slice sourceForm: self
halftoneForm: nil combinationRule: Form over
destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1
clipRect: slice boundingBox) colorMap: cm.
+ countBlt := (BitBlt toForm: slice)
- countBlt := (BitBlt current toForm: slice)
fillColor: (Bitmap with: 0);
destRect: (0@0 extent: slice extent);
combinationRule: 32.
^ (0 to: height-1) collect:
[:y |
copyBlt sourceOrigin: 0@y; copyBits.
countBlt copyBits]!
Item was changed:
----- Method: InfiniteForm>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') -----
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 destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm
- 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]]!
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'].
residuals := WordArray new: 3.
sosSeen := false.
self parseFirstMarker.
[sosSeen] whileFalse: [self parseNextMarker].
form := Form extent: (width @ height) depth: depth.
+ bb := BitBlt toForm: form.
- bb := BitBlt current 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 changed:
----- Method: PNGReadWriter>>copyPixelsGray: (in category 'pixel copies') -----
copyPixelsGray: y
"Handle non-interlaced grayscale color mode (colorType = 0)"
| base bits bytesLeft word |
bitsPerChannel = 16 ifTrue: [
"Warning: This is extremely slow. Besides we are downsampling to 8 bits!!"
| blitter |
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
0 to: width - 1 do: [ :x |
blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ].
^self ].
"Just copy the bits"
"This Smalltalk version might be easier to understand than the others below."
base := y * (form width * bitsPerChannel + 31 // 32) + 1.
bits := form bits.
0 to: thisScanline size // 4 - 1 do: [ :i |
| ii |
ii := i * 4.
"This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:)
is to make use of faster arithmetic bytecodes, but not of slow largeintegers."
word :=
(((thisScanline at: ii + 1) * 256 +
(thisScanline at: ii + 2) * 256 +
(thisScanline at: ii + 3)) bitShift: 8) bitOr:
(thisScanline at: ii + 4).
bits at: base + i put: word ].
(bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [
word := 0.
thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii |
word := word * 256 + (thisScanline at: ii) ].
word := word bitShift: 8 * (4 - bytesLeft).
bits at: base + (thisScanline size // 4) put: word ].
"This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones"
"^self copyPixelsGrayWeirdBitBltHack: y ".
"It uses the following method:
PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y
""Handle non-interlaced black and white color mode (colorType = 0)
By Andreas Raab""
| source dest cmap |
source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline.
dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits.
cmap := Smalltalk isLittleEndian
ifTrue:[ColorMap
shifts: #(-24 -8 8 24)
masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)].
(BitBlt toForm: dest)
sourceForm: source;
destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32);
colorMap: cmap;
combinationRule: 3;
copyBits."
"This interesting technique (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones"
"form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)".
"It uses the following method:
BitMap >> copyFromByteArray2: byteArray to: i
""This method should work with either byte orderings""
| myHack byteHack |
myHack := Form new hackBits: self.
byteHack := Form new hackBits: byteArray.
Smalltalk isLittleEndian ifTrue: [byteHack swapEndianness].
byteHack displayOn: myHack at: 0@i"!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') -----
copyPixelsGray: y at: startX by: incX
"Handle interlaced grayscale color mode (colorType = 0)"
| offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
bitsPerChannel = 16
ifTrue: [
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
startX to: width-1 by: incX do: [ :x |
b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1).
].
^ self
].
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8 ifTrue: [
startX to: width-1 by: incX do: [ :x | | w |
w := offset + (x>>2).
b := 3- (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
].
^ self
].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y
"Handle non-interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
0 to: width-1 do: [ :x |
i := (x << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
0 to: width-1 do: [ :x |
i := (x << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsGrayAlpha:at:by: (in category 'pixel copies') -----
copyPixelsGrayAlpha: y at: startX by: incX
"Handle interlaced grayscale with alpha color mode (colorType = 4)"
| i pixel gray b |
+ b := BitBlt bitPokerToForm: form.
- b := BitBlt current bitPokerToForm: form.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 1) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
ifFalse: [
startX to: width-1 by: incX do: [ :x |
i := (x // incX << 2) + 1.
gray := thisScanline at: i.
pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray.
b pixelAt: x@y put: pixel.
]
]
!
Item was changed:
----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') -----
copyPixelsIndexed: y at: startX by: incX
"Handle interlaced indexed color mode (colorType = 3)"
| offset bits pixPerByte shifts blitter pixel mask pixelNumber |
offset := y*rowSize+1.
bits := form bits.
bitsPerChannel = 8
ifTrue: [
startX to: width-1 by: incX do: [ :x | | b w |
w := offset + (x>>2).
b := 3 - (x \\ 4) * 8.
pixel := (thisScanline at: x // incX + 1)<<b.
mask := (255<<b) bitInvert32.
bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)].
^ self ].
bitsPerChannel = 1 ifTrue: [
pixPerByte := 8.
mask := 1.
shifts := #(7 6 5 4 3 2 1 0).
].
bitsPerChannel = 2 ifTrue: [
pixPerByte := 4.
mask := 3.
shifts := #(6 4 2 0).
].
bitsPerChannel = 4 ifTrue: [
pixPerByte := 2.
mask := 15.
shifts := #(4 0).
].
+ blitter := BitBlt bitPokerToForm: form.
- blitter := BitBlt current bitPokerToForm: form.
pixelNumber := 0.
startX to: width-1 by: incX do: [ :x | | rawByte |
rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
blitter pixelAt: (x@y) put: pixel.
pixelNumber := pixelNumber + 1.
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') -----
nextPutGray: aForm
+ | myType val |
- | myType peeker val |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
"stream position: 0."
aForm depth = 1 ifTrue:[myType := $4] ifFalse:[myType := $5].
self writeHeader: myType.
- peeker := BitBlt current bitPeekerFromForm: aForm.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
+ val := aForm pixelAt: x@y.
- val := peeker pixelAt: x@y.
stream nextPut: val.
]
].
!
Item was changed:
----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') -----
nextPutRGB: aForm
+ | myType f shift mask |
- | myType peeker f shift mask |
cols := aForm width.
rows := aForm height.
depth := aForm depth.
f := aForm.
depth < 16 ifTrue:[
f := aForm asFormOfDepth: 32.
depth := 32.
].
myType := $6.
"stream position: 0."
self writeHeader: myType.
depth = 32 ifTrue:[shift := 8. mask := 16rFF] ifFalse:[shift := 5. mask := 16r1F].
- peeker := BitBlt current bitPeekerFromForm: f.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x | | p r g b |
+ p := f pixelAt: x@y.
- p := peeker pixelAt: x@y.
b := p bitAnd: mask. p := p >> shift.
g := p bitAnd: mask. p := p >> shift.
r := p bitAnd: mask.
stream nextPut: r.
stream nextPut: g.
stream nextPut: b.
]
].
!
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 > 8 bits not supported in Squeak'].
stream binary.
form := ColorForm extent: cols@rows depth: depth.
form colors: nil.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
|val|
val := stream next.
poker pixelAt: x@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>>readPlainBW (in category 'reading') -----
readPlainBW
"plain BW"
| val form poker |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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'].
].
poker pixelAt: x@y put: (val asInteger).
]
].
^form
!
Item was changed:
----- Method: PNMReadWriter>>readPlainGray (in category 'reading') -----
readPlainGray
"plain gray"
| val form poker aux tokens |
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current bitPokerToForm: form.
tokens := OrderedCollection new.
0 to: rows-1 do: [:y |
0 to: cols-1 do: [:x |
aux := self getTokenPbm: tokens.
val := aux at: 1. tokens := aux at: 2.
poker pixelAt: x@y put: val.
]
].
^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 > 32 bits not supported in Squeak'].
form := Form extent: cols@rows depth: 32.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@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 > 32 bits not supported in Squeak'].
stream binary.
form := Form extent: cols@rows depth: depth.
+ poker := BitBlt bitPokerToForm: form.
- poker := BitBlt current 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@y put: val.
]
].
^form
!
Item was changed:
----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') -----
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 |
tabletScale := self tabletScaleFactor.
bitForm := Form extent: Display extent * cellSize depth: 1.
pen := Pen newOnForm: bitForm.
pen color: Color black.
+ warp := (WarpBlt toForm: Display)
- warp := (WarpBlt current toForm: Display)
sourceForm: bitForm;
colorMap: (bitForm colormapIfNeededFor: Display);
cellSize: cellSize;
combinationRule: Form over.
Display fillColor: Color white.
Display restoreAfter: [ | p r nibSize srcR startP dstR |
[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]]].
!
Item was changed:
----- Method: Pen>>print:withFont: (in category 'operations') -----
print: str withFont: font
"Print the given string in the given font at the current heading"
| lineStart scale wasDown |
scale := sourceForm width.
wasDown := penDown.
lineStart := location.
str do:
[:char |
char = Character cr ifTrue:
[self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
ifFalse:
+ [ | charStart pix rowStart form backgroundCode |
- [ | charStart pix rowStart form bb backgroundCode |
form := font characterFormAt: char.
backgroundCode := 1<< (form depth // 3 * 3) - 1.
charStart := location.
wasDown ifTrue: [
self up; turn: -90; go: font descent*scale; turn: 90; down.
0 to: form height-1 do:
[:y |
rowStart := location.
- bb := BitBlt current bitPeekerFromForm: form.
pix := RunArray newFrom:
+ ((0 to: form width-1) collect: [:x | form pixelAt: x@y]).
- ((0 to: form width-1) collect: [:x | bb pixelAt: x@y]).
pix runs with: pix values do:
[:run :value |
value = backgroundCode
ifTrue: [self up; go: run*scale; down]
ifFalse: [self go: run*scale]].
self place: rowStart; up; turn: 90; go: scale; turn: -90; down].
].
self place: charStart; up; go: form width*scale; down].
].
wasDown ifFalse: [self up]
"
Display restoreAfter:
[Pen new squareNib: 2; color: Color red; turn: 45;
print: 'The owl and the pussycat went to sea
in a beautiful pea green boat.' withFont: TextStyle defaultFont]
"!
Item was changed:
----- Method: StrikeFont>>bonk:with: (in category 'emphasis') -----
bonk: glyphForm with: bonkForm
"Bonking means to run through the glyphs clearing out black pixels
between characters to prevent them from straying into an adjacent
character as a result of, eg, bolding or italicizing"
"Uses the bonkForm to erase at every character boundary in glyphs."
| bb offset x |
offset := bonkForm offset x.
+ bb := BitBlt toForm: glyphForm.
- bb := BitBlt current toForm: glyphForm.
bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox;
combinationRule: Form erase; destY: 0.
x := self xTable.
(x isMemberOf: SparseLargeTable) ifTrue: [
x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
] ifFalse: [
1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits].
].
!
Item was changed:
----- Method: StrikeFont>>displayLine:at: (in category 'displaying') -----
displayLine: aString at: aPoint
"Display the characters in aString, starting at position aPoint."
self characters: (1 to: aString size)
in: aString
displayAt: aPoint
clippedBy: Display boundingBox
rule: Form over
fillColor: nil
kernDelta: 0
+ on: (BitBlt toForm: Display).
- on: (BitBlt current toForm: Display).
!
Item was removed:
- ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') -----
- justifiedPadFor: spaceIndex font: aFont
- "Compute the width of pad for a given space in a line of justified text."
-
- | pad |
- internalSpaces = 0 ifTrue: [^0].
- ^(aFont notNil and:[aFont isSubPixelPositioned])
- ifTrue:[paddingWidth * 1.0 / internalSpaces]
- ifFalse:[
- pad := paddingWidth // internalSpaces.
- spaceIndex <= (paddingWidth \\ internalSpaces)
- ifTrue: [pad + 1]
- ifFalse: [pad]]!
Item was changed:
----- Method: WarpBlt class>>current (in category 'instance creation') -----
current
"Return the class currently to be used for WarpBlt"
+ ^self!
- ^Display defaultWarpBltClass!
Item was changed:
----- Method: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') -----
warpBitsSmoothing: n sourceMap: sourceMap
+ | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne poker pix nSteps |
- | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps |
<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
"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).
+ poker := BitBlt bitPokerToForm: destForm.
- 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: (sourceForm pixelAt: sp // fixedPtOne asPoint)]
- 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:
+ (sourceForm pixelAt: sp
- (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]!
1
0