Squeak-dev March 2013

squeak-dev@lists.squeakfoundation.org

73 participants
283 discussions

The Trunk: ST80-tpr.143.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

tim Rowledge uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-tpr.143.mcz ==================== Summary ==================== Name: ST80-tpr.143 Author: tpr Time: 25 March 2013, 2:17:03.697 pm UUID: aec5d9ea-0e27-4409-9900-6b40a117c305 Ancestors: ST80-dtl.142 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against ST80-dtl.142 =============== Item was changed: ----- Method: ControlManager>>restore:below:without: (in category 'displaying') ----- restore: aRectangle below: index without: aView "Restore all windows visible in aRectangle, but without aView" | view | view := (scheduledControllers at: index) view. view == aView ifTrue: [index >= scheduledControllers size ifTrue: [^ self]. ^ self restore: aRectangle below: index+1 without: aView]. + view displayOn: ((BitBlt toForm: Display) clipRect: aRectangle). - view displayOn: ((BitBlt current toForm: Display) clipRect: aRectangle). index >= scheduledControllers size ifTrue: [^ self]. (aRectangle areasOutside: view windowBox) do: [:rect | self restore: rect below: index + 1 without: aView]! Item was changed: ----- Method: FormEditor>>repeatCopy (in category 'editing tools') ----- repeatCopy "As long as the red button is pressed, copy the source form onto the display screen." | drawingWasChanged | drawingWasChanged := false. [sensor redButtonPressed] whileTrue: + [(BitBlt destForm: Display sourceForm: form halftoneForm: color - [(BitBlt current destForm: Display sourceForm: form halftoneForm: color combinationRule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] ifFalse: [mode]) destOrigin: self cursorPoint sourceOrigin: 0@0 extent: form extent clipRect: view insetDisplayBox) colorMap: (Bitmap with: 0 with: 16rFFFFFFFF); copyBits. drawingWasChanged := true. ]. drawingWasChanged ifTrue: [hasUnsavedChanges contents: true.]! Item was changed: ----- Method: Paragraph>>caretFormForDepth: (in category 'selecting') ----- caretFormForDepth: depth "Return a caret form for the given depth." "(Paragraph new caretFormForDepth: Display depth) displayOn: Display at: 0@0 rule: Form reverse" | box f bb map | box := CaretForm boundingBox. f := Form extent: box extent depth: depth. map := (Color cachedColormapFrom: CaretForm depth to: depth) copy. map at: 1 put: (Color transparent pixelValueForDepth: depth). map at: 2 put: (Color quickHighLight: depth) first. "pixel value for reversing" + bb := BitBlt toForm: f. - bb := BitBlt current toForm: f. bb sourceForm: CaretForm; sourceRect: box; destOrigin: 0@0; colorMap: map; combinationRule: Form over; copyBits. ^ f!

1 0

The Trunk: Multilingual-tpr.159.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

tim Rowledge uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-tpr.159.mcz ==================== Summary ==================== Name: Multilingual-tpr.159 Author: tpr Time: 25 March 2013, 2:15:40.343 pm UUID: 47c427a1-a8dd-4675-ada8-8898a73411e0 Ancestors: Multilingual-nice.158 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against Multilingual-nice.158 =============== Item was changed: ----- Method: StrikeFontSet>>displayLine:at: (in category 'as yet unclassified') ----- 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). !

1 0

The Trunk: MorphicExtras-tpr.106.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

tim Rowledge uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-tpr.106.mcz ==================== Summary ==================== Name: MorphicExtras-tpr.106 Author: tpr Time: 25 March 2013, 2:14:11.755 pm UUID: fa05ed2e-81a1-482b-9d66-365fd51319f0 Ancestors: MorphicExtras-nice.105 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against MorphicExtras-nice.105 =============== Item was changed: ----- Method: PaintBoxMorph>>init3 (in category 'initialization') ----- init3 "Just a record of how we loaded in the latest paintbox button images" | bb pic16Bit aa blt thin | self loadoffImage: 'etoy_default.gif'. self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [button offImage: nil] ifFalse: [button position: button position + (100 @ 0)]]. (bb := self submorphNamed: #keep:) position: bb position + (100 @ 0). (bb := self submorphNamed: #toss:) position: bb position + (100 @ 0). (bb := self submorphNamed: #undo:) position: bb position + (100 @ 0). "Transparent is (Color r: 1.0 g: 0 b: 1.0)" self moveButtons. self loadOnImage: 'etoy_in.gif'. AllOnImage := nil. 'save space'. self loadPressedImage: 'etoy_in.gif'. AllPressedImage := nil. 'save space'. self loadCursors. "position the stamp buttons" stampHolder stampButtons owner last delete. stampHolder pickupButtons last delete. stampHolder stampButtons: (stampHolder stampButtons copyFrom: 1 to: 3). stampHolder pickupButtons: (stampHolder pickupButtons copyFrom: 1 to: 3). stampHolder pickupButtons do: [:button | | rect | "PopUpMenu notify: 'Rectangle for ',sel." rect := Rectangle fromUser. button bounds: rect "image is nil"]. "| rect lay |" stampHolder clear. stampHolder stampButtons do: [:button | | lay rect | button offImage: nil; pressedImage: nil. lay := button owner. "PopUpMenu notify: 'Rectangle for ',sel." rect := Rectangle fromUser. button image: (Form fromDisplay: (rect insetBy: 2)). lay borderWidth: 2. lay bounds: rect "image is nil"]. "| pic16Bit blt aa on |" pic16Bit := GIFReadWriter formFromFileNamed: 'etoy_in.gif'. "really 8" aa := Form extent: OriginalBounds extent depth: 8. + blt := BitBlt toForm: aa. - blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. "Collect all the images for the buttons in the on state" stampHolder pickupButtons do: [:button | | on | on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors. on copy: (0 @ 0 extent: button extent) from: button topLeft - self topLeft in: aa rule: Form over. button image: on; pressedImage: on; offImage: nil]. self invalidRect: bounds. ((self submorphNamed: #erase:) arguments third) offset: 12 @ 35. ((self submorphNamed: #eyedropper:) arguments third) offset: 0 @ 0. ((self submorphNamed: #fill:) arguments third) offset: 10 @ 44. ((self submorphNamed: #paint:) arguments third) offset: 3 @ 3. "unused" ((self submorphNamed: #rect:) arguments third) offset: 6 @ 17. ((self submorphNamed: #ellipse:) arguments third) offset: 5 @ 4. ((self submorphNamed: #polygon:) arguments third) offset: 5 @ 4. ((self submorphNamed: #line:) arguments third) offset: 5 @ 17. ((self submorphNamed: #star:) arguments third) offset: 2 @ 5. thumbnail delete. thumbnail := nil. (submorphs select: [:e | e class == RectangleMorph]) first bounds: Rectangle fromUser. ((submorphs select: [:e | e class == RectangleMorph]) first) borderWidth: 1; borderColor: Color black. "| thin |" submorphs do: [:ss | ss class == ImageMorph ifTrue: [thin := ss "first"]]. colorMemoryThin := thin! Item was changed: ----- Method: PaintBoxMorph>>init4 (in category 'initialization') ----- init4 "Just a record of how Ted loaded in the paintbox button images, Feb 98" | bb im pp newImage pic24Bit picNewBit blt | "self loadoffImage: 'roundedPalette3.bmp'." pic24Bit := GIFReadWriter formFromServerFile: 'updates/137roundedPalette3.bmp'. picNewBit := Form extent: pic24Bit extent depth: 16. pic24Bit displayOn: picNewBit. OriginalBounds := picNewBit boundingBox. AllOffImage := Form extent: OriginalBounds extent depth: 16. + blt := BitBlt toForm: AllOffImage. - blt := BitBlt current toForm: AllOffImage. blt sourceForm: picNewBit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. AllOffImage mapColor: Color transparent to: Color black. self image: AllOffImage. self invalidRect: bounds. self submorphsDo: [:button | button position: button position + (10 @ 10)]. (im := submorphs at: 28) class == ImageMorph ifTrue: [ im position: im position + (2 @ 0)]. "color picker" "exercise it once" (bb := self submorphNamed: #keep:) position: bb position + (0 @ 25). (bb := self submorphNamed: #toss:) position: bb position + (0 @ 25). (bb := self submorphNamed: #undo:) position: bb position + (0 @ -25). (bb := self submorphNamed: #clear:) position: bb position + (0 @ -25). (bb := self submorphNamed: #undo:) position: bb position + (0 @ -69). (bb := self submorphNamed: #clear:) position: bb position + (0 @ -69). self submorphsDo: [:button | button class == AlignmentMorph ifTrue: [ button position: button position + (0 @ 25)]. (button printString includesSubString: 'stamp:') ifTrue: [ button position: button position + (0 @ 25)]]. (bb := self submorphNamed: #prevStamp:) position: bb position + (0 @ 25). (bb := self submorphNamed: #nextStamp:) position: bb position + (0 @ 25). bb := self submorphNamed: #keep:. newImage := bb pressedImage copy: (0 @ 4 corner: (bb pressedImage boundingBox extent)). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (4 @ 1). pp := (bb := self submorphNamed: #toss:) pressedImage. newImage := pp copy: (0 @ 4 corner: (bb pressedImage extent - (3 @ 0))). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (3 @ 1). pp := (bb := self submorphNamed: #undo:) pressedImage. newImage := pp copy: (0 @ 0 corner: (bb pressedImage extent - (3 @ 5))). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (3 @ -1). pp := (bb := self submorphNamed: #clear:) pressedImage. newImage := pp copy: (0 @ 0 corner: (bb pressedImage extent - (0 @ 5))). bb onImage: newImage. bb pressedImage: newImage. bb extent: newImage extent. bb position: bb position + (3 @ -1). pic24Bit := GIFReadWriter formFromServerFile: 'updates/137pencil.bmp'. picNewBit := Form extent: pic24Bit extent depth: 16. pic24Bit displayOn: picNewBit. newImage := picNewBit as8BitColorForm. newImage transparentColor: (Color r: 0 g: 0 b: 0). (bb := self submorphNamed: #erase:) pressedImage: newImage; onImage: newImage; extent: newImage extent. bb position: bb position + (-11 @ -1). ! Item was changed: ----- Method: PaintBoxMorph>>loadOffForm: (in category 'initialization') ----- loadOffForm: pic16Bit "Prototype loadOffForm: (Smalltalk imageImports at: #offPaletteJapanese)" | blt | OriginalBounds := pic16Bit boundingBox. AllOffImage := Form extent: OriginalBounds extent depth: 16. + blt := BitBlt toForm: AllOffImage. - blt := BitBlt current toForm: AllOffImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. AllOffImage mapColor: Color blue to: Color transparent. self image: AllOffImage. AllOffImage := nil. self invalidRect: bounds ! Item was changed: ----- Method: PaintBoxMorph>>loadOnImage: (in category 'initialization') ----- loadOnImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadOnImage: 'NoSh:=on.bmp'. AllOnImage := nil. 'save space'. " | pic16Bit blt aa type | type := 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" := GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa := AllOnImage := Form extent: OriginalBounds extent depth: 8. + blt := BitBlt toForm: aa. - blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. ]. type = 'bmp' ifTrue: [ pic16Bit := (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa := AllOnImage := Form extent: OriginalBounds extent depth: 16. + blt := BitBlt toForm: aa. - blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" self allMorphsDo: [:button | | on | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors] ifFalse: [on := Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button onImage: on]]. self invalidRect: bounds. ! Item was changed: ----- Method: PaintBoxMorph>>loadPressedForm: (in category 'initialization') ----- loadPressedForm: pic16Bit "Prototype loadPressedForm: (Smalltalk imageImports at: #pressedPaletteJapanese)" | blt | AllPressedImage := AllPressedImage := Form extent: OriginalBounds extent depth: 16. + blt := BitBlt toForm: AllPressedImage. - blt := BitBlt current toForm: AllPressedImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. AllPressedImage mapColor: Color black to: Color transparent. self allMorphsDo: [:button | | on | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [on := Form extent: button extent depth: 16. on copy: (0 @ 0 extent: button extent) from: button topLeft - self topLeft in: AllPressedImage rule: Form over. button pressedImage: on]]. AllPressedImage := nil. self invalidRect: bounds ! Item was changed: ----- Method: PaintBoxMorph>>loadPressedImage: (in category 'initialization') ----- loadPressedImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadPressedImage: 'NoSh:=on.bmp'. AllPressedImage := nil. 'save space'. " | pic16Bit blt aa type | type := 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" := GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa := AllPressedImage := Form extent: OriginalBounds extent depth: 8. + blt := BitBlt toForm: aa. - blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. ]. type = 'bmp' ifTrue: [ pic16Bit := (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa := AllPressedImage := Form extent: OriginalBounds extent depth: 16. + blt := BitBlt toForm: aa. - blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" self allMorphsDo: [:button | | on | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors] ifFalse: [on := Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button pressedImage: on]]. self invalidRect: bounds. ! Item was changed: ----- Method: PaintBoxMorph>>loadoffImage: (in category 'initialization') ----- loadoffImage: fileName "Read in and convert the background image for the paintBox. All buttons off. A .bmp 24-bit image." " Prototype loadoffImage: 'roundedPalette3.bmp' " | pic16Bit blt type getBounds | type := 'bmp'. " gif or bmp " getBounds := 'fromPic'. "fromUser = draw out rect of paintbox on image" "fromOB = just read in new bits, keep same size and place as last time." "fromPic = picture is just the PaintBox, use its bounds" type = 'gif' ifTrue: [ pic16Bit "really 8" := GIFReadWriter formFromFileNamed: fileName. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds := Rectangle fromUser]. getBounds = 'fromPic' ifTrue: [OriginalBounds := pic16Bit boundingBox]. ]. "Use OriginalBounds as it was last time" type = 'bmp' ifTrue: [ pic16Bit := (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. getBounds = 'fromUser' ifTrue: ["Just first time, collect the bounds" pic16Bit display. OriginalBounds := Rectangle fromUser]. "Use OriginalBounds as it was last time" (getBounds = 'fromPic') ifTrue: [OriginalBounds := pic16Bit boundingBox]. AllOffImage := Form extent: OriginalBounds extent depth: 16. ]. type = 'gif' ifTrue: [ AllOffImage := ColorForm extent: OriginalBounds extent depth: 8. AllOffImage colors: pic16Bit colors]. + blt := BitBlt toForm: AllOffImage. - blt := BitBlt current toForm: AllOffImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. type = 'bmp' ifTrue: [AllOffImage mapColor: Color transparent to: Color black]. self image: AllOffImage. self invalidRect: bounds. ! Item was changed: ----- Method: ScreeningMorph>>fullDrawOn: (in category 'drawing') ----- fullDrawOn: aCanvas | mergeForm | submorphs isEmpty ifTrue: [^super fullDrawOn: aCanvas]. (aCanvas isVisible: self fullBounds) ifFalse: [^self]. (submorphs size = 1 or: [displayMode == #showScreenOnly]) ifTrue: [^aCanvas fullDrawMorph: self screenMorph]. displayMode == #showSourceOnly ifTrue: [^aCanvas fullDrawMorph: self sourceMorph]. displayMode == #showScreenOverSource ifTrue: [aCanvas fullDrawMorph: self sourceMorph. ^aCanvas fullDrawMorph: self screenMorph]. displayMode == #showScreened ifTrue: [aCanvas fullDrawMorph: self screenMorph. self flag: #fixCanvas. "There should be a more general way than this" mergeForm := self sourceMorph imageFormForRectangle: self screenMorph bounds. + (BitBlt toForm: mergeForm) - (BitBlt current toForm: mergeForm) copyForm: self screenForm to: 0 @ 0 rule: Form and colorMap: (Bitmap with: 0 with: 4294967295). aCanvas paintImage: mergeForm at: self screenMorph position]!

1 0

The Trunk: Morphic-tpr.645.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

tim Rowledge uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-tpr.645.mcz ==================== Summary ==================== Name: Morphic-tpr.645 Author: tpr Time: 25 March 2013, 2:12:47.714 pm UUID: 26d49d4a-210b-4691-b474-f1e1fe3c1e35 Ancestors: Morphic-fbs.644 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against Morphic-fbs.644 =============== Item was changed: ----- Method: BalloonCanvas>>image:at:sourceRect:rule: (in category 'private') ----- image: aForm at: aPoint sourceRect: sourceRect rule: rule | warp dstRect srcQuad dstOffset center | (self ifNoTransformWithIn: sourceRect) & false ifTrue:[^super image: aForm at: aPoint sourceRect: sourceRect rule: rule]. dstRect := (transform localBoundsToGlobal: (aForm boundingBox translateBy: aPoint)). dstOffset := 0@0. "dstRect origin." "dstRect := 0@0 corner: dstRect extent." center := 0@0."transform globalPointToLocal: dstRect origin." srcQuad := transform globalPointsToLocal: (dstRect innerCorners). srcQuad := srcQuad collect:[:pt| pt - aPoint]. + warp := (WarpBlt toForm: form) - warp := (WarpBlt current toForm: form) sourceForm: aForm; cellSize: 2; "installs a new colormap if cellSize > 1" combinationRule: Form over. warp copyQuad: srcQuad toRect: (dstRect translateBy: dstOffset). self frameRectangle: (aForm boundingBox translateBy: aPoint) color: Color green. "... TODO ... create a bitmap fill style from the form and use it for a simple rectangle."! Item was changed: ----- Method: FormCanvas>>portClass (in category 'private') ----- portClass "Return the class used as port" + ^BitBlt asGrafPort! - ^Display defaultBitBltClass asGrafPort! Item was changed: ----- Method: FormCanvas>>privateWarp:transform:at:sourceRect:cellSize: (in category 'private') ----- privateWarp: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize "Warp the given using the appropriate transform and offset." | globalRect sourceQuad warp tfm | tfm := aTransform. globalRect := tfm localBoundsToGlobal: sourceRect. sourceQuad := (tfm sourceQuadFor: globalRect) collect:[:p| p - sourceRect topLeft]. extraOffset ifNotNil:[globalRect := globalRect translateBy: extraOffset]. + warp := (WarpBlt toForm: port destForm) - warp := (WarpBlt current toForm: port destForm) combinationRule: Form paint; sourceQuad: sourceQuad destRect: (globalRect origin corner: globalRect corner+(1@1)); clipRect: port clipRect. warp cellSize: cellSize. warp sourceForm: aForm. warp warpBits! Item was changed: ----- Method: FormCanvas>>showAt:invalidRects: (in category 'other') ----- showAt: pt invalidRects: updateRects | blt | + blt := (BitBlt toForm: Display) - blt := (BitBlt current toForm: Display) sourceForm: form; combinationRule: Form over. updateRects do: [:rect | blt sourceRect: rect; destOrigin: rect topLeft + pt; copyBits]! Item was changed: ----- Method: FormCanvas>>warpFrom:toRect: (in category 'other') ----- warpFrom: sourceQuad toRect: destRect + ^ (WarpBlt toForm: port destForm) - ^ (WarpBlt current toForm: port destForm) combinationRule: Form paint; sourceQuad: sourceQuad destRect: (destRect translateBy: origin); clipRect: clipRect! Item was changed: ----- Method: Morph>>drawRolloverBorderOn: (in category 'drawing') ----- drawRolloverBorderOn: aCanvas | colorToUse offsetToUse myShadow newForm f | colorToUse := self valueOfProperty: #rolloverColor ifAbsent: [Color blue alpha: 0.5]. offsetToUse := self valueOfProperty: #rolloverWidth ifAbsent: [10 @ 10]. self hasRolloverBorder: false. myShadow := self shadowForm. self hasRolloverBorder: true. myShadow offset: 0 @ 0. f := ColorForm extent: myShadow extent depth: 1. myShadow displayOn: f. f colors: {Color transparent. colorToUse}. newForm := Form extent: offsetToUse * 2 + myShadow extent depth: 32. + (WarpBlt toForm: newForm) sourceForm: f; - (WarpBlt current toForm: newForm) sourceForm: f; cellSize: 1; combinationRule: 3; copyQuad: f boundingBox innerCorners toRect: newForm boundingBox. aCanvas translateBy: offsetToUse negated during: [:shadowCanvas | shadowCanvas shadowColor: colorToUse. shadowCanvas paintImage: newForm at: self position]! Item was changed: ----- Method: PasteUpMorph>>flashRects:color: (in category 'world state') ----- flashRects: rectangleList color: aColor "For testing. Flashes the given list of rectangles on the Display so you can watch incremental redisplay at work." "Details: Uses two reverses so that the display is restored to its original state. This is necessary when in deferred update mode." | blt | + blt := (BitBlt toForm: Display) - blt := (BitBlt current toForm: Display) sourceForm: nil; sourceOrigin: 0@0; clipRect: self viewBox; combinationRule: Form reverse. rectangleList do: [:r | | screenRect | screenRect := r translateBy: self viewBox origin. blt destRect: screenRect; copyBits. Display forceToScreen: screenRect; forceDisplayUpdate. (Delay forMilliseconds: 15) wait. blt destRect: screenRect; copyBits. Display forceToScreen: screenRect; forceDisplayUpdate]. ! Item was changed: ----- Method: PolygonMorph>>computeArrowFormAt:from: (in category 'private') ----- computeArrowFormAt: endPoint from: priorPoint "Compute a triangle oriented along the line from priorPoint to endPoint. Then draw those lines in a form and return that form, with appropriate offset" | p1 pts box arrowForm bb origin | pts := self arrowBoundsAt: endPoint from: priorPoint. box := ((pts first rect: pts last) encompass: (pts second)) expandBy: 1. arrowForm := Form extent: box extent asIntegerPoint. + bb := (BitBlt toForm: arrowForm) - bb := (BitBlt current toForm: arrowForm) sourceForm: nil; fillColor: Color black; combinationRule: Form over; width: 1; height: 1. origin := box topLeft. p1 := pts last - origin. pts do: [:p | bb drawFrom: p1 to: p - origin. p1 := p - origin]. arrowForm convexShapeFill: Color black. ^arrowForm offset: box topLeft! Item was changed: ----- Method: PolygonMorph>>filledForm (in category 'private') ----- filledForm "Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1@1 in the form. This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside. Computation of the filled form is done only on demand." | bb origin | closed ifFalse: [^ filledForm := nil]. filledForm ifNotNil: [^ filledForm]. filledForm := Form extent: bounds extent+2. "Draw the border..." + bb := (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black; - bb := (BitBlt current toForm: filledForm) sourceForm: nil; fillColor: Color black; combinationRule: Form over; width: 1; height: 1. origin := bounds topLeft asIntegerPoint-1. self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin to: p2 asIntegerPoint-origin]. "Fill it in..." filledForm convexShapeFill: Color black. (borderColor isColor and: [borderColor isTranslucentColor]) ifTrue: ["If border is stored as a form, then erase any overlap now." filledForm copy: self borderForm boundingBox from: self borderForm to: 1@1 rule: Form erase]. ^ filledForm! Item was changed: ----- Method: ProjectViewMorph>>updateImageFrom: (in category 'drawing') ----- updateImageFrom: sourceForm + (WarpBlt toForm: image) - (WarpBlt current toForm: image) sourceForm: sourceForm; cellSize: 2; "installs a colormap" combinationRule: Form over; copyQuad: (sourceForm boundingBox) innerCorners toRect: image boundingBox. ! Item was changed: ----- Method: SketchMorph>>generateRotatedForm (in category 'drawing') ----- generateRotatedForm "Compute my rotatedForm and offsetWhenRotated." | scalePt smoothPix pair | scalePoint ifNil: [scalePoint := 1 @ 1]. scalePt := scalePoint x abs @ scalePoint y abs. rotationStyle == #none ifTrue: [scalePt := 1 @ 1]. smoothPix := (scalePt x < 1.0 or: [scalePt y < 1.0]) ifTrue: [2] ifFalse: [1]. rotationStyle = #leftRight ifTrue: [self heading asSmallAngleDegrees < 0.0 ifTrue: [scalePt := scalePt x negated @ scalePt y]]. rotationStyle = #upDown ifTrue: [self heading asSmallAngleDegrees abs > 90.0 ifTrue: [scalePt := scalePt x @ scalePt y negated]]. rotatedForm := scalePt = (1 @ 1) ifTrue: [originalForm] ifFalse: ["ar 11/19/2001: I am uncertain what happens in the case of rotationStyle ~~ normal" (rotationStyle == #normal and: [self useInterpolation]) ifTrue: [^self generateInterpolatedForm]. + pair := WarpBlt - pair := WarpBlt current rotate: originalForm degrees: 0 center: originalForm boundingBox center scaleBy: scalePt smoothing: smoothPix. pair first]!

1 0

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

25 Mar '13

tim Rowledge uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-tpr.204.mcz ==================== Summary ==================== Name: Graphics-tpr.204 Author: tpr Time: 25 March 2013, 2:11:52.527 pm UUID: 47bc1ef2-4bb2-4c04-8e9b-6cbe3adba133 Ancestors: Graphics-cbc.203 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against Graphics-cbc.203 =============== Item was changed: ----- Method: BitBlt class>>current (in category 'instance creation') ----- current "Return the class currently to be used for BitBlt" + ^self! - ^Display defaultBitBltClass! Item was changed: ----- Method: ColorForm>>copy: (in category 'copying') ----- copy: aRect "Return a new ColorForm containing the portion of the receiver delineated by aRect." | newForm | newForm := self species extent: aRect extent depth: depth. + ((BitBlt - ((BitBlt current destForm: newForm sourceForm: self fillColor: nil combinationRule: Form over destOrigin: 0@0 sourceOrigin: aRect origin extent: aRect extent clipRect: newForm boundingBox) colorMap: nil) copyBits. colors ifNotNil: [newForm colors: colors copy]. ^ newForm ! Item was changed: ----- Method: ColorForm>>pixelValueAt: (in category 'pixel accessing') ----- pixelValueAt: aPoint "Return the raw pixel value at the given point. Typical clients use colorAt: to get a Color." "Details: To get the raw pixel value, be sure the peeker's colorMap is nil." + ^ (BitBlt bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint - ^ (BitBlt current bitPeekerFromForm: self) colorMap: nil; pixelAt: aPoint ! Item was changed: ----- Method: ColorForm>>twoToneFromDisplay:backgroundColor: (in category 'color manipulation') ----- twoToneFromDisplay: aRectangle backgroundColor: bgColor "Copy one-bit deep ColorForm from the Display using a color map that maps all colors except the background color to black. Used for caching the contents of inactive MVC windows." | map | (width = aRectangle width and: [height = aRectangle height]) ifFalse: [self setExtent: aRectangle extent depth: depth]. "make a color map mapping the background color to zero and all other colors to one" map := Bitmap new: (1 bitShift: (Display depth min: 9)). 1 to: map size do: [:i | map at: i put: 16rFFFFFFFF]. map at: (bgColor indexInMap: map) put: 0. + (BitBlt toForm: self) - (BitBlt current toForm: self) destOrigin: 0@0; sourceForm: Display; sourceRect: aRectangle; combinationRule: Form over; colorMap: map; copyBits. ! Item was changed: ----- Method: DisplayMedium>>fillShape:fillColor:at: (in category 'coloring') ----- fillShape: aShapeForm fillColor: aColor at: location "Fill a region corresponding to 1 bits in aShapeForm with aColor" + ((BitBlt destForm: self sourceForm: aShapeForm fillColor: aColor - ((BitBlt current destForm: self sourceForm: aShapeForm fillColor: aColor combinationRule: Form paint destOrigin: location + aShapeForm offset sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox) colorMap: (Bitmap with: 0 with: 16rFFFFFFFF)) copyBits! Item was changed: ----- Method: DisplayObject>>follow:while:bitsBehind:startingLoc: (in category 'displaying-Display') ----- follow: locationBlock while: durationBlock bitsBehind: initialBitsBehind startingLoc: loc "Move an image around on the Display. Restore the background continuously without causing flashing. The argument, locationBlock, supplies each new location, and the argument, durationBlock, supplies true to continue or false to stop. This variant takes the bitsBehind as an input argument, and returns the final saved saved bits as method value." | location rect1 save1 save1Blt buffer bufferBlt newLoc rect2 bothRects | location := loc. rect1 := location extent: self extent. save1 := initialBitsBehind. + save1Blt := BitBlt toForm: save1. - save1Blt := BitBlt current toForm: save1. buffer := Form extent: self extent*2 depth: Display depth. "Holds overlapping region" + bufferBlt := BitBlt toForm: buffer. - bufferBlt := BitBlt current toForm: buffer. Display deferUpdates: true. self displayOn: Display at: location rule: Form paint. Display deferUpdates: false; forceToScreen: (location extent: self extent). [durationBlock value] whileTrue: [ newLoc := locationBlock value. newLoc ~= location ifTrue: [ rect2 := newLoc extent: self extent. bothRects := rect1 merge: rect2. (rect1 intersects: rect2) ifTrue: [ "when overlap, buffer background for both rectangles" bufferBlt copyFrom: bothRects in: Display to: 0@0. bufferBlt copyFrom: save1 boundingBox in: save1 to: rect1 origin - bothRects origin. "now buffer is clean background; get new bits for save1" save1Blt copy: (0@0 extent: self extent) from: rect2 origin - bothRects origin in: buffer. self displayOnPort: bufferBlt at: rect2 origin - bothRects origin rule: Form paint. Display deferUpdates: true. Display copy: bothRects from: 0@0 in: buffer rule: Form over. Display deferUpdates: false; forceToScreen: bothRects] ifFalse: [ "when no overlap, do the simple thing (both rects might be too big)" Display deferUpdates: true. Display copy: (location extent: save1 extent) from: 0@0 in: save1 rule: Form over. save1Blt copyFrom: rect2 in: Display to: 0@0. self displayOn: Display at: newLoc rule: Form paint. Display deferUpdates: false; forceToScreen: (location extent: save1 extent); forceToScreen: (newLoc extent: self extent)]. location := newLoc. rect1 := rect2]]. ^ save1 displayOn: Display at: location ! Item was changed: ----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'displaying') ----- copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf + (BitBlt - (BitBlt current destForm: self sourceForm: sf fillColor: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: rect origin extent: rect extent clipRect: (clipRect intersect: clippingBox)) copyBits! Item was changed: ----- Method: DisplayScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'displaying') ----- copyBits: rect from: sf at: destOrigin clippingBox: clipRect rule: cr fillColor: hf map: map + ((BitBlt - ((BitBlt current destForm: self sourceForm: sf fillColor: hf combinationRule: cr destOrigin: destOrigin sourceOrigin: rect origin extent: rect extent clipRect: (clipRect intersect: clippingBox)) colorMap: map) copyBits! Item was changed: ----- Method: Form class>>dotOfSize: (in category 'instance creation') ----- dotOfSize: diameter "Create a form which contains a round black dot." | radius form bb rect centerX centerY centerYBias centerXBias radiusSquared xOverY maxy dx | radius := diameter//2. form := self extent: diameter@diameter offset: (0@0) - (radius@radius). + bb := (BitBlt toForm: form) - bb := (BitBlt current toForm: form) sourceX: 0; sourceY: 0; combinationRule: Form over; fillColor: Color black. rect := form boundingBox. centerX := rect center x. centerY := rect center y. centerYBias := rect height odd ifTrue: [0] ifFalse: [1]. centerXBias := rect width odd ifTrue: [0] ifFalse: [1]. radiusSquared := (rect height asFloat / 2.0) squared - 0.01. xOverY := rect width asFloat / rect height asFloat. maxy := rect height - 1 // 2. "First do the inner fill, and collect x values" 0 to: maxy do: [:dy | dx := ((radiusSquared - (dy * dy) asFloat) sqrt * xOverY) truncated. bb destX: centerX - centerXBias - dx destY: centerY - centerYBias - dy width: dx + dx + centerXBias + 1 height: 1; copyBits. bb destY: centerY + dy; copyBits]. ^ form " Time millisecondsToRun: [1 to: 20 do: [:i | (Form dotOfSize: i) displayAt: (i*20)@(i*20)]] "! Item was changed: ----- Method: Form class>>toothpaste: (in category 'examples') ----- toothpaste: diam "Display restoreAfter: [Form toothpaste: 30]" "Draws wormlike lines by laying down images of spheres. See Ken Knowlton, Computer Graphics, vol. 15 no. 4 p352. Draw with mouse button down; terminate by option-click." | facade ball filter point queue port color q colors colr colr2 | colors := Display depth = 1 ifTrue: [Array with: Color black] ifFalse: [Color red wheel: 12]. facade := Form extent: diam@diam offset: (diam // -2) asPoint. (Form dotOfSize: diam) displayOn: facade at: (diam // 2) asPoint clippingBox: facade boundingBox rule: Form under fillColor: Color white. #(1 2 3) do: [:x | "simulate facade by circles of gray" (Form dotOfSize: x * diam // 5) displayOn: facade at: (diam * 2 // 5) asPoint clippingBox: facade boundingBox rule: Form under fillColor: (Color perform: (#(black gray lightGray) at: x)). "facade displayAt: 50*x@50"]. ball := Form dotOfSize: diam. color := 8. + [port := BitBlt toForm: Display. - [port := BitBlt current toForm: Display. "Expand 1-bit forms to any pixel depth" port colorMap: (Bitmap with: 0 with: 16rFFFFFFFF). queue := OrderedCollection new: 32. 16 timesRepeat: [queue addLast: -20 @ -20]. Sensor waitButton. Sensor yellowButtonPressed ifTrue: [^ self]. filter := Sensor cursorPoint. colr := colors atWrap: (color := color + 5). "choose increment relatively prime to colors size" colr2 := colr alphaMixed: 0.3 with: Color white. [Sensor redButtonPressed or: [queue size > 0]] whileTrue: [filter := filter * 4 + Sensor cursorPoint // 5. point := Sensor redButtonPressed ifTrue: [filter] ifFalse: [-20 @ -20]. port copyForm: ball to: point rule: Form paint fillColor: colr. (q := queue removeFirst) == nil ifTrue: [^ self]. "exit" Display depth = 1 ifTrue: [port copyForm: facade to: q rule: Form erase] ifFalse: [port copyForm: facade to: q rule: Form paint fillColor: colr2]. Sensor redButtonPressed ifTrue: [queue addLast: point]]] repeat. ! Item was changed: ----- Method: Form>>asFormOfDepth: (in category 'converting') ----- asFormOfDepth: d | newForm | d = self depth ifTrue:[^self]. newForm := Form extent: self extent depth: d. + (BitBlt toForm: newForm) - (BitBlt current toForm: newForm) colorMap: (self colormapIfNeededFor: newForm); copy: (self boundingBox) from: 0@0 in: self fillColor: nil rule: Form over. "Special case: For a 16 -> 32 bit conversion fill the alpha channel because it gets lost in translation." (self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255]. ^newForm! Item was changed: ----- Method: Form>>asGrayScale (in category 'converting') ----- asGrayScale "Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)" | f32 srcForm result map bb grays | self depth = 32 ifFalse: [ f32 := Form extent: width@height depth: 32. self displayOn: f32. ^ f32 asGrayScale]. self unhibernate. srcForm := Form extent: (width * 4)@height depth: 8. srcForm bits: bits. result := ColorForm extent: width@height depth: 8. map := Bitmap new: 256. 2 to: 256 do: [:i | map at: i put: i - 1]. map at: 1 put: 1. "map zero pixel values to near-black" + bb := (BitBlt toForm: result) - bb := (BitBlt current toForm: result) sourceForm: srcForm; combinationRule: Form over; colorMap: map. 0 to: width - 1 do: [:dstX | bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height); destOrigin: dstX@0; copyBits]. "final BitBlt to zero-out pixels that were truely transparent in the original" map := Bitmap new: 512. map at: 1 put: 16rFF. + (BitBlt toForm: result) - (BitBlt current toForm: result) sourceForm: self; sourceRect: self boundingBox; destOrigin: 0@0; combinationRule: Form erase; colorMap: map; copyBits. grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0]. grays at: 1 put: Color transparent. result colors: grays. ^ result ! Item was changed: ----- Method: Form>>border:width:rule:fillColor: (in category 'bordering') ----- border: rect width: borderWidth rule: rule fillColor: fillColor "Paint a border whose rectangular area is defined by rect. The width of the border of each side is borderWidth. Uses fillColor for drawing the border." | blt | + blt := (BitBlt toForm: self) combinationRule: rule; fillColor: fillColor. - blt := (BitBlt current toForm: self) combinationRule: rule; fillColor: fillColor. blt sourceOrigin: 0@0. blt destOrigin: rect origin. blt width: rect width; height: borderWidth; copyBits. blt destY: rect corner y - borderWidth; copyBits. blt destY: rect origin y + borderWidth. blt height: rect height - borderWidth - borderWidth; width: borderWidth; copyBits. blt destX: rect corner x - borderWidth; copyBits! Item was changed: ----- Method: Form>>borderFormOfWidth:sharpCorners: (in category 'bordering') ----- borderFormOfWidth: borderWidth sharpCorners: sharpen "Smear this form around and then subtract the original to produce an outline. If sharpen is true, then cause right angles to be outlined by right angles (takes an additional diagonal smears ANDed with both horizontal and vertical smears)." | smearForm bigForm smearPort all cornerForm cornerPort nbrs | self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms." bigForm := self deepCopy. all := bigForm boundingBox. smearForm := Form extent: self extent. + smearPort := BitBlt toForm: smearForm. - smearPort := BitBlt current toForm: smearForm. sharpen ifTrue: [cornerForm := Form extent: self extent. + cornerPort := BitBlt toForm: cornerForm]. - cornerPort := BitBlt current toForm: cornerForm]. nbrs := (0@0) fourNeighbors. 1 to: borderWidth do: [:i | "Iterate to get several layers of 'skin'" nbrs do: [:d | "Smear the self in 4 directions to grow each layer of skin" smearPort copyForm: bigForm to: d rule: Form under]. sharpen ifTrue: ["Special treatment to smear sharp corners" nbrs with: ((2 to: 5) collect: [:i2 | nbrs atWrap: i2]) do: [:d1 :d2 | "Copy corner points diagonally" cornerPort copyForm: bigForm to: d1+d2 rule: Form over. "But only preserve if there were dots on either side" cornerPort copyForm: bigForm to: d1+d1+d2 rule: Form and. cornerPort copyForm: bigForm to: d1+d2+d2 rule: Form and. smearPort copyForm: cornerForm to: 0@0 rule: Form under]. ]. bigForm copy: all from: 0@0 in: smearForm rule: Form over. ]. "Now erase the original shape to obtain the outline" bigForm copy: all from: 0@0 in: self rule: Form erase. ^ bigForm! Item was changed: ----- Method: Form>>copy:from:in:rule: (in category 'copying') ----- copy: destRectangle from: sourcePt in: sourceForm rule: rule "Make up a BitBlt table and copy the bits." + (BitBlt toForm: self) - (BitBlt current toForm: self) copy: destRectangle from: sourcePt in: sourceForm fillColor: nil rule: rule! Item was changed: ----- Method: Form>>copyBits:at:translucent: (in category 'copying') ----- copyBits: sourceForm at: destOrigin translucent: factor "Make up a BitBlt table and copy the bits with the given colorMap." + (BitBlt - (BitBlt current destForm: self sourceForm: sourceForm halftoneForm: nil combinationRule: 30 destOrigin: destOrigin sourceOrigin: 0@0 extent: sourceForm extent clipRect: self boundingBox) copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255) " | f f2 f3 | f := Form fromUser. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy. 0.0 to: 1.0 by: 1.0/32 do: [:t | f3 := f2 deepCopy. f3 copyBits: f at: 0@0 translucent: t. f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait]. "! Item was changed: ----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor: (in category 'copying') ----- copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm "Make up a BitBlt table and copy the bits." + (BitBlt - (BitBlt current destForm: self sourceForm: sourceForm fillColor: aForm combinationRule: rule destOrigin: destOrigin sourceOrigin: sourceRect origin extent: sourceRect extent clipRect: clipRect) copyBits! Item was changed: ----- Method: Form>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'copying') ----- copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: aForm map: map "Make up a BitBlt table and copy the bits. Use a colorMap." + ((BitBlt - ((BitBlt current destForm: self sourceForm: sourceForm fillColor: aForm combinationRule: rule destOrigin: destOrigin sourceOrigin: sourceRect origin extent: sourceRect extent clipRect: clipRect) colorMap: map) copyBits! Item was changed: ----- Method: Form>>copyBits:from:at:colorMap: (in category 'copying') ----- copyBits: sourceRect from: sourceForm at: destOrigin colorMap: map "Make up a BitBlt table and copy the bits with the given colorMap." + ((BitBlt - ((BitBlt current destForm: self sourceForm: sourceForm halftoneForm: nil combinationRule: Form over destOrigin: destOrigin sourceOrigin: sourceRect origin extent: sourceRect extent clipRect: self boundingBox) colorMap: map) copyBits! Item was changed: ----- Method: Form>>displayInterpolatedIn:on: (in category 'displaying') ----- displayInterpolatedIn: aRectangle on: aForm "Display the receiver on aForm, using interpolation if necessary. Form fromUser displayInterpolatedOn: Display. Note: When scaling we attempt to use bilinear interpolation based on the 3D engine. If the engine is not there then we use WarpBlt. " | engine adjustedR | self extent = aRectangle extent ifTrue:[^self displayOn: aForm at: aRectangle origin]. engine := Smalltalk at: #B3DRenderEngine ifPresent: [:engineClass | (engineClass defaultForPlatformOn: aForm)]. engine ifNil:[ "We've got no bilinear interpolation. Use WarpBlt instead" + (WarpBlt toForm: aForm) - (WarpBlt current toForm: aForm) sourceForm: self destRect: aRectangle; combinationRule: 3; cellSize: 2; warpBits. ^self ]. "Otherwise use the 3D engine for our purposes" "there seems to be a slight bug in B3D which the following adjusts for" adjustedR := (aRectangle withRight: aRectangle right + 1) translateBy: 0@1. engine viewport: adjustedR. engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white). engine texture: self. engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect). engine finish.! Item was changed: ----- Method: Form>>displayInterpolatedOn: (in category 'displaying') ----- displayInterpolatedOn: aForm "Display the receiver on aForm, using interpolation if necessary. Form fromUser displayInterpolatedOn: Display. Note: When scaling we attempt to use bilinear interpolation based on the 3D engine. If the engine is not there then we use WarpBlt. " | engine | self extent = aForm extent ifTrue:[^self displayOn: aForm]. engine := Smalltalk at: #B3DRenderEngine ifPresent:[:engineClass| (engineClass defaultForPlatformOn: aForm)]. engine ifNil:[ "We've got no bilinear interpolation. Use WarpBlt instead" + (WarpBlt toForm: aForm) - (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: 3; cellSize: 2; warpBits. ^self ]. "Otherwise use the 3D engine for our purposes" engine viewport: aForm boundingBox. engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white). engine texture: self. engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect). engine finish.! Item was changed: ----- Method: Form>>displayResourceFormOn: (in category 'displaying') ----- displayResourceFormOn: aForm "a special display method for blowing up resource thumbnails" | engine tx cmap blitter | self extent = aForm extent ifTrue:[^self displayOn: aForm]. engine := Smalltalk at: #B3DRenderEngine ifPresent: [:engineClass | engineClass defaultForPlatformOn: aForm]. engine ifNil:[ "We've got no bilinear interpolation. Use WarpBlt instead" + (WarpBlt toForm: aForm) - (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: 3; cellSize: 2; warpBits. ^self ]. tx := self asTexture. + (blitter := BitBlt toForm: tx) - (blitter := BitBlt current toForm: tx) sourceForm: self; destRect: aForm boundingBox; sourceOrigin: 0@0; combinationRule: Form paint. "map transparency to current World background color" (World color respondsTo: #pixelWordForDepth:) ifTrue: [ cmap := Bitmap new: (self depth <= 8 ifTrue: [1 << self depth] ifFalse: [4096]). cmap at: 1 put: (tx pixelWordFor: World color). blitter colorMap: cmap. ]. blitter copyBits. engine viewport: aForm boundingBox. engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white). engine texture: tx. engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect). engine finish. "the above, using bilinear interpolation doesn't leave transparent pixel values intact" + (WarpBlt toForm: aForm) - (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: Form and; colorMap: (Color maskingMap: self depth); warpBits.! Item was changed: ----- Method: Form>>displayScaledOn: (in category 'displaying') ----- displayScaledOn: aForm "Display the receiver on aForm, scaling if necessary. Form fromUser displayScaledOn: Display. " self extent = aForm extent ifTrue:[^self displayOn: aForm]. + (WarpBlt toForm: aForm) - (WarpBlt current toForm: aForm) sourceForm: self destRect: aForm boundingBox; combinationRule: Form paint; cellSize: 2; warpBits.! Item was changed: ----- Method: Form>>drawLine:from:to:clippingBox:rule:fillColor: (in category 'displaying') ----- drawLine: sourceForm from: beginPoint to: endPoint clippingBox: clipRect rule: anInteger fillColor: aForm "Refer to the comment in DisplayMedium|drawLine:from:to:clippingBox:rule:mask:." | dotSetter | "set up an instance of BitBlt for display" + dotSetter := BitBlt - dotSetter := BitBlt current destForm: self sourceForm: sourceForm fillColor: aForm combinationRule: anInteger destOrigin: beginPoint sourceOrigin: 0 @ 0 extent: sourceForm extent clipRect: clipRect. dotSetter drawFrom: beginPoint to: endPoint! Item was changed: ----- Method: Form>>eraseShape: (in category 'filling') ----- eraseShape: bwForm "use bwForm as a mask to clear all pixels where bwForm has 1's" + ((BitBlt destForm: self sourceForm: bwForm - ((BitBlt current destForm: self sourceForm: bwForm fillColor: nil combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask" destOrigin: bwForm offset sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox) colorMap: (Bitmap with: 0 with: 16rFFFFFFFF)) copyBits. ! Item was changed: ----- Method: Form>>fill:rule:fillColor: (in category 'filling') ----- fill: aRectangle rule: anInteger fillColor: aForm "Replace a rectangular area of the receiver with the pattern described by aForm according to the rule anInteger." + (BitBlt toForm: self) - (BitBlt current toForm: self) copy: aRectangle from: 0@0 in: nil fillColor: aForm rule: anInteger! Item was changed: ----- Method: Form>>fillFromXYColorBlock: (in category 'filling') ----- fillFromXYColorBlock: colorBlock "General Gradient Fill. Supply relative x and y in [0.0 ... 1.0] to colorBlock, and paint each pixel with the color that comes back" | poker yRel xRel | + poker := BitBlt bitPokerToForm: self. - poker := BitBlt current bitPokerToForm: self. 0 to: height-1 do: [:y | yRel := y asFloat / (height-1) asFloat. 0 to: width-1 do: [:x | xRel := x asFloat / (width-1) asFloat. poker pixelAt: x@y put: ((colorBlock value: xRel value: yRel) pixelWordForDepth: self depth)]] " | d | ((Form extent: 100@20 depth: Display depth) fillFromXYColorBlock: [:x :y | d := 1.0 - (x - 0.5) abs - (y - 0.5) abs. Color r: d g: 0 b: 1.0-d]) display "! Item was changed: ----- Method: Form>>findShapeAroundSeedBlock: (in category 'filling') ----- findShapeAroundSeedBlock: seedBlock "Build a shape that is black in any region marked by seedBlock. SeedBlock will be supplied a form, in which to blacken various pixels as 'seeds'. Then the seeds are smeared until there is no change in the smear when it fills the region, ie, when smearing hits a black border and thus goes no further." | smearForm previousSmear all count smearPort | self depth > 1 ifTrue: [self halt]. "Only meaningful for B/W forms." all := self boundingBox. smearForm := Form extent: self extent. + smearPort := BitBlt toForm: smearForm. - smearPort := BitBlt current toForm: smearForm. seedBlock value: smearForm. "Blacken seeds to be smeared" smearPort copyForm: self to: 0 @ 0 rule: Form erase. "Clear any in black" previousSmear := smearForm deepCopy. count := 1. [count = 10 and: "check for no change every 10 smears" [count := 1. previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form reverse. previousSmear isAllWhite]] whileFalse: [smearPort copyForm: smearForm to: 1 @ 0 rule: Form under. smearPort copyForm: smearForm to: -1 @ 0 rule: Form under. "After horiz smear, trim around the region border" smearPort copyForm: self to: 0 @ 0 rule: Form erase. smearPort copyForm: smearForm to: 0 @ 1 rule: Form under. smearPort copyForm: smearForm to: 0 @ -1 rule: Form under. "After vert smear, trim around the region border" smearPort copyForm: self to: 0 @ 0 rule: Form erase. count := count + 1. count = 9 ifTrue: "Save penultimate smear for comparison" [previousSmear copy: all from: 0 @ 0 in: smearForm rule: Form over]]. "Now paint the filled region in me with aHalftone" ^ smearForm! Item was changed: ----- Method: Form>>flipBy:centerAt: (in category 'scaling, rotation') ----- flipBy: direction centerAt: aPoint "Return a copy of the receiver flipped either #vertical or #horizontal." | newForm quad | + newForm := self class extent: self extent depth: depth. - newForm := self species extent: self extent depth: depth. quad := self boundingBox innerCorners. quad := (direction = #vertical ifTrue: [#(2 1 4 3)] ifFalse: [#(4 3 2 1)]) collect: [:i | quad at: i]. + (WarpBlt toForm: newForm) - (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); combinationRule: 3; copyQuad: quad toRect: newForm boundingBox. newForm offset: (self offset flipBy: direction centerAt: aPoint). ^ newForm " [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) flipBy: #vertical centerAt: 0@0) display] " "Consistency test... | f f2 p | [Sensor anyButtonPressed] whileFalse: [f := Form fromDisplay: ((p := Sensor cursorPoint) extent: 31@41). Display fillBlack: (p extent: 31@41). f2 := f flipBy: #vertical centerAt: 0@0. (f2 flipBy: #vertical centerAt: 0@0) displayAt: p] " ! Item was changed: ----- Method: Form>>floodFill2:at: (in category 'filling') ----- floodFill2: aColor at: interiorPoint "Fill the shape (4-connected) at interiorPoint. The algorithm is based on Paul Heckbert's 'A Seed Fill Algorithm', Graphic Gems I, Academic Press, 1990. NOTE: This is a less optimized variant for flood filling which is precisely along the lines of Heckbert's algorithm. For almost all cases #floodFill:at: will be faster (see the comment there) but this method is left in both as reference and as a fallback if such a strange case is encountered in reality." | peeker poker stack old new x y top x1 x2 dy left goRight | + peeker := BitBlt bitPeekerFromForm: self. + poker := BitBlt bitPokerToForm: self. - peeker := BitBlt current bitPeekerFromForm: self. - poker := BitBlt current bitPokerToForm: self. stack := OrderedCollection new: 50. "read old pixel value" old := peeker pixelAt: interiorPoint. "compute new value" new := self pixelValueFor: aColor. old = new ifTrue:[^self]. "no point, is there?!!" x := interiorPoint x. y := interiorPoint y. (y >= 0 and:[y < height]) ifTrue:[ stack addLast: {y. x. x. 1}. "y, left, right, dy" stack addLast: {y+1. x. x. -1}]. [stack isEmpty] whileFalse:[ top := stack removeLast. y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4. y := y + dy. "Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled. Now explore adjacent pixels in scanline y." x := x1. [x >= 0 and:[(peeker pixelAt: x@y) = old]] whileTrue:[ poker pixelAt: x@y put: new. x := x - 1]. goRight := x < x1. left := x+1. (left < x1 and:[y-dy >= 0 and:[y-dy < height]]) ifTrue:[stack addLast: {y. left. x1-1. 0-dy}]. goRight ifTrue:[x := x1 + 1]. [ goRight ifTrue:[ [x < width and:[(peeker pixelAt: x@y) = old]] whileTrue:[ poker pixelAt: x@y put: new. x := x + 1]. (y+dy >= 0 and:[y+dy < height]) ifTrue:[stack addLast: {y. left. x-1. dy}]. (x > (x2+1) and:[y-dy >= 0 and:[y-dy >= 0]]) ifTrue:[stack addLast: {y. x2+1. x-1. 0-dy}]]. [(x := x + 1) <= x2 and:[(peeker pixelAt: x@y) ~= old]] whileTrue. left := x. goRight := true. x <= x2] whileTrue. ]. ! Item was changed: ----- Method: Form>>floodFill:at:tolerance: (in category 'filling') ----- floodFill: aColor at: interiorPoint tolerance: tolerance "Fill the shape (4-connected) at interiorPoint. The algorithm is based on Paul Heckbert's 'A Seed Fill Algorithm', Graphic Gems I, Academic Press, 1990. NOTE (ar): This variant has been heavily optimized to prevent the overhead of repeated calls to BitBlt. Usually this is a really big winner but the runtime now depends a bit on the complexity of the shape to be filled. For extremely complex shapes (say, a Hilbert curve) with very few pixels to fill it can be slower than #floodFill2:at: since it needs to repeatedly read the source bits. However, in all practical cases I found this variant to be 15-20 times faster than anything else. Further note (di): I have added a feature that allows this routine to fill areas of approximately constant color (such as photos, scans, and jpegs). It does this by computing a color map for the peeker that maps all colors close to 'old' into colors identical to old. This mild colorblindness achieves the desired effect with no further change or degradation of the algorithm. tolerance should be 0 (exact match), or a value corresponding to those returned by Color>>diff:, with 0.1 being a reasonable starting choice." | peeker poker stack old new x y top x1 x2 dy left goRight span spanBits w box debug | debug := false. "set it to true to see the filling process" box := interiorPoint extent: 1@1. span := Form extent: width@1 depth: 32. spanBits := span bits. + peeker := BitBlt toForm: span. - peeker := BitBlt current toForm: span. peeker sourceForm: self; combinationRule: 3; width: width; height: 1. "read old pixel value" peeker sourceOrigin: interiorPoint; destOrigin: interiorPoint x @ 0; width: 1; copyBits. old := spanBits at: interiorPoint x + 1. "compute new value (take care since the algorithm will fail if old = new)" new := self privateFloodFillValue: aColor. old = new ifTrue: [^ box]. tolerance > 0 ifTrue: ["Set up color map for approximate fills" peeker colorMap: (self floodFillMapFrom: self to: span mappingColorsWithin: tolerance to: old)]. + poker := BitBlt toForm: self. - poker := BitBlt current toForm: self. poker fillColor: aColor; combinationRule: 3; width: width; height: 1. stack := OrderedCollection new: 50. x := interiorPoint x. y := interiorPoint y. (y >= 0 and:[y < height]) ifTrue:[ stack addLast: {y. x. x. 1}. "y, left, right, dy" stack addLast: {y+1. x. x. -1}]. [stack isEmpty] whileFalse:[ debug ifTrue:[self displayOn: Display]. top := stack removeLast. y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4. y := y + dy. debug ifTrue:[ Display drawLine: (Form extent: 1@1 depth: 8) fillWhite from: (x1-1)@y to: (x2+1)@y clippingBox: Display boundingBox rule: Form over fillColor: nil]. "Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled. Now explore adjacent pixels in scanline y." peeker sourceOrigin: 0@y; destOrigin: 0@0; width: width; copyBits. "Note: above is necessary since we don't know where we'll end up filling" x := x1. w := 0. [x >= 0 and:[(spanBits at: x+1) = old]] whileTrue:[ w := w + 1. x := x - 1]. w > 0 ifTrue:[ "overwrite pixels" poker destOrigin: x+1@y; width: w; copyBits. box := box quickMerge: ((x+1@y) extent: w@1)]. goRight := x < x1. left := x+1. (left < x1 and:[y-dy >= 0 and:[y-dy < height]]) ifTrue:[stack addLast: {y. left. x1-1. 0-dy}]. goRight ifTrue:[x := x1 + 1]. [ goRight ifTrue:[ w := 0. [x < width and:[(spanBits at: x+1) = old]] whileTrue:[ w := w + 1. x := x + 1]. w > 0 ifTrue:[ "overwrite pixels" poker destOrigin: (x-w)@y; width: w; copyBits. box := box quickMerge: ((x-w@y) extent: w@1)]. (y+dy >= 0 and:[y+dy < height]) ifTrue:[stack addLast: {y. left. x-1. dy}]. (x > (x2+1) and:[y-dy >= 0 and:[y-dy >= 0]]) ifTrue:[stack addLast: {y. x2+1. x-1. 0-dy}]]. [(x := x + 1) <= x2 and:[(spanBits at: x+1) ~= old]] whileTrue. left := x. goRight := true. x <= x2] whileTrue. ]. ^box! Item was changed: ----- Method: Form>>magnify:by:smoothing: (in category 'scaling, rotation') ----- magnify: aRectangle by: scale smoothing: cellSize "Answer a Form created as a scaling of the receiver. Scale may be a Float or even a Point, and may be greater or less than 1.0." | newForm | newForm := self blankCopyOf: aRectangle scaledBy: scale. + (WarpBlt toForm: newForm) - (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: 3; copyQuad: aRectangle innerCorners toRect: newForm boundingBox. ^ newForm "Dynamic test... [Sensor anyButtonPressed] whileFalse: [(Display magnify: (Sensor cursorPoint extent: 131@81) by: 0.5 smoothing: 2) display] " "Scaling test... | f cp | f := Form fromDisplay: (Rectangle originFromUser: 100@100). Display restoreAfter: [Sensor waitNoButton. [Sensor anyButtonPressed] whileFalse: [cp := Sensor cursorPoint. (f magnify: f boundingBox by: (cp x asFloat@cp y asFloat)/f extent smoothing: 2) display]] "! Item was changed: ----- Method: Form>>mapColor:to: (in category 'color mapping') ----- mapColor: oldColor to: newColor "Make all pixels of the given color in this Form to the given new color." "Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution." | map | map := (Color cachedColormapFrom: self depth to: self depth) copy. map at: (oldColor indexInMap: map) put: (newColor pixelWordForDepth: self depth). + (BitBlt toForm: self) - (BitBlt current toForm: self) sourceForm: self; sourceOrigin: 0@0; combinationRule: Form over; destX: 0 destY: 0 width: width height: height; colorMap: map; copyBits. ! Item was changed: ----- Method: Form>>mapColors:to: (in category 'color mapping') ----- mapColors: oldColorBitsCollection to: newColorBits "Make all pixels of the given color in this Form to the given new color." "Warnings: This method modifies the receiver. It may lose some color accuracy on 32-bit Forms, since the transformation uses a color map with only 15-bit resolution." | map | self depth < 16 ifTrue: [map := (Color cachedColormapFrom: self depth to: self depth) copy] ifFalse: [ "use maximum resolution color map" "source is 16-bit or 32-bit RGB; use colormap with 5 bits per color component" map := Color computeRGBColormapFor: self depth bitsPerColor: 5]. oldColorBitsCollection do:[ :oldColor | map at: oldColor put: newColorBits]. + (BitBlt toForm: self) - (BitBlt current toForm: self) sourceForm: self; sourceOrigin: 0@0; combinationRule: Form over; destX: 0 destY: 0 width: width height: height; colorMap: map; copyBits. ! Item was changed: ----- Method: Form>>pageWarp:at:forward: (in category 'transitions') ----- pageWarp: otherImage at: topLeft forward: forward "Produce a page-turning illusion that gradually reveals otherImage located at topLeft in this form. forward == true means turn pages toward you, else away. [ignored for now]" | pageRect oldPage nSteps buffer p leafRect sourceQuad warp oldBottom d | pageRect := otherImage boundingBox. oldPage := self copy: (pageRect translateBy: topLeft). (forward ifTrue: [oldPage] ifFalse: [otherImage]) border: pageRect widthRectangle: (Rectangle left: 0 right: 2 top: 1 bottom: 1) rule: Form over fillColor: Color black. oldBottom := self copy: ((pageRect bottomLeft + topLeft) extent: (pageRect width@(pageRect height//4))). nSteps := 8. buffer := Form extent: otherImage extent + (0@(pageRect height//4)) depth: self depth. d := pageRect topLeft + (0@(pageRect height//4)) - pageRect topRight. 1 to: nSteps-1 do: [:i | forward ifTrue: [buffer copy: pageRect from: otherImage to: 0@0 rule: Form over. p := pageRect topRight + (d * i // nSteps)] ifFalse: [buffer copy: pageRect from: oldPage to: 0@0 rule: Form over. p := pageRect topRight + (d * (nSteps-i) // nSteps)]. buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over. leafRect := pageRect topLeft corner: p x @ (pageRect bottom + p y). sourceQuad := Array with: pageRect topLeft with: pageRect bottomLeft + (0@p y) with: pageRect bottomRight with: pageRect topRight - (0@p y). + warp := (WarpBlt toForm: buffer) - warp := (WarpBlt current toForm: buffer) clipRect: leafRect; sourceForm: (forward ifTrue: [oldPage] ifFalse: [otherImage]); combinationRule: Form paint. warp copyQuad: sourceQuad toRect: leafRect. self copy: buffer boundingBox from: buffer to: topLeft rule: Form over. Display forceDisplayUpdate]. buffer copy: pageRect from: otherImage to: 0@0 rule: Form over. buffer copy: oldBottom boundingBox from: oldBottom to: pageRect bottomLeft rule: Form over. self copy: buffer boundingBox from: buffer to: topLeft rule: Form over. Display forceDisplayUpdate. " 1 to: 4 do: [:corner | Display pageWarp: (Form fromDisplay: (10@10 extent: 200@300)) reverse at: 10@10 forward: false] " ! Item was changed: ----- Method: Form>>paintBits:at:translucent: (in category 'displaying') ----- paintBits: sourceForm at: destOrigin translucent: factor "Make up a BitBlt table and copy the bits with the given colorMap." + (BitBlt destForm: self - (BitBlt current destForm: self sourceForm: sourceForm halftoneForm: nil combinationRule: 31 destOrigin: destOrigin sourceOrigin: 0@0 extent: sourceForm extent clipRect: self boundingBox) copyBitsTranslucent: ((0 max: (factor*255.0) asInteger) min: 255) " | f f2 f3 | f := Form fromUser. f replaceColor: f peripheralColor withColor: Color transparent. f2 := Form fromDisplay: (0@0 extent: f extent). f3 := f2 deepCopy. 0.0 to: 1.0 by: 1.0/32 do: [:t | f3 := f2 deepCopy. f3 paintBits: f at: 0@0 translucent: t. f3 displayAt: 0@0. (Delay forMilliseconds: 100) wait]. "! Item was changed: ----- Method: Form>>pixelCompare:with:at: (in category 'analyzing') ----- pixelCompare: aRect with: otherForm at: otherLoc "Compare the selected bits of this form (those within aRect) against those in a similar rectangle of otherFrom. Return the sum of the absolute value of the differences of the color values of every pixel. Obviously, this is most useful for rgb (16- or 32-bit) pixels but, in the case of 8-bits or less, this will return the sum of the differing bits of the corresponding pixel values (somewhat less useful)" | pixPerWord temp | pixPerWord := 32//self depth. (aRect left\\pixPerWord = 0 and: [aRect right\\pixPerWord = 0]) ifTrue: ["If word-aligned, use on-the-fly difference" + ^ (BitBlt toForm: self) copy: aRect from: otherLoc in: otherForm - ^ (BitBlt current toForm: self) copy: aRect from: otherLoc in: otherForm fillColor: nil rule: 32]. "Otherwise, combine in a word-sized form and then compute difference" temp := self copy: aRect. temp copy: aRect from: otherLoc in: otherForm rule: 21. + ^ (BitBlt toForm: temp) copy: aRect from: otherLoc in: nil - ^ (BitBlt current toForm: temp) copy: aRect from: otherLoc in: nil fillColor: (Bitmap with: 0) rule: 32 " Dumb example prints zero only when you move over the original rectangle... | f diff | f := Form fromUser. [Sensor anyButtonPressed] whileFalse: [diff := f pixelCompare: f boundingBox with: Display at: Sensor cursorPoint. diff printString , ' ' displayAt: 0@0] "! Item was changed: ----- Method: Form>>pixelValueAt: (in category 'pixel access') ----- pixelValueAt: aPoint "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. " + ^ (BitBlt bitPeekerFromForm: self) pixelAt: aPoint - ^ (BitBlt current bitPeekerFromForm: self) pixelAt: aPoint ! Item was changed: ----- Method: Form>>pixelValueAt:put: (in category 'pixel access') ----- pixelValueAt: aPoint put: pixelValue "Store the given raw pixel value at the given point. Typical clients use colorAt:put: to store a color. " + (BitBlt bitPokerToForm: self) pixelAt: aPoint put: pixelValue. - (BitBlt current bitPokerToForm: self) pixelAt: aPoint put: pixelValue. ! Item was changed: ----- Method: Form>>primCountBits (in category 'analyzing') ----- primCountBits "Count the non-zero pixels of this form." self depth > 8 ifTrue: [^(self asFormOfDepth: 8) primCountBits]. + ^ (BitBlt toForm: self) - ^ (BitBlt current toForm: self) fillColor: (Bitmap with: 0); destRect: (0@0 extent: width@height); combinationRule: 32; copyBits! Item was added: + ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') ----- + primPixelValueAtX: x y: y + "Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. " + + <primitive: 'primitivePixelValueAt' module:'PixelValuePeekPlugin'> + ^(BitBlt bitPeekerFromForm: self) pixelAtX: x y: y! Item was changed: ----- Method: Form>>rectangleEnclosingPixelsNotOfColor: (in category 'analyzing') ----- rectangleEnclosingPixelsNotOfColor: aColor "Answer the smallest rectangle enclosing all the pixels of me that are different from the given color. Useful for extracting a foreground graphic from its background." | cm slice copyBlt countBlt top bottom newH left right | "map the specified color to 1 and all others to 0" cm := Bitmap new: (1 bitShift: (self depth min: 15)). cm primFill: 1. cm at: (aColor indexInMap: cm) put: 0. "build a 1-pixel high horizontal slice and BitBlts for counting pixels of interest" slice := Form extent: width@1 depth: 1. + copyBlt := (BitBlt toForm: slice) - copyBlt := (BitBlt current toForm: slice) sourceForm: self; combinationRule: Form over; destX: 0 destY: 0 width: width height: 1; colorMap: cm. + countBlt := (BitBlt toForm: slice) - countBlt := (BitBlt current toForm: slice) fillColor: (Bitmap with: 0); destRect: (0@0 extent: slice extent); combinationRule: 32. "scan in from top and bottom" top := (0 to: height) detect: [:y | copyBlt sourceOrigin: 0@y; copyBits. countBlt copyBits > 0] ifNone: [^ 0@0 extent: 0@0]. bottom := (height - 1 to: top by: -1) detect: [:y | copyBlt sourceOrigin: 0@y; copyBits. countBlt copyBits > 0]. "build a 1-pixel wide vertical slice and BitBlts for counting pixels of interest" newH := bottom - top + 1. slice := Form extent: 1@newH depth: 1. + copyBlt := (BitBlt toForm: slice) - copyBlt := (BitBlt current toForm: slice) sourceForm: self; combinationRule: Form over; destX: 0 destY: 0 width: 1 height: newH; colorMap: cm. + countBlt := (BitBlt toForm: slice) - countBlt := (BitBlt current toForm: slice) fillColor: (Bitmap with: 0); destRect: (0@0 extent: slice extent); combinationRule: 32. "scan in from left and right" left := (0 to: width) detect: [:x | copyBlt sourceOrigin: x@top; copyBits. countBlt copyBits > 0]. right := (width - 1 to: left by: -1) detect: [:x | copyBlt sourceOrigin: x@top; copyBits. countBlt copyBits > 0]. ^ left@top corner: (right + 1)@(bottom + 1) ! Item was changed: ----- Method: Form>>replaceColor:withColor: (in category 'image manipulation') ----- replaceColor: oldColor withColor: newColor "Replace one color with another everywhere is this form" | cm newInd target ff | self depth = 32 ifTrue: [cm := (Color cachedColormapFrom: 16 to: 32) copy] ifFalse: [cm := Bitmap new: (1 bitShift: (self depth min: 15)). 1 to: cm size do: [:i | cm at: i put: i - 1]]. newInd := newColor pixelValueForDepth: self depth. cm at: (oldColor pixelValueForDepth: (self depth min: 16))+1 put: newInd. target := newColor isTransparent ifTrue: [ff := Form extent: self extent depth: depth. ff fillWithColor: newColor. ff] ifFalse: [self]. + (BitBlt toForm: target) - (BitBlt current toForm: target) sourceForm: self; sourceOrigin: 0@0; combinationRule: Form paint; destX: 0 destY: 0 width: width height: height; colorMap: cm; copyBits. newColor = Color transparent ifTrue: [target displayOn: self].! Item was changed: ----- Method: Form>>rotateBy:centerAt: (in category 'scaling, rotation') ----- rotateBy: direction centerAt: aPoint "Return a rotated copy of the receiver. direction = #none, #right, #left, or #pi" | newForm quad rot scale | direction == #none ifTrue: [^ self]. scale := (direction = #pi ifTrue: [width@height] ifFalse: [height@width]) / self extent . newForm := self blankCopyOf: self boundingBox scaledBy: scale. quad := self boundingBox innerCorners. rot := #(right pi left) indexOf: direction. + (WarpBlt toForm: newForm) - (WarpBlt current toForm: newForm) sourceForm: self; colorMap: (self colormapIfNeededFor: newForm); combinationRule: 3; copyQuad: ((1+rot to: 4+rot) collect: [:i | quad atWrap: i]) toRect: newForm boundingBox. newForm offset: (self offset rotateBy: direction centerAt: aPoint). ^ newForm " [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) rotateBy: #left centerAt: 0@0) display] " "Consistency test... | f f2 p | [Sensor anyButtonPressed] whileFalse: [f := Form fromDisplay: ((p := Sensor cursorPoint) extent: 31@41). Display fillBlack: (p extent: 31@41). f2 := f rotateBy: #left centerAt: 0@0. (f2 rotateBy: #right centerAt: 0@0) displayAt: p] " ! Item was changed: ----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') ----- rotateBy: deg magnify: scale smoothing: cellSize "Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects " "rot is the destination form, big enough for any angle." | side rot warp r1 pts bigSide | side := 1 + self extent r asInteger. bigSide := (side asPoint * scale) rounded. rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ). + warp := (WarpBlt toForm: rot) - warp := (WarpBlt current toForm: rot) sourceForm: self; colorMap: (self colormapIfNeededFor: rot); cellSize: cellSize; "installs a new colormap if cellSize > 1" combinationRule: Form paint. r1 := (0@0 extent: side@side) align: (side@side)//2 with: self boundingBox center. "Rotate the corners of the source rectangle." pts := r1 innerCorners collect: [:pt | | p | p := pt - r1 center. (r1 center x asFloat + (p x asFloat*deg degreeCos) + (p y asFloat*deg degreeSin)) @ (r1 center y asFloat - (p x asFloat*deg degreeSin) + (p y asFloat*deg degreeCos))]. warp copyQuad: pts toRect: rot boundingBox. ^ rot " | a f | f := Form fromDisplay: (0@0 extent: 200@200). a := 0. [Sensor anyButtonPressed] whileFalse: [((Form fromDisplay: (Sensor cursorPoint extent: 130@66)) rotateBy: (a := a+5) magnify: 0.75@2 smoothing: 2) display]. f display "! Item was changed: ----- Method: Form>>smear:distance: (in category 'image manipulation') ----- smear: dir distance: dist "Smear any black pixels in this form in the direction dir in Log N steps" | skew bb | + bb := BitBlt destForm: self sourceForm: self fillColor: nil - bb := BitBlt current destForm: self sourceForm: self fillColor: nil combinationRule: Form under destOrigin: 0@0 sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox. skew := 1. [skew < dist] whileTrue: [bb destOrigin: dir*skew; copyBits. skew := skew+skew]! Item was changed: ----- Method: Form>>tallyPixelValuesInRect:into: (in category 'analyzing') ----- tallyPixelValuesInRect: destRect into: valueTable "Tally the selected pixels of this Form into valueTable, a Bitmap of depth 2^depth similar to a color map. Answer valueTable." + (BitBlt toForm: self) - (BitBlt current toForm: self) sourceForm: self; "src must be given for color map ops" sourceOrigin: 0@0; tallyMap: valueTable; combinationRule: 33; destRect: destRect; copyBits. ^ valueTable " Move a little rectangle around the screen and print its tallies... | r tallies nonZero | Cursor blank showWhile: [ [Sensor anyButtonPressed] whileFalse: [r := Sensor cursorPoint extent: 10@10. Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil. tallies := (Display copy: r) tallyPixelValues. nonZero := (1 to: tallies size) select: [:i | (tallies at: i) > 0] thenCollect: [:i | (tallies at: i) -> (i-1)]. nonZero printString , ' ' displayAt: 0@0. Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]] "! Item was changed: ----- Method: Form>>xTallyPixelValue:orNot: (in category 'analyzing') ----- xTallyPixelValue: pv orNot: not "Return an array of the number of pixels with value pv by x-value. Note that if not is true, then this will tally those different from pv." | cm slice countBlt copyBlt | cm := self newColorMap. "Map all colors but pv to zero" not ifTrue: [cm atAllPut: 1]. "... or all but pv to one" cm at: pv+1 put: 1 - (cm at: pv+1). slice := Form extent: 1@height. + copyBlt := (BitBlt destForm: slice sourceForm: self - copyBlt := (BitBlt current destForm: slice sourceForm: self halftoneForm: nil combinationRule: Form over destOrigin: 0@0 sourceOrigin: 0@0 extent: 1 @ slice height clipRect: slice boundingBox) colorMap: cm. + countBlt := (BitBlt toForm: slice) - countBlt := (BitBlt current toForm: slice) fillColor: (Bitmap with: 0); destRect: (0@0 extent: slice extent); combinationRule: 32. ^ (0 to: width-1) collect: [:x | copyBlt sourceOrigin: x@0; copyBits. countBlt copyBits]! Item was changed: ----- Method: Form>>yTallyPixelValue:orNot: (in category 'analyzing') ----- yTallyPixelValue: pv orNot: not "Return an array of the number of pixels with value pv by y-value. Note that if not is true, then this will tally those different from pv." | cm slice copyBlt countBlt | cm := self newColorMap. "Map all colors but pv to zero" not ifTrue: [cm atAllPut: 1]. "... or all but pv to one" cm at: pv+1 put: 1 - (cm at: pv+1). slice := Form extent: width@1. + copyBlt := (BitBlt destForm: slice sourceForm: self - copyBlt := (BitBlt current destForm: slice sourceForm: self halftoneForm: nil combinationRule: Form over destOrigin: 0@0 sourceOrigin: 0@0 extent: slice width @ 1 clipRect: slice boundingBox) colorMap: cm. + countBlt := (BitBlt toForm: slice) - countBlt := (BitBlt current toForm: slice) fillColor: (Bitmap with: 0); destRect: (0@0 extent: slice extent); combinationRule: 32. ^ (0 to: height-1) collect: [:y | copyBlt sourceOrigin: 0@y; copyBits. countBlt copyBits]! Item was changed: ----- Method: InfiniteForm>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm "This is the real display message, but it doesn't get used until the new display protocol is installed." | targetBox patternBox bb | (patternForm isForm) ifFalse: [^ aDisplayMedium fill: clipRectangle rule: ruleInteger fillColor: patternForm]. "Do it iteratively" targetBox := aDisplayMedium boundingBox intersect: clipRectangle. patternBox := patternForm boundingBox. + bb := BitBlt destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm - bb := BitBlt current destForm: aDisplayMedium sourceForm: patternForm fillColor: aForm combinationRule: ruleInteger destOrigin: 0@0 sourceOrigin: 0@0 extent: patternBox extent clipRect: clipRectangle. bb colorMap: (patternForm colormapIfNeededFor: aDisplayMedium). (targetBox left truncateTo: patternBox width) to: targetBox right - 1 by: patternBox width do: [:x | (targetBox top truncateTo: patternBox height) to: targetBox bottom - 1 by: patternBox height do: [:y | bb destOrigin: x@y; copyBits]]! Item was changed: ----- Method: JPEGReadWriter>>nextImageDitheredToDepth: (in category 'public access') ----- nextImageDitheredToDepth: depth | form xStep yStep x y bb | ditherMask := DitherMasks at: depth ifAbsent: [self error: 'can only dither to display depths']. residuals := WordArray new: 3. sosSeen := false. self parseFirstMarker. [sosSeen] whileFalse: [self parseNextMarker]. form := Form extent: (width @ height) depth: depth. + bb := BitBlt toForm: form. - bb := BitBlt current toForm: form. bb sourceForm: mcuImageBuffer. bb colorMap: (mcuImageBuffer colormapIfNeededFor: form). bb sourceRect: mcuImageBuffer boundingBox. bb combinationRule: Form over. xStep := mcuWidth * DCTSize. yStep := mcuHeight * DCTSize. y := 0. 1 to: mcuRowsInScan do: [:row | x := 0. 1 to: mcusPerRow do: [:col | self decodeMCU. self idctMCU. self colorConvertMCU. bb destX: x; destY: y; copyBits. x := x + xStep]. y := y + yStep]. ^ form! Item was changed: ----- Method: PNGReadWriter>>copyPixelsGray: (in category 'pixel copies') ----- copyPixelsGray: y "Handle non-interlaced grayscale color mode (colorType = 0)" | base bits bytesLeft word | bitsPerChannel = 16 ifTrue: [ "Warning: This is extremely slow. Besides we are downsampling to 8 bits!!" | blitter | + blitter := BitBlt bitPokerToForm: form. - blitter := BitBlt current bitPokerToForm: form. 0 to: width - 1 do: [ :x | blitter pixelAt: x @ y put: 255 - (thisScanline at: x * 2 + 1) ]. ^self ]. "Just copy the bits" "This Smalltalk version might be easier to understand than the others below." base := y * (form width * bitsPerChannel + 31 // 32) + 1. bits := form bits. 0 to: thisScanline size // 4 - 1 do: [ :i | | ii | ii := i * 4. "This somewhat weird mixture of (#* and #+) with (#bitShift: and #bitOr:) is to make use of faster arithmetic bytecodes, but not of slow largeintegers." word := (((thisScanline at: ii + 1) * 256 + (thisScanline at: ii + 2) * 256 + (thisScanline at: ii + 3)) bitShift: 8) bitOr: (thisScanline at: ii + 4). bits at: base + i put: word ]. (bytesLeft := thisScanline size bitAnd: 3) = 0 ifFalse: [ word := 0. thisScanline size - bytesLeft + 1 to: thisScanline size do: [ :ii | word := word * 256 + (thisScanline at: ii) ]. word := word bitShift: 8 * (4 - bytesLeft). bits at: base + (thisScanline size // 4) put: word ]. "This interesting technique (By Andreas Raab) is faster for very large images, but might be slower for small ones" "^self copyPixelsGrayWeirdBitBltHack: y ". "It uses the following method: PNGReadWriter >> copyPixelsGrayWeirdBitBltHack: y ""Handle non-interlaced black and white color mode (colorType = 0) By Andreas Raab"" | source dest cmap | source := Form extent: 1 @ (thisScanline size // 4) depth: 32 bits: thisScanline. dest := Form extent: 1 @ (form bits size) depth: 32 bits: form bits. cmap := Smalltalk isLittleEndian ifTrue:[ColorMap shifts: #(-24 -8 8 24) masks: #(16rFF000000 16r00FF0000 16r0000FF00 16r000000FF)]. (BitBlt toForm: dest) sourceForm: source; destX: 0 destY: (y * form width*bitsPerChannel//32) width: 1 height: (form width+31*bitsPerChannel//32); colorMap: cmap; combinationRule: 3; copyBits." "This interesting technique (By Yoshiki Ohshima) is faster for very large images, but might be slower for small ones" "form bits copyFromByteArray2: thisScanline to: y * (form width* bitsPerChannel // 32)". "It uses the following method: BitMap >> copyFromByteArray2: byteArray to: i ""This method should work with either byte orderings"" | myHack byteHack | myHack := Form new hackBits: self. byteHack := Form new hackBits: byteArray. Smalltalk isLittleEndian ifTrue: [byteHack swapEndianness]. byteHack displayOn: myHack at: 0@i"! Item was changed: ----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') ----- copyPixelsGray: y at: startX by: incX "Handle interlaced grayscale color mode (colorType = 0)" | offset bits blitter pixPerByte shifts b pixel mask pixelNumber | bitsPerChannel = 16 ifTrue: [ + b := BitBlt bitPokerToForm: form. - b := BitBlt current bitPokerToForm: form. startX to: width-1 by: incX do: [ :x | b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1). ]. ^ self ]. offset := y*rowSize+1. bits := form bits. bitsPerChannel = 8 ifTrue: [ startX to: width-1 by: incX do: [ :x | | w | w := offset + (x>>2). b := 3- (x \\ 4) * 8. pixel := (thisScanline at: x // incX + 1)<<b. mask := (255<<b) bitInvert32. bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel) ]. ^ self ]. bitsPerChannel = 1 ifTrue: [ pixPerByte := 8. mask := 1. shifts := #(7 6 5 4 3 2 1 0). ]. bitsPerChannel = 2 ifTrue: [ pixPerByte := 4. mask := 3. shifts := #(6 4 2 0). ]. bitsPerChannel = 4 ifTrue: [ pixPerByte := 2. mask := 15. shifts := #(4 0). ]. + blitter := BitBlt bitPokerToForm: form. - blitter := BitBlt current bitPokerToForm: form. pixelNumber := 0. startX to: width-1 by: incX do: [ :x | | rawByte | rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1. pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask. blitter pixelAt: (x@y) put: pixel. pixelNumber := pixelNumber + 1. ]. ! Item was changed: ----- Method: PNGReadWriter>>copyPixelsGrayAlpha: (in category 'pixel copies') ----- copyPixelsGrayAlpha: y "Handle non-interlaced grayscale with alpha color mode (colorType = 4)" | i pixel gray b | + b := BitBlt bitPokerToForm: form. - b := BitBlt current bitPokerToForm: form. bitsPerChannel = 8 ifTrue: [ 0 to: width-1 do: [ :x | i := (x << 1) + 1. gray := thisScanline at: i. pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray. b pixelAt: x@y put: pixel. ] ] ifFalse: [ 0 to: width-1 do: [ :x | i := (x << 2) + 1. gray := thisScanline at: i. pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray. b pixelAt: x@y put: pixel. ] ] ! Item was changed: ----- Method: PNGReadWriter>>copyPixelsGrayAlpha:at:by: (in category 'pixel copies') ----- copyPixelsGrayAlpha: y at: startX by: incX "Handle interlaced grayscale with alpha color mode (colorType = 4)" | i pixel gray b | + b := BitBlt bitPokerToForm: form. - b := BitBlt current bitPokerToForm: form. bitsPerChannel = 8 ifTrue: [ startX to: width-1 by: incX do: [ :x | i := (x // incX << 1) + 1. gray := thisScanline at: i. pixel := ((thisScanline at: i+1)<<24) + (gray<<16) + (gray<<8) + gray. b pixelAt: x@y put: pixel. ] ] ifFalse: [ startX to: width-1 by: incX do: [ :x | i := (x // incX << 2) + 1. gray := thisScanline at: i. pixel := ((thisScanline at: i+2)<<24) + (gray<<16) + (gray<<8) + gray. b pixelAt: x@y put: pixel. ] ] ! Item was changed: ----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') ----- copyPixelsIndexed: y at: startX by: incX "Handle interlaced indexed color mode (colorType = 3)" | offset bits pixPerByte shifts blitter pixel mask pixelNumber | offset := y*rowSize+1. bits := form bits. bitsPerChannel = 8 ifTrue: [ startX to: width-1 by: incX do: [ :x | | b w | w := offset + (x>>2). b := 3 - (x \\ 4) * 8. pixel := (thisScanline at: x // incX + 1)<<b. mask := (255<<b) bitInvert32. bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)]. ^ self ]. bitsPerChannel = 1 ifTrue: [ pixPerByte := 8. mask := 1. shifts := #(7 6 5 4 3 2 1 0). ]. bitsPerChannel = 2 ifTrue: [ pixPerByte := 4. mask := 3. shifts := #(6 4 2 0). ]. bitsPerChannel = 4 ifTrue: [ pixPerByte := 2. mask := 15. shifts := #(4 0). ]. + blitter := BitBlt bitPokerToForm: form. - blitter := BitBlt current bitPokerToForm: form. pixelNumber := 0. startX to: width-1 by: incX do: [ :x | | rawByte | rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1. pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask. blitter pixelAt: (x@y) put: pixel. pixelNumber := pixelNumber + 1. ]. ! Item was changed: ----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') ----- nextPutGray: aForm | myType peeker val | cols := aForm width. rows := aForm height. depth := aForm depth. "stream position: 0." aForm depth = 1 ifTrue:[myType := $4] ifFalse:[myType := $5]. self writeHeader: myType. + peeker := BitBlt bitPeekerFromForm: aForm. - peeker := BitBlt current bitPeekerFromForm: aForm. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | val := peeker pixelAt: x@y. stream nextPut: val. ] ]. ! Item was changed: ----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') ----- nextPutRGB: aForm | myType peeker f shift mask | cols := aForm width. rows := aForm height. depth := aForm depth. f := aForm. depth < 16 ifTrue:[ f := aForm asFormOfDepth: 32. depth := 32. ]. myType := $6. "stream position: 0." self writeHeader: myType. depth = 32 ifTrue:[shift := 8. mask := 16rFF] ifFalse:[shift := 5. mask := 16r1F]. + peeker := BitBlt bitPeekerFromForm: f. - peeker := BitBlt current bitPeekerFromForm: f. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | | p r g b | p := peeker pixelAt: x@y. b := p bitAnd: mask. p := p >> shift. g := p bitAnd: mask. p := p >> shift. r := p bitAnd: mask. stream nextPut: r. stream nextPut: g. stream nextPut: b. ] ]. ! Item was changed: ----- Method: PNMReadWriter>>readGray (in category 'reading') ----- readGray "gray form, return ColorForm with gray ramp" | form poker | maxValue > 255 ifTrue:[self error:'Gray value > 8 bits not supported in Squeak']. stream binary. form := ColorForm extent: cols@rows depth: depth. form colors: nil. + poker := BitBlt bitPokerToForm: form. - poker := BitBlt current bitPokerToForm: form. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | |val| val := stream next. poker pixelAt: x@y put: val. ] ]. "a better way is using a gamma corrected palette" form colors: ((0 to: 255) collect:[:c| c > maxValue ifTrue:[Color white] ifFalse:[Color gray: (c/maxValue) asFloat]]). form colors at: 1 put: (Color black). ^form ! Item was changed: ----- Method: PNMReadWriter>>readPlainBW (in category 'reading') ----- readPlainBW "plain BW" | val form poker | form := Form extent: cols@rows depth: depth. + poker := BitBlt bitPokerToForm: form. - poker := BitBlt current bitPokerToForm: form. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | [val := stream next. (val = $0 or:[val = $1])] whileFalse:[ val ifNil:[self error:'End of file reading PBM']. ]. poker pixelAt: x@y put: (val asInteger). ] ]. ^form ! Item was changed: ----- Method: PNMReadWriter>>readPlainGray (in category 'reading') ----- readPlainGray "plain gray" | val form poker aux tokens | form := Form extent: cols@rows depth: depth. + poker := BitBlt bitPokerToForm: form. - poker := BitBlt current bitPokerToForm: form. tokens := OrderedCollection new. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | aux := self getTokenPbm: tokens. val := aux at: 1. tokens := aux at: 2. poker pixelAt: x@y put: val. ] ]. ^form ! Item was changed: ----- Method: PNMReadWriter>>readPlainRGB (in category 'reading') ----- readPlainRGB "RGB form, use 32 bits" | val form poker tokens aux | maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak']. form := Form extent: cols@rows depth: 32. + poker := BitBlt bitPokerToForm: form. - poker := BitBlt current bitPokerToForm: form. tokens := OrderedCollection new. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | | r g b| aux := self getTokenPbm: tokens. r := aux at: 1. tokens := aux at: 2. aux := self getTokenPbm: tokens. g := aux at: 1. tokens := aux at: 2. aux := self getTokenPbm: tokens. b := aux at: 1. tokens := aux at: 2. val := self r: r g: g b: b for: depth. poker pixelAt: x@y put: val. ] ]. ^form ! Item was changed: ----- Method: PNMReadWriter>>readRGB (in category 'reading') ----- readRGB "RGB form, use 16/32 bits" | val form poker sample shift | maxValue > 255 ifTrue:[self error:'RGB value > 32 bits not supported in Squeak']. stream binary. form := Form extent: cols@rows depth: depth. + poker := BitBlt bitPokerToForm: form. - poker := BitBlt current bitPokerToForm: form. depth = 32 ifTrue:[shift := 8] ifFalse:[shift := 5]. 0 to: rows-1 do: [:y | 0 to: cols-1 do: [:x | val := 16rFF. "no transparency" 1 to: 3 do: [:i | sample := stream next. val := val << shift + sample. ]. poker pixelAt: x@y put: val. ] ]. ^form ! Item was changed: ----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') ----- feltTip: width cellSize: cellSize "Warning: This example potentially uses a large amount of memory--it creates a Form with cellSize squared bits for every Display pixel." "In this example, all drawing is done into a large, monochrome Form and then scaled down onto the Display using smoothing. The larger the cell size, the more possible shades of gray can be generated, and the smoother the resulting line appears. A cell size of 8 yields 64 possible grays, while a cell size of 16 gives 256 levels, which is about the maximum number of grays that the human visual system can distinguish. The width parameter determines the maximum line thickness. Requires the optional tablet support primitives which may not be supported on all platforms. Works best in full screen mode. Shift-mouse to exit." "Pen feltTip: 2.7 cellSize: 8" | tabletScale bitForm pen warp | tabletScale := self tabletScaleFactor. bitForm := Form extent: Display extent * cellSize depth: 1. pen := Pen newOnForm: bitForm. pen color: Color black. + warp := (WarpBlt toForm: Display) - warp := (WarpBlt current toForm: Display) sourceForm: bitForm; colorMap: (bitForm colormapIfNeededFor: Display); cellSize: cellSize; combinationRule: Form over. Display fillColor: Color white. Display restoreAfter: [ | p r nibSize srcR startP dstR | [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [ p := (Sensor tabletPoint * cellSize * tabletScale) rounded. nibSize := (Sensor tabletPressure * (cellSize * width)) rounded. nibSize > 0 ifTrue: [ pen squareNib: nibSize. startP := pen location. pen goto: p. r := startP rect: pen location. dstR := (r origin // cellSize) corner: ((r corner + nibSize + (cellSize - 1)) // cellSize). srcR := (dstR origin * cellSize) corner: (dstR corner * cellSize). warp copyQuad: srcR innerCorners toRect: dstR] ifFalse: [ pen place: p]]]. ! Item was changed: ----- Method: Pen>>print:withFont: (in category 'operations') ----- print: str withFont: font "Print the given string in the given font at the current heading" | lineStart scale wasDown | scale := sourceForm width. wasDown := penDown. lineStart := location. str do: [:char | char = Character cr ifTrue: [self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down] ifFalse: [ | charStart pix rowStart form bb backgroundCode | form := font characterFormAt: char. backgroundCode := 1<< (form depth // 3 * 3) - 1. charStart := location. wasDown ifTrue: [ self up; turn: -90; go: font descent*scale; turn: 90; down. 0 to: form height-1 do: [:y | rowStart := location. + bb := BitBlt bitPeekerFromForm: form. - bb := BitBlt current bitPeekerFromForm: form. pix := RunArray newFrom: ((0 to: form width-1) collect: [:x | bb pixelAt: x@y]). pix runs with: pix values do: [:run :value | value = backgroundCode ifTrue: [self up; go: run*scale; down] ifFalse: [self go: run*scale]]. self place: rowStart; up; turn: 90; go: scale; turn: -90; down]. ]. self place: charStart; up; go: form width*scale; down]. ]. wasDown ifFalse: [self up] " Display restoreAfter: [Pen new squareNib: 2; color: Color red; turn: 45; print: 'The owl and the pussycat went to sea in a beautiful pea green boat.' withFont: TextStyle defaultFont] "! Item was changed: ----- Method: StrikeFont>>bonk:with: (in category 'emphasis') ----- bonk: glyphForm with: bonkForm "Bonking means to run through the glyphs clearing out black pixels between characters to prevent them from straying into an adjacent character as a result of, eg, bolding or italicizing" "Uses the bonkForm to erase at every character boundary in glyphs." | bb offset x | offset := bonkForm offset x. + bb := BitBlt toForm: glyphForm. - bb := BitBlt current toForm: glyphForm. bb sourceForm: bonkForm; sourceRect: bonkForm boundingBox; combinationRule: Form erase; destY: 0. x := self xTable. (x isMemberOf: SparseLargeTable) ifTrue: [ x base to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ] ifFalse: [ 1 to: x size-1 do: [:i | bb destX: (x at: i) + offset; copyBits]. ]. ! Item was changed: ----- Method: StrikeFont>>displayLine:at: (in category 'displaying') ----- displayLine: aString at: aPoint "Display the characters in aString, starting at position aPoint." self characters: (1 to: aString size) in: aString displayAt: aPoint clippedBy: Display boundingBox rule: Form over fillColor: nil kernDelta: 0 + on: (BitBlt toForm: Display). - on: (BitBlt current toForm: Display). ! Item was changed: ----- Method: WarpBlt class>>current (in category 'instance creation') ----- current "Return the class currently to be used for WarpBlt" + ^self! - ^Display defaultWarpBltClass! Item was changed: ----- Method: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') ----- warpBitsSmoothing: n sourceMap: sourceMap | deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne picker poker pix nSteps | <primitive: 'primitiveWarpBits' module: 'BitBltPlugin'> "Check for compressed source, destination or halftone forms" ((sourceForm isForm) and: [sourceForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. ((destForm isForm) and: [destForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. ((halftoneForm isForm) and: [halftoneForm unhibernate]) ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap]. (width < 1) | (height < 1) ifTrue: [^ self]. fixedPtOne := 16384. "1.0 in fixed-pt representation" n > 1 ifTrue: [(destForm depth < 16 and: [colorMap == nil]) ifTrue: ["color map is required to smooth non-RGB dest" ^ self primitiveFail]. pix := Array new: n*n]. nSteps := height-1 max: 1. deltaP12 := (self deltaFrom: p1x to: p2x nSteps: nSteps) @ (self deltaFrom: p1y to: p2y nSteps: nSteps). pA := (self startFrom: p1x to: p2x offset: nSteps*deltaP12 x) @ (self startFrom: p1y to: p2y offset: nSteps*deltaP12 y). deltaP43 := (self deltaFrom: p4x to: p3x nSteps: nSteps) @ (self deltaFrom: p4y to: p3y nSteps: nSteps). pB := (self startFrom: p4x to: p3x offset: nSteps*deltaP43 x) @ (self startFrom: p4y to: p3y offset: nSteps*deltaP43 y). + picker := BitBlt bitPeekerFromForm: sourceForm. + poker := BitBlt bitPokerToForm: destForm. - picker := BitBlt current bitPeekerFromForm: sourceForm. - poker := BitBlt current bitPokerToForm: destForm. poker clipRect: self clipRect. nSteps := width-1 max: 1. destY to: destY+height-1 do: [:y | deltaPAB := (self deltaFrom: pA x to: pB x nSteps: nSteps) @ (self deltaFrom: pA y to: pB y nSteps: nSteps). sp := (self startFrom: pA x to: pB x offset: nSteps*deltaPAB x) @ (self startFrom: pA y to: pB y offset: nSteps*deltaPAB x). destX to: destX+width-1 do: [:x | n = 1 ifTrue: [poker pixelAt: x@y put: (picker pixelAt: sp // fixedPtOne asPoint)] ifFalse: [0 to: n-1 do: [:dx | 0 to: n-1 do: [:dy | pix at: dx*n+dy+1 put: (picker pixelAt: sp + (deltaPAB*dx//n) + (deltaP12*dy//n) // fixedPtOne asPoint)]]. poker pixelAt: x@y put: (self mixPix: pix sourceMap: sourceMap destMap: colorMap)]. sp := sp + deltaPAB]. pA := pA + deltaP12. pB := pB + deltaP43]!

1 0

The Trunk: Collections-tpr.511.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

tim Rowledge uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-tpr.511.mcz ==================== Summary ==================== Name: Collections-tpr.511 Author: tpr Time: 25 March 2013, 2:10:42.848 pm UUID: 028a2dce-fd27-49ab-adc5-933eb24e0bdb Ancestors: Collections-tpr.510 Remove BitBlt|WarpBlt>current usage - it's a vestige of an old experiment =============== Diff against Collections-nice.509 =============== Item was changed: ----- Method: PositionableStream>>nextWordsInto: (in category 'accessing') ----- nextWordsInto: aBitmap "Fill the word based buffer from my collection. Stored on stream as Big Endian. Optimized for speed. Read in BigEndian, then restoreEndianness." | blt pos source byteSize | collection class isBytes ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1]. byteSize := aBitmap byteSize. "is the test on collection basicSize \\ 4 necessary?" ((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0]) ifTrue: [source := collection. pos := self position. self skip: byteSize] ifFalse: ["forced to copy it into a buffer" source := self next: byteSize. pos := 0]. "Now use BitBlt to copy the bytes to the bitmap." + blt := (BitBlt - blt := (BitBlt current toForm: (Form new hackBits: aBitmap)) sourceForm: (Form new hackBits: source). blt combinationRule: Form over. "store" blt sourceX: 0; sourceY: pos // 4; height: byteSize // 4; width: 4. blt destX: 0; destY: 0. blt copyBits. "And do whatever the bitmap needs to do to convert from big-endian order." aBitmap restoreEndianness. ^ aBitmap "May be WordArray, ColorArray, etc" !

1 0

Re: [squeak-dev] "Chain" to a different image?
by Chris Muller 25 Mar '13

25 Mar '13

It may not be what you want, but another thing you can do is save the current image as another name and continue executing. On Sun, Mar 24, 2013 at 8:27 PM, Jim Rosenberg <jr(a)amanue.com> wrote: > 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 >

1 0

Re: Reproducible VM crash when loading FFI
by Eliot Miranda 25 Mar '13

25 Mar '13

Hi Guille, thanks for this. The problem is that Pharo's recreateSpecialObjectsArray uses newCompactClassesArray to recreate the compact classes array and on Cog that is not supported. Cog caches the compactClassesArray (specialObjectsArray at: 29) in every jitted method prolog to reduce the time taken to derive the receiver's class in message lookup. The Pharo 2.0 code for recreating the specialObjectsArray can therefore create a dangling pointer where the only reference to the old compactClassesArray is in machine code, and the machine code GC doesn't cope with there being roots in machine code. Note that Cog also caches the characterTable and class SmallInteger in machine code. There are two solutions to this. One would be to reuse the compactClassesArray (my recommendation). So that recreateSpecialObjectsArray looks like ... "An array of the 255 Characters in ascii order. Cog inlines table into machine code at: prim so do not regenerate it." newArray at: 25 put: Character characterTable. ... "A 32-element array with up to 32 classes that have compact instances. Cog inlines table into machine code class lookup so do not regenerate it." newArray at: 29 put: self compactClassesArray. ... where compactClassesArray, like Character characterTable, answers the existing object. The second solution (rather hackish) is to void all machine code on installing the new specialObjectsArray. e.g. recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." "Replace the interpreter's reference in one atomic operation. Void machine code to avoid crashing Cog." | newSpecialObjectsArray | newSpecialObjectsArray := self newSpecialObjectsArray. self specialObjectsArray becomeForward: newSpecialObjectsArray. Smalltalk vm voidCogVMState this is my fault for not ensuring recreateSpecialObjectsArray was properly commented. I had commented the inlining of Character table, but not the inlining of the CompactClasses array. Apologies. HTH, Eliot On Sat, Mar 23, 2013 at 10:19 AM, Guillermo Polito < guillermopolito(a)gmail.com> wrote: > Hi! > > In my quest to crash the vm, i've found an ugly common case :(. > I am trying to port the opendbx driver to 2.0, but I'm getting vm crashes > when my configuration loads FFI :(. I updated my configuration to load > version 1.7 of FFI (which I assume is the latest). > > I tried to do it in Pharo 2.0 with latest pharovm, and with eliot's Cog > 2701 from his website, failing in both cases. > The snippet of code that gets a sistematic crash is: > > Gofer it > smalltalkhubUser: 'DBXTalk' project: 'DBXTalkDriver'; > package: 'ConfigurationOfOpenDBXDriver'; > load. > ((Smalltalk at: #ConfigurationOfOpenDBXDriver) project version:#stable) > load > > > This snippet crashes always with a segmentation fault (at least the > fifteen times i tried :), with several different output in the console... > > Surprisingly, if I load FFI alone and not from the OpenDBXDriver > configuration, it loads well... :/ > > So I'm deferring the OpenDBX port a bit longer :( > > Thanks! > Guille > -- best, Eliot

1 0

The Trunk: Monticello-bf.534.mcz
by commits＠source.squeak.org 25 Mar '13

25 Mar '13

Bert Freudenberg uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-bf.534.mcz ==================== Summary ==================== Name: Monticello-bf.534 Author: bf Time: 25 March 2013, 4:04:22.764 pm UUID: c45273fb-83e7-4fa8-b8e7-6c12120c0c49 Ancestors: Monticello-nice.533, Monticello-cg.529 Merge Monticello-cg.529: allow colons and slashes in a package's name (MCVersion generated an invalid filename for those). Needed to be able to load monticello packages as written by ST/X. (Does not affect squeak/pharo operation, as those packages do not normally contain such characters) =============== Diff against Monticello-nice.533 =============== Item was changed: ----- Method: MCVersion>>fileName (in category 'accessing') ----- fileName + |rawName cookedName| + + rawName := info name. + "care for invalid filename characters" + cookedName := rawName copy + replaceAll: $/ with: $_; + replaceAll: $: with: $_.. + ^ (cookedName, '.', self writerClass extension) asMCVersionName! - ^ (info name, '.', self writerClass extension) asMCVersionName!

1 0

Re: [squeak-dev] The Inbox: Monticello-cg.529.mcz
by Bert Freudenberg 25 Mar '13

25 Mar '13

On 2013-03-25, at 13:10, commits(a)source.squeak.org wrote: > 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! > Merged. - Bert -

1 0

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

Jump to page: