'From Cuis 1.0 of 21 August 2009 [latest update: #268] on 27 August 2009 at 9:29:55 am'!

!BitBlt methodsFor: 'copying' stamp: 'jmv 8/27/2009 08:59'!
displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta
	"If required, do a second pass with new rule and colorMap"

	| answer prevRule secondPassMap sourceDepth destDepth |
	"If combinationRule is rgbMul, we might need the special two-pass technique for component alpha blending.
	If not, do it simply"
	combinationRule = 37 "rgbMul" ifFalse: [
		^self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta ].
	
	"We need to do a second pass. The colormap set is for use in the second pass."
	secondPassMap _ colorMap.
	sourceDepth _ sourceForm depth.
	destDepth _ destForm depth.
	colorMap _ sourceDepth ~= destDepth
		ifTrue: [ Color cachedColormapFrom: sourceDepth to: destDepth ].
	answer := self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
	colorMap := secondPassMap.
	secondPassMap ifNotNil: [
		prevRule := combinationRule.
		combinationRule := 20. "rgbAdd"
		self basicDisplayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
		combinationRule := prevRule ].
	^answer! !

!BitBlt methodsFor: 'private' stamp: 'jmv 8/27/2009 09:18'!
cachedFontColormapFrom1BitTo: destDepth

	| map |
	CachedFontColorMaps 
		ifNil: [CachedFontColorMaps _ Array new: 32].
	(map _ CachedFontColorMaps at: destDepth) ifNotNil: [^ map].

	map _ (Color cachedColormapFrom: 1 to: destDepth) copy.
	CachedFontColorMaps at: destDepth put: map.
	^ map
! !

!BitBlt methodsFor: 'private' stamp: 'jmv 8/27/2009 08:48'!
colorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix
	"Note: The color converting map for sourceDepth=16 and for sourceDepth=32 are the same"
	
	| srcIndex map mapsForSource mapsForSourceAndDest |
	ColorConvertingMaps 
		ifNil: [ColorConvertingMaps _ (1 to: 10) collect: [:i | Array new: 32]].
		
	srcIndex _ sourceDepth.
	sourceDepth > 8 ifTrue: [ srcIndex _ keepSubPix ifTrue: [9] ifFalse: [10] ].
	mapsForSource _ ColorConvertingMaps at: srcIndex.
	(mapsForSourceAndDest _ mapsForSource at: destDepth) ifNil: [
		mapsForSourceAndDest _ mapsForSource at: destDepth put: Dictionary new ].
	
	map _ mapsForSourceAndDest at: targetColor ifAbsentPut: [
		Color 
			computeColorConvertingMap: targetColor 
			from: sourceDepth 
			to: destDepth 
			keepSubPixelAA: keepSubPix ].

	^ map
! !

!BitBlt methodsFor: 'private' stamp: 'jmv 8/27/2009 09:25'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor

	| lastSourceDepth targetColor sourceDepth destDepth |
	sourceForm notNil ifTrue: [ lastSourceDepth _ sourceForm depth ].
	sourceForm _ aStrikeFont glyphs.
	sourceDepth _ sourceForm depth.
	destDepth _ destForm depth.
	"Ignore any halftone pattern since we use a color map approach here"
	halftoneForm _ nil.
	sourceY _ 0.
	height _ aStrikeFont height.

	sourceDepth = 1 ifTrue: [
		self combinationRule: Form paint.
		(colorMap isNil or: [ lastSourceDepth ~= sourceDepth ]) ifTrue: [
			"Set up color map for a different source depth (color font)"
			"Uses caching for reasonable efficiency
			Warning: We are not considering that destDepth could change too, requiring a new colormap
			This seems not to cause any problems..."
			colorMap _ self cachedFontColormapFrom1BitTo: destDepth.
			colorMap at: 1 put: (destForm pixelValueFor: Color transparent)].
		colorMap at: 2 put: (destForm pixelValueFor: foregroundColor) ]
	
	ifFalse: [
		(Preferences subPixelRenderFonts and: [ foregroundColor = Color black or: [ Preferences subPixelRenderColorFonts ]]) ifTrue: [
			destDepth > 8 ifTrue: [
				"rgbMul is equivalent to component alpha blend if text is black (only faster, hehe)"
				self combinationRule: 37.		"rgbMul"
				colorMap _ (Preferences properAlphaForBlackText or: [ (foregroundColor = Color black) not ]) ifTrue: [
					"rgbMul / rgbAdd IS component alpha blend for any color of text (neat trick, eh!!)"
					"This colorMap is to be used on the second pass with rule 20 (rgbAdd)
					See #displayString:from:to:at:strikeFont:kern:"
					self colorConvertingMap: foregroundColor from: sourceDepth to: destDepth keepSubPixelAA: true]]
			ifFalse: [
				self combinationRule: 25.		"Paint"
				targetColor _ foregroundColor = Color black ifFalse: [ foregroundColor ].
				colorMap _ self colorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: true]]
		ifFalse: [
			"Do not use rule 34 for 16bpp display. TTCFont uses it, but it builds a glyphs cache for each color used!!"
			self combinationRule: (destDepth = 32 ifTrue: [34 "alphaBlendScaled"] ifFalse: [25 "Paint"]).
			colorMap _ self colorConvertingMap: foregroundColor from: sourceDepth to: destDepth keepSubPixelAA: false]].! !


!Color class methodsFor: 'colormaps' stamp: 'jmv 8/27/2009 08:56'!
cachedColormapFrom: sourceDepth to: destDepth
	"Return a cached colormap for mapping between the given depths. Always return a real colormap, not nil; this allows the client to get an identity colormap that can then be copied and modified to do color transformations."
	"Note: This method returns a shared, cached colormap to save time and space. Clients that need to modify a colormap returned by this method should make a copy and modify that!!"
	"Note: The colormap cache may be cleared by evaluating 'Color shutDown'."
	"Note: The color maps for sourceDepth=16 and for sourceDepth=32 are the same"

	| srcIndex map |
	CachedColormaps
		ifNil: [CachedColormaps _ (1 to: 9) collect: [:i | Array new: 32]].
	
	srcIndex _ sourceDepth.
	sourceDepth > 8 ifTrue: [srcIndex _ 9].
	(map _ (CachedColormaps at: srcIndex) at: destDepth) ifNotNil: [^ map].

	map _ self computeColormapFrom: sourceDepth to: destDepth.
	(CachedColormaps at: srcIndex) at: destDepth put: map.
	^ map
! !

!Color class methodsFor: 'colormaps' stamp: 'jmv 8/27/2009 08:47'!
computeColorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix
	"Note: The color converting map for sourceDepth=16 and for sourceDepth=32 are the same"
	sourceDepth < 16 ifTrue: [
		"source is 1-, 2-, 4-, or 8-bit indexed color.
		Assumed not to include subpixelAA"
		^ self computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
	] ifFalse: [
		"source is 16-bit or 32-bit RGB.
		Might include subpixelAA"
		^ self computeRGBColorConvertingMap: targetColor to: destDepth keepSubPixelAA: keepSubPix
	]! !

!Color class methodsFor: 'colormaps' stamp: 'jmv 8/27/2009 08:53'!
computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
	| map f c |
	
	map _ (IndexedColors copyFrom: 1 to: (1 bitShift: sourceDepth)) collect: [ :cc | 
		f _ 1.0 - (cc red + cc green + cc blue / 3.0 ).
		c _ targetColor
			ifNotNil: [
				destDepth = 32
					ifTrue: [ targetColor * f alpha: f]
					ifFalse: [ targetColor alphaMixed: f*1.5 with: Color white ]]
			ifNil: [ cc ].
		destDepth = 32
			ifTrue: [ c pixelValueForDepth: destDepth]
			ifFalse: [
				f = 0.0
					ifTrue: [ 0 ]
					ifFalse: [ c pixelValueForDepth: destDepth ]]].
	map _ map as: Bitmap.
	^map! !

!Color class methodsFor: 'colormaps' stamp: 'jmv 8/27/2009 08:54'!
computeRGBColorConvertingMap: targetColor to: destDepth keepSubPixelAA: keepSubPix
	"Builds a colormap intended to convert from subpixelAA black values to targetColor values.
	keepSubPix
		ifTrue: [ Answer colors that also include subpixelAA ]
		ifFalse: [ 
			Take fullpixel luminance level. Apply it to targetColor.
			I.e. answer colors with NO subpixelAA ]"

	| mask map c bitsPerColor r g b f v |

	destDepth > 8
		ifTrue: [bitsPerColor _ 5]  "retain maximum color resolution"
		ifFalse: [bitsPerColor _ 4].
	"Usually a bit less is enough, but make it configurable"
	bitsPerColor _ bitsPerColor min: Preferences aaFontsColormapDepth.
	mask _ (1 bitShift: bitsPerColor) - 1.
	map _ Bitmap new: (1 bitShift: (3 * bitsPerColor)).
	0 to: map size - 1 do: [:i |
		r _ (i bitShift: 0 - (2 * bitsPerColor)) bitAnd: mask.
		g _ (i bitShift: 0 - bitsPerColor) bitAnd: mask.
		b _ (i bitShift: 0) bitAnd: mask.
		f _ 1.0 - (r + g + b / 3.0 / mask).
		c _ targetColor
			ifNotNil: [
				(keepSubPix and: [destDepth > 8]) ifTrue: [
						Color
							r: 1.0 - (r/mask) * targetColor red
							g: 1.0 - (g/mask) * targetColor green
							b: 1.0 - (b/mask) * targetColor blue ]
				ifFalse: [
					destDepth = 32
						ifTrue: [ targetColor * f alpha: f ]
						ifFalse: [ targetColor alphaMixed: f*1.5 with: Color white ]]]
			ifNil: [ Color r: r g: g b: b range: mask].
		v _ destDepth = 32
			ifTrue: [ c pixelValueForDepth: destDepth]
			ifFalse: [
				f < 0.1
					ifTrue: [ 0 ]
					ifFalse: [ c pixelValueForDepth: destDepth ]].
		map at: i + 1 put: v ].
	^ map! !


!MessageTally class methodsFor: 'spying' stamp: 'jmv 8/27/2009 08:12'!
spyAllOn: aBlock
	"Spy on all the processes in the system
	
	[1000 timesRepeat: [3.14159 printString. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	[1000 timesRepeat: [20 factorial. Processor yield]] fork.
	MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait]
	
	"
	| node result |
	node _ self new.
	result _ node spyAllEvery: self defaultPollPeriod on: aBlock.
	(CodeHolder new contents: (String streamContents: [:s | node report: s; close]))
		openLabel: 'Spy Results' wrap: false.
	^ result! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 8/27/2009 08:12'!
spyOn: aBlock
	"
	[1000 timesRepeat: [
		100 timesRepeat: [120 factorial].
		(Delay forMilliseconds: 10) wait
		]] forkAt: 45 named: '45'.
	MessageTally spyOn: [10000 timesRepeat: [1.23 printString]]
	"
	| node result |
	node _ self new.
	result _ node spyEvery: self defaultPollPeriod on: aBlock.
	(CodeHolder new contents: (String streamContents: [:s | node report: s; close]))
		openLabel: 'Spy Results' wrap: false.
	^ result! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 8/27/2009 08:12'!
spyOnProcess: aProcess forMilliseconds: msecDuration 
	"
	| p1 p2 |  
	p1 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork.  
	p2 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork.  
	(Delay forMilliseconds: 100) wait.  
	MessageTally spyOnProcess: p1 forMilliseconds: 1000
	"
	| node |
	node _ self new.
	node
		spyEvery: self defaultPollPeriod
		onProcess: aProcess
		forMilliseconds: msecDuration.
	(CodeHolder new
		contents: (String
				streamContents: [:s | node report: s;
						 close]))
		openLabel: 'Spy Results' wrap: false! !

!MessageTally class methodsFor: 'spying' stamp: 'jmv 8/27/2009 08:12'!
tallySendsTo: receiver inBlock: aBlock showTree: treeOption
	"MessageTally tallySends: [3.14159 printString]"
	"This method uses the simulator to count the number of calls on each method
	invoked in evaluating aBlock. If receiver is not nil, then only sends
	to that receiver are tallied.
	Results are presented as leaves, sorted by frequency,
	preceded, optionally, by the whole tree."
	| prev tallies startTime totalTime |
	startTime _ Time millisecondClockValue.
	tallies _ MessageTally new class: aBlock receiver class
							method: aBlock method.
	prev _ aBlock.
	thisContext sender
		runSimulated: aBlock
		contextAtEachStep:
			[:current |
			current == prev ifFalse: 
				["call or return"
				prev sender == nil ifFalse: 
					["call only"
					(receiver == nil or: [current receiver == receiver])
						ifTrue: [tallies tally: current by: 1]].
				prev _ current]].

	totalTime _ Time millisecondClockValue - startTime // 1000.0 roundTo: 0.01.
	(CodeHolder new contents:
		(String streamContents:
			[:s |
			s nextPutAll: 'This simulation took ' , totalTime printString
							, ' seconds.'; cr.
			treeOption
				ifTrue: [tallies fullPrintOn: s tallyExact: true orThreshold: 0]
				ifFalse: [tallies leavesPrintOn: s tallyExact: true orThreshold: 0].
			tallies close]))
		openLabel: 'Spy Results' wrap: false! !

BitBlt removeSelector: #cachedFontColormapFrom:to:!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
BitBlt recreateColorMaps!

