'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 21 May 2009 at 2:29:50 pm'!
!classDefinition: #GrafPort category: #'Morphic-OldSupport'!
BitBlt subclass: #GrafPort
	instanceVariableNames: 'alpha fillPattern secondPassRule secondPassColorMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldSupport'!

!AbstractFont methodsFor: 'displaying' stamp: 'jmv 5/21/2009 12:34'!
installOn: aDisplayContext foregroundColor: foregroundColor
	"Install the receiver on the given DisplayContext (either BitBlt or Canvas) for further drawing operations."
	^self subclassResponsibility! !


!BitBlt methodsFor: 'private' stamp: 'jmv 5/21/2009 13:56'!
colorConvertingMap: targetColor from: sourceDepth to: destDepth

	| srcIndex map mapsForSource mapsForSourceAndDest |
	ColorConvertingMaps class == Array 
		ifFalse: [ColorConvertingMaps _ (1 to: 9) collect: [:i | Array new: 32]].
		
	srcIndex _ sourceDepth.
	sourceDepth > 8 ifTrue: [ srcIndex _ 9 ].
	mapsForSource _ ColorConvertingMaps at: srcIndex.
	(mapsForSourceAndDest _ mapsForSource at: destDepth) isNil ifTrue: [
		mapsForSourceAndDest _ mapsForSource at: destDepth put: Dictionary new ].
	
	map _ mapsForSourceAndDest at: targetColor ifAbsentPut: [
		Color computeColorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: false ].

	^ map
! !

!BitBlt methodsFor: 'private' stamp: 'jmv 5/21/2009 14:04'!
colorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix

	| srcIndex map mapsForSource mapsForSourceAndDest |
	ColorConvertingMaps class == Array 
		ifFalse: [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) isNil ifTrue: [
		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 5/21/2009 14:12'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor

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

	sourceForm depth = 1 ifTrue: [
		self combinationRule: Form paint.
		(colorMap isNil or: [ lastSourceDepth ~= sourceForm depth ]) ifTrue: [
			"Set up color map for a different source depth (color font)"
			"Uses caching for reasonable efficiency"
			colorMap _ self cachedFontColormapFrom: sourceForm depth to: destForm depth.
			colorMap at: 1 put: (destForm pixelValueFor: Color transparent)].
		colorMap at: 2 put: (destForm pixelValueFor: foregroundColor).
		^ self ].

	(foregroundColor = Color black and: [Preferences subPixelRenderFonts]) ifTrue: [
		destForm depth > 8 ifTrue: [
			self combinationRule: 37.		"RGBMul"
			colorMap _ sourceForm depth ~= destForm depth
				ifTrue: [self cachedFontColormapFrom: sourceForm depth to: destForm depth]]
		ifFalse: [
			self combinationRule: 25.		"Paint"
			colorMap _ self colorConvertingMap: nil from: sourceForm depth to: destForm depth keepSubPixelAA: true ].
		^self ].
	
	"Do not use rule 34 for 16bpp display. TTCFont uses it, but it builds a glyphs cache for each color used!!"
	self combinationRule: (destForm depth = 32 ifTrue: [34 "alphaBlendScaled"] ifFalse: [25 "Paint"]).
	colorMap _ self colorConvertingMap: foregroundColor from: sourceForm depth to: destForm depth keepSubPixelAA: false! !


!CodeHolder methodsFor: 'message list' stamp: 'jmv 5/20/2009 22:39'!
sourceStringPrettifiedAndDiffed
	"Answer a copy of the source code for the selected message, transformed by diffing and pretty-printing exigencies"

	| class selector sourceString |
	class _ self selectedClassOrMetaClass.
	selector _ self selectedMessageName.
	(class isNil or: [selector isNil]) ifTrue: [^ 'missing'].

	sourceString _ class ultimateSourceCodeAt: selector ifAbsent: [^ 'error'].
	self validateMessageSource: sourceString forSelector: selector.

	(#(prettyPrint colorPrint prettyDiffs) includes: contentsSymbol) ifTrue: [
		sourceString _ class compilerClass new
						format: sourceString 
						in: class 
						notifying: nil
						decorated: contentsSymbol = #colorPrint].
	self showingAnyKindOfDiffs ifTrue:
		[sourceString _ self diffFromPriorSourceFor: sourceString].

	^ sourceString! !


!ChangeSorter methodsFor: 'code pane' stamp: 'jmv 5/20/2009 22:42'!
setContents
	"return the source code that shows in the bottom pane"

	| sel class strm changeType |
	self clearUserEditFlag.
	currentClassName ifNil: [^ contents _ myChangeSet preambleString ifNil: ['']].
	class _ self selectedClassOrMetaClass.
	(sel _ currentSelector) == nil
		ifFalse: [changeType _ (myChangeSet atSelector: (sel _ sel asSymbol) class: class).
			changeType == #remove
				ifTrue: [^ contents _ 'Method has been removed (see versions)'].
			changeType == #addedThenRemoved
				ifTrue: [^ contents _ 'Added then removed (see versions)'].
			class ifNil: [^ contents _ 'Method was added, but cannot be found!!'].
			(class includesSelector: sel)
				ifFalse: [^ contents _ 'Method was added, but cannot be found!!'].
			contents _ class sourceCodeAt: sel.
			(#(prettyPrint colorPrint prettyDiffs) includes: contentsSymbol) ifTrue:
				[contents _ class compilerClass new
						format: contents 
						in: class 
						notifying: nil
						decorated: contentsSymbol = #colorPrint].
			self showingAnyKindOfDiffs
				ifTrue: [contents _ self diffFromPriorSourceFor: contents].
			^ contents _ contents asText makeSelectorBoldIn: class]
		ifTrue: [strm _ WriteStream on: (String new: 100).
			(myChangeSet classChangeAt: currentClassName) do:
				[:each |
				each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.'; cr].
				each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.'].
				each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.'; cr].
				each = #add ifTrue: [strm nextPutAll: 'Class definition was added.'; cr].
				each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.'; cr].
				each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.'; cr].
				each = #comment ifTrue: [strm nextPutAll: 'New class comment.'; cr.
				]].
			^ contents _ strm contents].! !


!Color class methodsFor: 'colormaps' stamp: 'jmv 5/21/2009 13:55'!
computeColorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix

	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 5/21/2009 14:20'!
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 notNil
			ifTrue: [
				(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 ]]]
			ifFalse: [ 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! !


!DisplayScanner methodsFor: 'private' stamp: 'jmv 5/21/2009 12:32'!
setFont 
	foregroundColor _ paragraphColor.
	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
	font installOn: bitBlt foregroundColor: foregroundColor.
	text ifNotNil:[destY _ lineY + line baseline - font ascent]! !


!FormCanvas methodsFor: 'drawing-text' stamp: 'jmv 5/21/2009 12:33'!
drawString: aString from: firstIndex to: lastIndex at: aPoint font: fontOrNil color: c
	| font |
	port colorMap: nil.
	font _ fontOrNil ifNil: [TextStyle defaultFont].
	font installOn: port foregroundColor: (self shadowColor ifNil:[c]).
	font displayString: aString on: port 
		from: firstIndex to: lastIndex at: (origin + aPoint) kern: font baseKern negated.! !

!FormCanvas methodsFor: 'drawing-text' stamp: 'jmv 5/21/2009 12:33'!
drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c
	| font portRect |
	port colorMap: nil.
	portRect _ port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	font _ fontOrNil ifNil: [TextStyle defaultFont].
	font installOn: port foregroundColor: (self shadowColor ifNil:[c]).
	font displayString: aString asString on: port 
		from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: font baseKern negated.
	port clipRect: portRect.! !


!GrafPort methodsFor: 'accessing' stamp: 'jmv 5/21/2009 09:15'!
secondPassRule: rule2 secondPassColorMap: colorMap2
	"If these variables are not nil, #displayString:from:to:at:strikeFont:kern: will do two passes.
	The first will be with parameters as provided. The second one will use these new variables.
	
	This is useful for composing complex BitBlt rules from simple ones"
	
	secondPassRule _ rule2.
	secondPassColorMap _ colorMap2! !

!GrafPort methodsFor: 'copying' stamp: 'jmv 5/21/2009 12:24'!
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 prevMap |
	answer _ super displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
	secondPassRule ifNotNil: [
		prevRule _ combinationRule.
		combinationRule _ secondPassRule.
		prevMap _ colorMap.
		colorMap _ secondPassColorMap.
		super displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: font kern: kernDelta.
		combinationRule _ prevRule.
		colorMap _ prevMap ].
	^answer! !

!GrafPort methodsFor: 'private' stamp: 'jmv 5/21/2009 09:23'!
fixRuleFor1bpp: aStrikeFont foregroundColor: foregroundColor
	aStrikeFont glyphs depth = 1 ifTrue: [
		alpha _ foregroundColor privateAlpha.
		"dynamically switch between blend modes to support text with a translucent foregroundColor"
		"To handle the transition from TTCFont to StrikeFont, rule 34 must be taken into account."
		alpha = 255 ifTrue:[
			combinationRule = 30 ifTrue: [combinationRule _ Form over].
			combinationRule = 31 ifTrue: [combinationRule _ Form paint].
			combinationRule = 34 ifTrue: [combinationRule _ Form paint].
		] ifFalse:[
			combinationRule = Form over ifTrue: [combinationRule _ 30].
			combinationRule = Form paint ifTrue: [combinationRule _ 31].
			combinationRule = 34 ifTrue: [combinationRule _ 31].
		]
	]! !

!GrafPort methodsFor: 'private' stamp: 'jmv 5/21/2009 14:25'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor

	"Redefined as we can do a second pass (see ivars secondPassRule and secondPassColorMap)"

	| lastSourceDepth targetColor |
	sourceForm notNil ifTrue: [ lastSourceDepth _ sourceForm depth ].
	sourceForm _ aStrikeFont glyphs.
	"Ignore any halftone pattern since we use a color map approach here"
	halftoneForm _ nil.
	sourceY _ 0.
	height _ aStrikeFont height.
	"Set later if needed"
	self secondPassRule: nil secondPassColorMap: nil.

	sourceForm depth = 1 ifTrue: [
		self combinationRule: Form paint.
		(colorMap isNil or: [ lastSourceDepth ~= sourceForm depth ]) ifTrue: [
			"Set up color map for a different source depth (color font)"
			"Uses caching for reasonable efficiency"
			colorMap _ self cachedFontColormapFrom: sourceForm depth to: destForm depth.
			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: [
			destForm depth > 8 ifTrue: [
				"rgbMul is equivalent to component alpha blend if text is black (only faster, hehe)"
				self combinationRule: 37.		"rgbMul"
				colorMap _ sourceForm depth ~= destForm depth
					ifTrue: [ self cachedFontColormapFrom: sourceForm depth to: destForm depth ].	
				foregroundColor = Color black  ifFalse: [
					"rgbMul / rgbAdd IS component alpha blend for any color of text (neat trick, eh!!)"
					self secondPassRule: 20 "rgbAdd" secondPassColorMap: 
						(self colorConvertingMap: foregroundColor from: sourceForm depth to: destForm depth keepSubPixelAA: true)]]
			ifFalse: [
				self combinationRule: 25.		"Paint"
				targetColor _ foregroundColor = Color black ifFalse: [ foregroundColor ].
				colorMap _ self colorConvertingMap: targetColor from: sourceForm depth to: destForm depth 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: (destForm depth = 32 ifTrue: [34 "alphaBlendScaled"] ifFalse: [25 "Paint"]).
			colorMap _ self colorConvertingMap: foregroundColor from: sourceForm depth to: destForm depth keepSubPixelAA: false]].
	
	self fixRuleFor1bpp: aStrikeFont foregroundColor: foregroundColor! !


!Preferences class methodsFor: 'standard queries' stamp: 'jmv 5/20/2009 22:31'!
colorWhenPrettyPrinting
	^ "self
		valueOfFlag: #colorWhenPrettyPrinting
		ifAbsent: [false]"true! !

!Preferences class methodsFor: 'standard queries' stamp: 'jmv 5/21/2009 14:29'!
subPixelRenderColorFonts
	^ self
		valueOfFlag: #subPixelRenderColorFonts
		ifAbsent: [true]! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 5/21/2009 13:35'!
juans

	self setPreferencesFrom:

	#(
		(alternativeWindowLook true)
		(annotationPanes true)
		(balloonHelpEnabled false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips true)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(honorDesktopCmdKeys false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(optionalButtons true)
		(personalizedWorldMenu false)
		(restartAlsoProceeds false)
		(scrollBarsNarrow true)
		(scrollBarsWithoutMenuButton false)
		(simpleMenus false)
		(smartUpdating true)
		(subPixelRenderFonts true)
		(thoroughSenders true)
	)! !


!StrikeFont methodsFor: 'displaying' stamp: 'jmv 5/21/2009 12:32'!
installOn: aDisplayContext foregroundColor: foregroundColor
	^aDisplayContext 
		installStrikeFont: self
		foregroundColor: foregroundColor! !

StrikeFont removeSelector: #installOn:foregroundColor:backgroundColor:!
GrafPort removeSelector: #installStrikeFont:foregroundColor:backgroundColor:!
!classDefinition: #GrafPort category: #'Morphic-OldSupport'!
BitBlt subclass: #GrafPort
	instanceVariableNames: 'alpha fillPattern secondPassRule secondPassColorMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldSupport'!
Color class removeSelector: #computeColorConvertingMap:from:to:!
Color class removeSelector: #computeRGBColorConvertingMap:to:!
BitBlt removeSelector: #installStrikeFont:foregroundColor:backgroundColor:!
AbstractFont removeSelector: #installOn:foregroundColor:backgroundColor:!
