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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 13 23:40:34 UTC 2015


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

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

Name: Graphics-tpr.319
Author: tpr
Time: 13 November 2015, 3:40:15.027 pm
UUID: ea659db8-1afb-4241-9600-37ed16edd7b6
Ancestors: Graphics-tpr.318

Second try - 
Add support for Pi-accelerating bitblt colour testing calls.
Make StrikeFont loading methods actually work.
Change Form>asFormOfDepth: - this may possibly be contentious but it certainly makes Scratch image loading more reliable

=============== Diff against Graphics-eem.317 ===============

Item was added:
+ ----- Method: BitBlt>>primCompareColor:to:test: (in category 'private') -----
+ primCompareColor: colorValueA to: colorValueB test: testID
+ 	"Call the prim that compares pixel color values and can tell if two Forms that overlap in some manner when composited are touching colors as defined by the testID.
+ "
+ 	<primitive: 'primitiveCompareColors' module: 'BitBltPlugin'>
+ 	"to signal failure without an error we'll return -1"
+ 	^-1!

Item was added:
+ ----- Method: Form class>>compareMatchColor (in category 'mode constants') -----
+ compareMatchColor
+ 	"The primCompare test id values are
+ 	compareMatchColors -> 0
+ 	compareNotColorANotColorB -> 1
+ 	compareNotColorAMatchColorB -> 2"
+ 	^0!

Item was added:
+ ----- Method: Form class>>compareNotColorAMatchColorB (in category 'mode constants') -----
+ compareNotColorAMatchColorB
+ 	"The primCompare test id values are
+ 	compareMatchColors -> 0
+ 	compareNotColorANotColorB -> 1
+ 	compareNotColorAMatchColorB -> 2"
+ 	^2!

Item was added:
+ ----- Method: Form class>>compareNotColorANotColorB (in category 'mode constants') -----
+ compareNotColorANotColorB
+ 	"The primCompare test id values are
+ 	compareMatchColors -> 0
+ 	compareNotColorANotColorB -> 1
+ 	compareNotColorAMatchColorB -> 2"
+ 	^1!

Item was added:
+ ----- Method: Form class>>compareTallyFlag (in category 'mode constants') -----
+ compareTallyFlag
+ 	"The primCompare test id values are ORR'd with 8 to indicate tallying rather than simply reporting the first hit"
+ 	^8!

Item was added:
+ ----- Method: Form class>>exampleColorSees (in category 'examples') -----
+ exampleColorSees
+ 	"Form exampleColorSees"
+ 	"First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon.
+ 	Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this
+ 	Third shows the hit area - where red touches blue - superimposed on the original scene.
+ 	Fourth column is the tally of hits via the old algorithm
+ 	Last column shows the tally of hits via the new prim"	
+ 		
+ 	|formA formB maskA  offset tally map intersection left top dCanvas sensitiveColor soughtColor index|
+ 	formA := formB := maskA := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"
+ 	ActiveWorld restoreMorphicDisplay; doOneCycle.
+ 
+ 	sensitiveColor := Color red.
+ 	soughtColor := Color blue.
+ 
+ 	top := 50.
+ 	dCanvas := FormCanvas on: Display.
+ 	-50 to: 80 by: 10 do:[:p|
+ 		offset:= p at 0. "vary this to check different states"
+ 		left := 10.
+ 
+ 		formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths".
+ 		formB := Form extent: 100 at 50 depth: 32.
+ 
+ 		"make a red square in the middle of the form"
+ 		(FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: sensitiveColor.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow.
+ 		"formA displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		"make a blue block on the right half of the form"
+ 		(FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: soughtColor.
+ 		(FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach.
+ 		"formB displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).
+ 
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150.
+ 	
+ 		maskA := Form extent: intersection extent depth: 1.
+ 
+ 		map := Bitmap new: (1 bitShift: (formA depth min: 15)).
+ 		map at: (index := sensitiveColor indexInMap: map) put: 1.
+ 
+ 		maskA copyBits: (intersection translateBy:  offset negated) from: formA at: 0 at 0 colorMap: map.
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.	left := left + 150.
+ 
+ 		"intersect world pixels of the color we're looking for with sensitive pixels mask"
+ 		map at: index put: 0.  "clear map and reuse it"
+ 		map at: (soughtColor indexInMap: map) put: 1.
+ 
+ 		maskA
+ 	 		copyBits: intersection
+ 			from: formB at: 0 at 0 clippingBox: formB boundingBox
+ 			rule: Form and
+ 			fillColor: nil
+ 			map: map.
+ 
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 170.
+ 		
+ 		(maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20).
+ 		left := left + 70.
+ 		
+ 		"now try using the new primitive"
+ 		tally := (BitBlt
+ 			destForm: formB
+ 			sourceForm: formA
+ 			fillColor: nil
+ 			combinationRule: 3 "really ought to work with nil but prim code checks"
+ 			destOrigin: intersection origin
+ 			sourceOrigin: (offset negated max: 0 at 0)
+ 			extent: intersection extent 
+ 			clipRect: intersection)
+ 				primCompareColor: ((sensitiveColor pixelValueForDepth: formA depth) ) to: ((soughtColor pixelValueForDepth: formB depth) ) test: (Form compareMatchColor bitOr: Form compareTallyFlag).
+ 		tally  asString asDisplayText displayOn: Display at: left@(top +20).
+ 		top:= top + 60]
+ 
+ !

Item was added:
+ ----- Method: Form class>>exampleTouchTest (in category 'examples') -----
+ exampleTouchTest
+ 	"Form exampleTouchTest"
+ 	"Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a 
+ 	non-transparent pixel of the background upon which it is displayed.
+ 	First column shows a form with a red block in the midst of transparent area sneaking up on a form with a transparent LHS and blue RHS. 	The green frame shows the intersection area.
+ 	Second column shows in grey the part of the red that is within the intersection.
+ 	Third column shows in black the blue that is within the intersection.
+ 	Fourth column shows just the A touching B area.
+ 	Fifth column is the tally of hits via the old algorithm
+ 	Last column shows the tally of hits via the new prim"
+ 	|formA formB maskA maskB offset tally map intersection left top dCanvas|
+ 	formA := formB := maskA := maskB := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"
+ 
+ 	ActiveWorld restoreMorphicDisplay; doOneCycle.
+ 
+ 	top := 50.
+ 	dCanvas := FormCanvas on: Display.
+ 	-50 to: 80 by: 10 do:[:p|
+ 		offset:= p at 0. "vary this to check different states"
+ 		left := 10.
+ 
+ 		formA := Form extent: 100 at 50 depth: 32.
+ 		formB := Form extent: 100 at 50 depth: 16.
+ 
+ 		"make a red square in the middle of the form"
+ 		(FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color yellow.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color red.
+ 		"formA displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		"make a blue block on the right half of the form"
+ 		(FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: Color blue.
+ 		(FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach.
+ 		"formB displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).
+ 
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150.
+ 
+ 		maskA := Form extent: intersection extent depth: 2.
+ 		formA displayOn: maskA at: offset  - intersection origin rule: Form paint.
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150.
+ 
+ 		maskB := Form extent: intersection extent depth: 2.
+ 		formB displayOn: maskB at: intersection origin negated rule: Form paint.
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150.
+ 
+ 		map := Bitmap new: 4 withAll: 1.
+ 		map at: 1 put: 0.  "transparent"
+ 
+ 		maskA copyBits: maskA boundingBox from: maskA at: 0 at 0 colorMap: map.
+ 		"maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		maskB copyBits: maskB boundingBox from: maskB at: 0 at 0 colorMap: map.
+ 		"maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		maskB displayOn: maskA at: 0 at 0 rule: Form and.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 170.
+ 		
+ 		(maskA boundingBox area -( maskA tallyPixelValues at: 1)) asString asDisplayText displayOn: Display at: left@(top +20).
+ 		left := left + 70.
+ 		
+ 		"now try using the new primitive"
+ 		tally := (BitBlt
+ 			destForm: formB
+ 			sourceForm: formA
+ 			fillColor: nil
+ 			combinationRule: 3 "really ought to work with nil but prim code checks"
+ 			destOrigin: intersection origin
+ 			sourceOrigin: (offset negated max: 0 at 0)
+ 			extent: intersection extent 
+ 			clipRect: intersection)
+ 				primCompareColor: ((Color transparent pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((Color transparent pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorANotColorB bitOr: Form compareTallyFlag).
+ 		tally  asString asDisplayText displayOn: Display at: left@(top +20).
+ 		top:= top + 60]
+ 
+ 
+ !

Item was added:
+ ----- Method: Form class>>exampleTouchingColor (in category 'examples') -----
+ exampleTouchingColor
+ 	"Form exampleTouchingColor"
+ 	"Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a
+ 	particular color pixel of the background upon which it is displayed.
+ 	First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon.
+ 	Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this
+ 	Third shows the hit area (black) superimposed on the original scene
+ 	Fourth column is the tally of hits via the old algorithm
+ 	Last column shows the tally of hits via the new prim"	
+ 	|formA formB maskA  offset tally map intersection left top dCanvas ignoreColor soughtColor|
+ 	formA := formB := maskA := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"
+ 	ActiveWorld restoreMorphicDisplay; doOneCycle.
+ 
+ 	ignoreColor := Color transparent.
+ 	soughtColor := Color blue.
+ 
+ 	top := 50.
+ 	dCanvas := FormCanvas on: Display.
+ 	-50 to: 80 by: 10 do:[:p|
+ 		offset:= p at 0. "vary this to check different states"
+ 		left := 10.
+ 
+ 		formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths".
+ 		formB := Form extent: 100 at 50 depth: 32.
+ 
+ 		"make a red square in the middle of the form"
+ 		(FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color red.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent.
+ 		(FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow.
+ 		"formA displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		"make a blue block on the right half of the form"
+ 		(FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: soughtColor.
+ 		(FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach.
+ 		"formB displayOn: Display at: left at top rule: Form paint.
+ 		dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green.
+ 		left := left + 150."
+ 
+ 		intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).
+ 
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 150.
+ 	
+ 		maskA := Form extent: intersection extent depth: 1.
+ 
+ 		map := Bitmap new: (1 bitShift: (formA depth min: 15)).
+ 		map atAllPut: 1.
+ 		map at: ( ignoreColor indexInMap: map) put: 0.
+ 
+ 		maskA copyBits: (intersection translateBy:  offset negated) from: formA at: 0 at 0 colorMap: map.
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.	left := left + 150.
+ 
+ 		"intersect world pixels of the color we're looking for with sensitive pixels mask"
+ 		map atAllPut: 0.  "clear map and reuse it"
+ 		map at: (soughtColor indexInMap: map) put: 1.
+ 
+ 		maskA
+ 	 		copyBits: intersection
+ 			from: formB at: 0 at 0 clippingBox: formB boundingBox
+ 			rule: Form and
+ 			fillColor: nil
+ 			map: map.
+ 
+ 		formB displayOn: Display at: left at top rule: Form paint.
+ 		formA displayOn: Display at: (left at top) + offset rule: Form paint.
+ 		maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint.
+ 		dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green.
+ 		left := left + 170.
+ 		
+ 		(maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20).
+ 		left := left + 70.
+ 		
+ 		"now try using the new primitive"
+ 		tally := (BitBlt
+ 			destForm: formB
+ 			sourceForm: formA
+ 			fillColor: nil
+ 			combinationRule: 3 "really ought to work with nil but prim code checks"
+ 			destOrigin: intersection origin
+ 			sourceOrigin: (offset negated max: 0 at 0)
+ 			extent: intersection extent 
+ 			clipRect: intersection)
+ 				primCompareColor: ((ignoreColor pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((soughtColor pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorAMatchColorB bitOr: Form compareTallyFlag).
+ 		tally  asString asDisplayText displayOn: Display at: left@(top +20).
+ 		top:= top + 60]
+ !

Item was changed:
  ----- Method: Form>>asFormOfDepth: (in category 'converting') -----
  asFormOfDepth: d
+ 	"Create a copy of me with depth 'd'. Includes a correction for some bitmaps that when imported have poorly set up transparency"
  	| newForm |
  	d = self depth ifTrue:[^self].
  	newForm := Form extent: self extent depth: d.
  	(BitBlt toForm: newForm)
  		colorMap: (self colormapIfNeededFor: newForm);
  		copy: (self boundingBox)
  		from: 0 at 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."
+ 	d = 32 ifTrue:[newForm fixAlpha].
- 	(self depth = 16 and:[d= 32]) ifTrue:[newForm fillAlpha: 255].
  	^newForm!

Item was changed:
  ----- Method: StrikeFont class>>readStrikeFont2Family: (in category 'examples') -----
  readStrikeFont2Family: familyName 
  	"StrikeFont readStrikeFont2Family: 'Lucida'"
+ 
  	^self readStrikeFont2Family: familyName fromDirectory: FileDirectory default!

Item was changed:
  ----- Method: StrikeFont class>>readStrikeFont2Family:fromDirectory: (in category 'examples') -----
  readStrikeFont2Family: familyName fromDirectory: aDirectory
  	"StrikeFont readStrikeFont2Family: 'Lucida' fromDirectory: FileDirectory default"
  	"This utility reads all available .sf2 StrikeFont files for a given family from  
  	the current directory. It returns an Array, sorted by size, suitable for handing 
  	to TextStyle newFontArray: ."
  	"For this utility to work as is, the .sf2 files must be named 'familyNN.sf2'."
  	| fileNames strikeFonts |
  	fileNames := aDirectory fileNamesMatching: familyName , '##.sf2'.
+ 	strikeFonts := fileNames collect: [:fname | StrikeFont new readFromStrike2: (aDirectory fullNameFor: fname)].
- 	strikeFonts := fileNames collect: [:fname | StrikeFont new readFromStrike2: fname].
  	strikeFonts do: [ :font | font reset ].
  	^strikeFonts asArray sort: [:a :b | a height < b height].
  
+ 	"TextConstants at: #Lucida put: (TextStyle fontArray: (StrikeFont  readStrikeFont2Family: 'Lucida' fromDirectory: FileDirectory default))."!
- "TextConstants at: #Lucida put: (TextStyle fontArray: (StrikeFont 
- 	readStrikeFont2Family: 'Lucida'))."!

Item was changed:
  ----- Method: StrikeFont>>readFromStrike2: (in category 'file in/out') -----
  readFromStrike2: fileName  "StrikeFont new readFromStrike2: 'Palatino14.sf2'"
  	"Build an instance from the strike font stored in strike2 format.
  	fileName is of the form: <family name><pointSize>.sf2"
  	| file |
  	('*.sf2' match: fileName) ifFalse: [self halt.  "likely incompatible"].
+ 	name := FileDirectory baseNameFor: ( FileDirectory localNameFor: fileName).  "Drop filename extension"
- 	name := fileName copyUpTo: $. .  "Drop filename extension"
  	file := FileStream readOnlyFileNamed: fileName.
  	file binary.
  	[self readFromStrike2Stream: file] ensure: [file close]!



More information about the Squeak-dev mailing list