Squeak-dev March 2013

squeak-dev@lists.squeakfoundation.org

73 participants
283 discussions

Re: [squeak-dev] The Inbox: Installer-Core-fbs.366.mcz
by Frank Shearar 25 Mar '13

25 Mar '13

On 18 March 2013 11:46, <commits(a)source.squeak.org> wrote: > Frank Shearar uploaded a new version of Installer-Core to project The Inbox: > http://source.squeak.org/inbox/Installer-Core-fbs.366.mcz > > ==================== Summary ==================== > > Name: Installer-Core-fbs.366 > Author: fbs > Time: 18 March 2013, 11:46:52.277 am > UUID: f665ad84-81d3-4337-8527-4c5f320ec2ab > Ancestors: Installer-Core-fbs.365 > > InstallerGitHub lets you install source stored in a GitHub repository. It detects FileTree repositories (through the .filetree marker file) and otherwise assumes chunk format. > > It will lazily pull in WebClient, SqueakSSL and FileTree as and when necessary. Note that since GitHub uses SSL everywhere, you MUST have the SqueakSSL plugin installed in your VM to use this class. I've actually used this, and it seems to work: it's now in good enough shape for other folk to beat on it. Dale, if you've a moment spare, I'd particularly appreciate any comments you might have on my use/abuse of FileTree classes. I want to be able to pull in sources stored on GitHub without worrying about the file system mapping someone chose to use, whether Gitocello or Filetree or other. (And, in particular, I'd like to keep things loose enough that I can experiment with alternative fileout syntaxes.) Thanks! frank

1 2

The Inbox: Graphics-tpr.205.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

Bert Freudenberg uploaded a new version of Graphics to project The Inbox: http://source.squeak.org/inbox/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

The Inbox: Monticello-cg.529.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

Claus Gittinger uploaded a new version of Monticello to project The Inbox: http://source.squeak.org/inbox/Monticello-cg.529.mcz ==================== Summary ==================== Name: Monticello-cg.529 Author: cg Time: 25 March 2013, 2:10:09.446 pm UUID: 0bcc62fe-400b-4dba-8d91-6dc1aefbbcbf Ancestors: Monticello-cg.528 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-bf.527 =============== 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

BitBltPlugin>primitivePixelValueAt support
by tim Rowledge 25 Mar '13

25 Mar '13

Eliot had the simple but brilliant idea to move the bitblt plugin to be a subclass of SmartSyntaxInterpreterPlugin and just copy my primitivePixelValueAt code into it. It works, at least so far as I can tell from running it and the BitBLt tests in TestRunner. In order to save some of the changes to support it I need access to the http://www.squeaksource.com/Balloon3D repository - or a volunteer to cross-losd my two whole method changes. And just now I managed to crush the image completely so I'll have to rework all this tomorrow and hope that in the interim nobody does anything silly like installing the partially dealt with changes. Sigh. Sorry about that. tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim When all else fails, let a = 7. If that doesn't help, then read the manual.

3 4

Squeak Community Monday - today
by Bert Freudenberg 25 Mar '13

25 Mar '13

Two weeks ago we had lots of fun talking about everything from the VM (several VM hackers stopped by) over OpenQWAQ / Immersive Terf (3D stuff is always fascinating) and tablet UIs (the next big thing is here already) to Metacello and git (with Dale, our cross-dialect hero). But mostly we had fun :) Today we're opening a hangout again for 24 hours so everyone worldwide can get their chance: https://plus.google.com/events/cgrv2ob01fsga5ppbunjdg55fnk Feel free to drop by and say hello! - Bert -

1 0

"Chain" to a different image?
by Jim Rosenberg 25 Mar '13

25 Mar '13

Is there a way from inside Squeak to "chain" to a different image? (I.e. to load an image whose name is determined by a method of a class in the current image?) I'm guessing this has to be handled at the operating system outside of Squeak ... -Thanks, Jim

2 1

Daily Commit Log
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2013-March/005809.html Name: Graphics-tpr.205 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 =============================================

1 0

New catalog entry for Seaside 3.0.3
by Chris Muller 24 Mar '13

24 Mar '13

Hi Tobias, I made new Community-Supported catalog entries for: DynamicBindings ("4.4" and "head") KomHttpServer ("4.4") Grease ("1.1.0" and "head") Sport (already up-to-date, no action taken) Seaside ("3.0.3") These each consume with single-click (necessary pre-reqs are loaded automatically for each package). Installing the head versions always perform a merge, similar to updating trunk packages. I didn't know what version to make for DynamicBindings and KomHttpServer so I just made them the same as the Squeak version they're for. I didn't make head versions of KomHttpServer or Seaside because I wanted to ask your (and others') opinions about it. If Seaside Development Team is still putting out Squeak versions and using Metacello to keep that managed, our catalog entries should definitely reflect that. Otherwise, it's worth asking, what is the best way for us as a community to keep up a dependably working version of Seaside for Squeak? Do you know why the Metacello scripts keep failing for stuff that was once working? Best, Chris On Tue, Feb 26, 2013 at 7:29 AM, Tobias Pape <Das.Linux(a)gmx.de> wrote: > Hi again Seasiders > > > Anfang der weitergeleiteten Nachricht: > >> Von: Tobias Pape <Das.Linux(a)gmx.de> >> Betreff: [Seaside] Making seaside load in Squeak again. >> Datum: 26. Februar 2013 09:42:56 MEZ >> An: Seaside - general discussion <seaside(a)lists.squeakfoundation.org> >> Kopie: The general-purpose Squeak developers list <squeak-dev(a)lists.squeakfoundation.org> >> Antwort an: Seaside - general discussion <seaside(a)lists.squeakfoundation.org> >> >> Hey Seasiders >> >> I am trying to prepare a stable Seaside Image for Squeak 4.4 >> and just tried loading via the Metacello configuration >> (Like this: >> >> Installer ss >> project: 'MetacelloRepository'; >> install: 'ConfigurationOfSeaside30'. >> ((Smalltalk at: #ConfigurationOfSeaside30 project) version: #stable) load >> >> ) >> >> This fails, as there is a dependency on Zinc #stable in >> #squeakCommon. Also, I think it is worthwhile to add WebCilent >> to the Adaptors for, at least, Squeak, if not Pharo, too. >> >> I have seen that there is progress for that in the Seaside31 repository, >> especially for the 3.1 version of Seaside. > > In my effort to see what I can do I succeeded in > Running Seaside 3.1 atop Squeak 4.4 (I needed to bring an interim Grease 1.1.1 version for that) > > You load [1] > http://netshed.de/seaside/ConfigurationOfGrease-topa.191.mcz > http://netshed.de/seaside/ConfigurationOfSeaside30-topa.415.mcz > and then you can DoIt > > ((Smalltalk at: #ConfigurationOfSeaside30) project version: '3.1.0') load: #(Development OmniBrowser Swazoo WebClient Welcome). > (Smalltalk at: #WAServerAdaptorBrowser) open > > in a fresh Squeak4.4-12327. > (Then rightclick in the Seaside Control Panel and 'Add adaptor', a WebServer Adaptor, > which uses WebClient. Then go to localhost:8080 and be happy.) > > Now I will try to work on Seaside 3.0. > >>> > To any Seaside dev, please consider merging my versions :) > << > > Best > -Tobias > > [1] this is no MC repo, I just don't have access to the Seaside Repos and didn't want to pollute > any MetacelloRepository.

8 50

SPLASH-13 Call for Workshop Proposals
by Robert Hirschfeld 24 Mar '13

24 Mar '13

Subject: Extended deadline for SPLASH 2013 workshop proposals: July 1st *** Call for Workshop Proposals *** for ACM Conference on Systems, Programming, Languages, and Applications: Software for Humanity (SPLASH) 2013 Indianapolis, Indiana, October 26-31, 2013 The reviewing process for SPLASH Workshop proposals has been changed to allow for a FIRST-COME FIRST-SERVED SCHEME using short proposals that can be submitted over an extended period of time: - March 28, 2013: START of reviewing period for submitted proposals - July 1, 2013: DEADLINE for proposal submissions Workshop proposals can be submitted STARTING from March 28, 2013, and authors will be notified about acceptance or rejection of the proposal within about a week's time. As long as there is enough space, high-quality proposals can be submitted and accepted until July 1, 2013. Please find the complete call for proposals below, also found at http://splashcon.org/2013/cfp/due-march-28-2013/644-workshops ---------------------------------------------------------------------- WORKSHOPS: Call for Proposals Following its long-standing tradition, SPLASH 2013 will host a variety of high-quality workshops, allowing their participants to meet and discuss research questions with peers, to mature new and exciting ideas, and to build up communities and start new collaborations. SPLASH workshops complement the main tracks of the conference and provide meetings in a smaller and more specialized setting. Workshops cultivate new ideas and concepts for the future, optionally recorded in formal proceedings. Note the changed submission and review procedure this year, a first-come first-serve process with lightweight proposals. The ACM International Conference on Systems, Programming, Languages and Applications: Software for Humanity (SPLASH) is sponsored by ACM SIGPLAN. SPLASH is the home of OOPSLA Research Papers, Onward!, and the Dynamic Languages Symposium, among other events. TOPICS We encourage proposals for workshops on any of the topics relevant to SPLASH. If there is a topic relevant to SPLASH that you feel passionate about and you want to connect with others who have similar interests, you should consider submitting a proposal to organize a workshop! The exact format of the workshop can be defined by the proposal submitters, and we more than welcome new, maybe even unconventional ideas for workshop formats. The following suggestions may serve as a starting point for possible workshop formats: * Mini-conferences provide their participants the possibility to present their work to other domain experts. The smaller and more specialized setting of the workshop allows for more extensive Q&A sessions and facilitates ample, maybe post-workshop, discussions. Typically, presentations of work-in-progress as well as of completed projects are welcome, and the workshop may result in formal proceedings. * Retreats act as a platform for domain experts to gather with the purpose of tackling the issues of a predetermined research agenda. Those gatherings are highly interactive and goal-oriented, allowing their participants to address open challenges in their domain, to explore new, uncharted ideas, and to (maybe even) uncover new, promising research domains. Other common activities include poster sessions, hands-on practical work, and focus groups. Proposal submitters can direct any open questions about workshop formats to the workshop chairs (see below). Workshops that result in research papers and that implement a SIGPLAN-approved selection process may be archived as formal proceedings in the ACM Digital Library; note that only workshops submitted before April 28th are eligible for this option. SUBMISSION SPLASH workshop proposals can be submitted either as PDF files or plain text files and include the following information: (1) Title and desired abbreviation: If the workshop is accepted, this will be used for advertising purposes. (2) Main theme and goals: the main topic and goals of the workshop, the workshop's relevance to the SPLASH community, as well as the workshop's format (e.g., mini-conference, retreat - contact workshop chairs for questions/suggestions). (3) Abstract: a 150-word abstract that summarizes the theme and goals of the workshop. If the workshop is accepted, this abstract will be used for advertising purposes. (4) Organizers: workshop organizers are responsible for advertising the workshop (e.g., creating the anchoring website for the workshop and sending CfPs to relevant mailing lists), organizing the paper reviewing process (e.g., by forming a small program committee), running the workshop, and collating any results of the workshop for dissemination. The proposal should indicate the names, affiliations, and contact details of the workshop organizers as well as a primary organizer and contact person (primary organizer and contact person do not need to be the same persons). For each organizer, the proposal should describe his/her background (expertise in the area and previous experience in running workshops) and also identify his/her responsibilities for the workshop. Once a workshop proposal is accepted, the workshop organizers are asked to provide further details, such as the anticipated attendance, planned advertisement, special requirements, etc. EVALUATION CRITERIA Workshop proposals will be selected on a first-come first-served basis. Evaluation of submitted proposals starts after March 28 2013. Proposals submitted after that date may be selected based on their quality and provided there is space available. The following questions may be helpful in devising a high-quality proposal: * Are there at least two organizers and do they represent a reasonably varied cross-section of the community close to the topic? * Does the abstract present a compelling case for the importance of the topic area? * Are the goals of the workshop expressed clearly? * Is the topic likely to be attractive to SPLASH attendees? * Does the chosen format encourage a high level of interaction between the participants? * Is a workshop the right forum to address the theme and goals or does the proposal fit better into another type of SPLASH event? FOR MORE INFORMATION For additional information, clarification, or answers to questions please contact the Workshops Chair, Stephanie Balzer and Ulrik Schultz, at workshops(a)splashcon.org. WORKSHOPS COMMITTEE * Stephanie Balzer, CMU, USA (chair) * Ulrik Schultz, University of Southern Denmark, Denmark (chair) * Ademar Aguiar, University of Porto, Portugal * Dave Thomas, Bedarra Research Labs, USA * Eric Van Wyk, University of Minnesota, USA * Erik Ernst, University of Aarhus, Denmark * Frank Tip, University of Waterloo, Canada * Gavin Bierman, Microsoft Research, UK * Robert Hirschfeld, University of Potsdam, Germany

3 2

The Trunk: Graphics-tpr.205.mcz
by commits＠source.squeak.org 24 Mar '13

24 Mar '13

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

← Newer
1
...
5
6
7
8
9
10
11
...
29
Older →

Jump to page: