[squeak-dev] The Trunk: Graphics-tpr.208.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Mar 26 18:20:13 UTC 2013


tim Rowledge uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-tpr.208.mcz

==================== Summary ====================

Name: Graphics-tpr.208
Author: tpr
Time: 26 March 2013, 11:19:24.327 am
UUID: 565062f6-2335-4484-bfb9-44a91a9e32eb
Ancestors: Graphics-tpr.207

Correct some idiotic bugs in Graphics-tpr.206
- the method intended to call the new pixel peeker bitblt prim wasn't doing so
- several places where pixelAt: was used should have been pixelValueAt: (and how stupid we have two variants to get confused)

=============== Diff against Graphics-tpr.206 ===============

Item was changed:
  ----- Method: Form>>floodFill2:at: (in category 'filling') -----
  floodFill2: aColor at: interiorPoint
  	"Fill the shape (4-connected) at interiorPoint.  The algorithm is based on Paul Heckbert's 'A Seed Fill Algorithm', Graphic Gems I, Academic Press, 1990.
  	NOTE: This is a less optimized variant for flood filling which is precisely along the lines of Heckbert's algorithm. For almost all cases #floodFill:at: will be faster (see the comment there) but this method is left in both as reference and as a fallback if such a strange case is encountered in reality."
  	| poker stack old new x y top x1 x2 dy left goRight |
  	poker := BitBlt bitPokerToForm: self.
  	stack := OrderedCollection new: 50.
  	"read old pixel value"
+ 	old := self pixelValueAt: interiorPoint.
- 	old := self pixelAt: interiorPoint.
  	"compute new value"
  	new := self pixelValueFor: aColor.
  	old = new ifTrue:[^self]. "no point, is there?!!"
  
  	x := interiorPoint x.
  	y := interiorPoint y.
  	(y >= 0 and:[y < height]) ifTrue:[
  		stack addLast: {y. x. x. 1}. "y, left, right, dy"
  		stack addLast: {y+1. x. x. -1}].
  	[stack isEmpty] whileFalse:[
  		top := stack removeLast.
  		y := top at: 1. x1 := top at: 2. x2 := top at: 3. dy := top at: 4.
  		y := y + dy.
  		"Segment of scanline (y-dy) for x1 <= x <= x2 was previously filled.
  		Now explore adjacent pixels in scanline y."
  		x := x1.
+ 		[x >= 0 and:[(self pixelValueAt: x at y) = old]] whileTrue:[
- 		[x >= 0 and:[(self pixelAt: x at y) = old]] whileTrue:[
  			poker pixelAt: x at y put: new.
  			x := x - 1].
  		goRight := x < x1.
  		left := x+1.
  		(left < x1 and:[y-dy >= 0 and:[y-dy < height]]) 
  			ifTrue:[stack addLast: {y. left. x1-1. 0-dy}].
  		goRight ifTrue:[x := x1 + 1].
  		[
  			goRight ifTrue:[
+ 				[x < width and:[(self pixelValueAt: x at y) = old]] whileTrue:[
- 				[x < width and:[(self pixelAt: x at y) = old]] whileTrue:[
  					poker pixelAt: x at y put: new.
  					x := x + 1].
  				(y+dy >= 0 and:[y+dy < height]) 
  					ifTrue:[stack addLast: {y. left. x-1. dy}].
  				(x > (x2+1) and:[y-dy >= 0 and:[y-dy >= 0]]) 
  					ifTrue:[stack addLast: {y. x2+1. x-1. 0-dy}]].
+ 			[(x := x + 1) <= x2 and:[(self pixelValueAt: x at y) ~= old]] whileTrue.
- 			[(x := x + 1) <= x2 and:[(self pixelAt: x at y) ~= old]] whileTrue.
  			left := x.
  			goRight := true.
  		x <= x2] whileTrue.
  	].
  !

Item was changed:
  ----- Method: Form>>primPixelValueAtX:y: (in category 'pixel access') -----
  primPixelValueAtX: x y: y 
  	"Return the raw pixel value at the given point. This pixel value depends on the receiver's depth. Typical clients use colorAt: to get a Color. Make sure the colorMap is nil for ColorForms "
  
+ 	<primitive: 'primitivePixelValueAt' module:'BitBltPlugin'>
- 	<primitive: 'primitivePixelValueAt' module:'PixelValuePeekPlugin'>
  	^(BitBlt bitPeekerFromForm: self) colorMap: nil;  pixelAt: x at y!

Item was changed:
  ----- Method: PNMReadWriter>>nextPutGray: (in category 'writing') -----
  nextPutGray: aForm
  	| myType 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.
  	0 to: rows-1 do: [:y |
  		0 to: cols-1 do: [:x |
+ 			val := aForm pixelValueAt: x at y.
- 			val := aForm pixelAt: x at y.
  			stream nextPut: val.
  		]
  	].
  !

Item was changed:
  ----- Method: PNMReadWriter>>nextPutRGB: (in category 'writing') -----
  nextPutRGB: aForm
  	| myType 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].
  	0 to: rows-1 do: [:y |
  		0 to: cols-1 do: [:x | | p r g b |
+ 			p := f pixelValueAt: x at y.
- 			p := f pixelAt: x at 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: Pen>>print:withFont: (in category 'operations') -----
  print: str withFont: font
  	"Print the given string in the given font at the current heading"
  	| lineStart scale wasDown |
  	scale := sourceForm width.
  	wasDown := penDown.
  	lineStart := location.
  	str do:
  		[:char |
  		char = Character cr ifTrue:
  			[self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
  		ifFalse:
  			[ | charStart pix rowStart form backgroundCode |
  			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.
  				pix := RunArray newFrom:
+ 					((0 to: form width-1) collect: [:x | form pixelValueAt: x at y]).
- 					((0 to: form width-1) collect: [:x | form pixelAt: x at 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: WarpBlt>>warpBitsSmoothing:sourceMap: (in category 'primitives') -----
  warpBitsSmoothing: n sourceMap: sourceMap
  	| deltaP12 deltaP43 pA pB deltaPAB sp fixedPtOne poker pix nSteps |
  	<primitive: 'primitiveWarpBits' module: 'BitBltPlugin'>
  
  	"Check for compressed source, destination or halftone forms"
  	((sourceForm isForm) and: [sourceForm unhibernate])
  		ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap].
  	((destForm isForm) and: [destForm unhibernate])
  		ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap].
  	((halftoneForm isForm) and: [halftoneForm unhibernate])
  		ifTrue: [^ self warpBitsSmoothing: n sourceMap: sourceMap].
  
  	(width < 1) | (height < 1) ifTrue: [^ self].
  	fixedPtOne := 16384.  "1.0 in fixed-pt representation"
  	n > 1 ifTrue:
  		[(destForm depth < 16 and: [colorMap == nil])
  			ifTrue: ["color map is required to smooth non-RGB dest"
  					^ self primitiveFail].
  		pix := Array new: n*n].
  
  	nSteps := height-1 max: 1.
  	deltaP12 := (self deltaFrom: p1x to: p2x nSteps: nSteps)
  			@ (self deltaFrom: p1y to: p2y nSteps: nSteps).
  	pA := (self startFrom: p1x to: p2x offset: nSteps*deltaP12 x)
  		@ (self startFrom: p1y to: p2y offset: nSteps*deltaP12 y).
  	deltaP43 := (self deltaFrom: p4x to: p3x nSteps: nSteps)
  			@ (self deltaFrom: p4y to: p3y nSteps: nSteps).
  	pB := (self startFrom: p4x to: p3x offset: nSteps*deltaP43 x)
  		@ (self startFrom: p4y to: p3y offset: nSteps*deltaP43 y).
  
  	poker := BitBlt bitPokerToForm: destForm.
  	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 at y
+ 						put: (sourceForm pixelValueAt: sp // fixedPtOne asPoint)]
- 						put: (sourceForm pixelAt: sp // fixedPtOne asPoint)]
  			ifFalse:
  				[0 to: n-1 do:
  					[:dx | 0 to: n-1 do:
  						[:dy |
  						pix at: dx*n+dy+1 put:
+ 								(sourceForm pixelValueAt: sp
- 								(sourceForm pixelAt: sp
  									+ (deltaPAB*dx//n)
  									+ (deltaP12*dy//n)
  										// fixedPtOne asPoint)]].
  				poker pixelAt: x at y put: (self mixPix: pix
  										sourceMap: sourceMap
  										destMap: colorMap)].
  			sp := sp + deltaPAB].
  		pA := pA + deltaP12.
  		pB := pB + deltaP43]!



More information about the Squeak-dev mailing list