'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 20 October 2008 at 1:35:42 pm'!
!classDefinition: #BitBlt category: #'Graphics-Primitives'!
Object subclass: #BitBlt
	instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight colorMap '
	classVariableNames: 'CachedFontColorMaps ColorConvertingMaps '
	poolDictionaries: ''
	category: 'Graphics-Primitives'!
!classDefinition: #Color category: #'Graphics-Primitives'!
Object subclass: #Color
	instanceVariableNames: 'rgb cachedDepth cachedBitPattern '
	classVariableNames: 'Black Blue BlueShift Brown CachedColormaps CachedColormapsForAAText ColorChart ColorNames ComponentMask ComponentMax Cyan DarkGray Gray GrayToIndexMap Green GreenShift HalfComponentMask HighLightBitmaps IndexedColors LightBlue LightBrown LightCyan LightGray LightGreen LightMagenta LightOrange LightRed LightYellow Magenta MaskingMap Orange PaleBlue PaleBuff PaleGreen PaleMagenta PaleOrange PalePeach PaleRed PaleTan PaleYellow PureBlue PureCyan PureGreen PureMagenta PureRed PureYellow RandomStream Red RedShift TranslucentPatterns Transparent VeryDarkGray VeryLightGray VeryPaleRed VeryVeryDarkGray VeryVeryLightGray White Yellow '
	poolDictionaries: ''
	category: 'Graphics-Primitives'!

!BitBlt methodsFor: 'private' stamp: 'jmv 10/20/2008 13:34'!
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 ].

	^ map
! !

!BitBlt methodsFor: 'private' stamp: 'jmv 10/20/2008 12:58'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	| 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: backgroundColor)].
		colorMap at: 2 put: (destForm pixelValueFor: foregroundColor).
		^ self ].

	(foregroundColor = Color black and: [Preferences subPixelRenderFonts]) ifTrue: [
		destForm depth > 8 ifTrue: [
			self combinationRule: 28.		"RGBMin"
			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].
		^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] ifFalse: [25]).
	colorMap _ self colorConvertingMap: foregroundColor from: sourceForm depth to: destForm depth! !


!Color class methodsFor: 'colormaps' stamp: 'jmv 10/20/2008 11:30'!
computeColorConvertingMap: targetColor from: sourceDepth to: destDepth

	sourceDepth < 16 ifTrue: [
		"source is 1-, 2-, 4-, or 8-bit indexed color"
		^ self computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
	] ifFalse: [
		"source is 16-bit or 32-bit RGB"
		^ self computeRGBColorConvertingMap: targetColor to: destDepth
	]! !

!Color class methodsFor: 'colormaps' stamp: 'jmv 10/20/2008 13:04'!
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 notNil
			ifTrue: [
				destDepth = 32
					ifTrue: [ targetColor * f alpha: f]
					ifFalse: [ targetColor alphaMixed: f*1.5 with: Color white ]]
			ifFalse: [ 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 10/20/2008 13:08'!
computeRGBColorConvertingMap: targetColor to: destDepth
	| 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: [
				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! !

!Color class methodsFor: 'other' stamp: 'jmv 10/20/2008 13:26'!
shutDown
	"Color shutDown"

	ColorChart _ nil.		"Palette of colors for the user to pick from"
	CachedColormaps _ nil.	"Maps to translate between color depths"
	MaskingMap _ nil.		"Maps all colors except transparent to black for creating a mask"! !


!GrafPort methodsFor: 'private' stamp: 'jmv 10/18/2008 15:48'!
installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	super installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor.
	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].
		]
	]! !


!OldLazyListMorph methodsFor: 'drawing' stamp: 'jmv 10/20/2008 13:24'!
drawSelectionOn: aCanvas
	| selectionDrawBounds |
	selectedRow ifNil: [ ^self ].
	selectedRow = 0 ifTrue: [ ^self ].
	selectionDrawBounds := self drawBoundsForRow: selectedRow.
	selectionDrawBounds := selectionDrawBounds intersect: self bounds.
	aCanvas fillRectangle: selectionDrawBounds color: (
		Display depth = 1 
			ifTrue: [Color lightGray] 
			ifFalse: [
				Display depth = 2 
					ifTrue: [Color black] 
					ifFalse: [Color lightGray alpha: 0.45]])! !


!OldMenuItemMorph methodsFor: 'drawing' stamp: 'jmv 10/20/2008 13:17'!
drawOn: aCanvas 
	| stringColor stringBounds leftEdge |
	isSelected & isEnabled
		ifTrue: [
			aCanvas fillRectangle: self bounds color: (
				Display depth < 8
					ifTrue: [ Color veryLightGray ]
					ifFalse: [ Color lightBlue ])].
	stringColor := color.

	leftEdge := 0.
	self hasIcon
		ifTrue: [| iconForm | 
			iconForm := isEnabled ifTrue:[self icon] ifFalse:[self icon asGrayScale].
			aCanvas paintImage: iconForm at: self left @ (self top + (self height - iconForm height // 2)).
			leftEdge := iconForm width + 2].

	self hasMarker
		ifTrue: [ leftEdge := leftEdge + self submorphBounds width + 8 ].

	stringBounds := bounds left: bounds left + leftEdge.

	aCanvas
		drawString: contents
		in: stringBounds
		font: self fontToUse
		color: stringColor.
	subMenu
		ifNotNil: [aCanvas paintImage: SubMenuMarker at: self right - 8 @ (self top + self bottom - SubMenuMarker height // 2)]! !


!OldNewParagraph methodsFor: 'display' stamp: 'jmv 10/20/2008 13:11'!
selectionColor
	| color |
	Display depth = 1 ifTrue: [^ Color veryLightGray].
	Display depth = 2 ifTrue: [^ Color gray: 0.87].
	color := Preferences textHighlightColor.
	self focused ifFalse: [color := color alphaMixed: 0.2 with: Color veryVeryLightGray].
	^ color! !


!StrikeFont methodsFor: 'building' stamp: 'jmv 10/18/2008 23:50'!
setGlyphsDepthAtMost: aNumber
	glyphs depth > aNumber ifTrue: [
		glyphs _ glyphs asFormOfDepth: aNumber ]! !


!StrikeFont class methodsFor: 'removing' stamp: 'jmv 10/18/2008 23:47'!
removeMostFonts
"
StrikeFont removeMostFonts
"
	| style keep vera10 vera16 vera vera8 vera12 vera18 |
	style _ TextConstants at: #Vera.
	vera8 _ style fontNamed: 'Vera 8'.
	vera8 derivativeFont: nil at: 0.
	vera10 _ style fontNamed: 'Vera 10'.
	vera10 derivativeFont: nil at: 0.
	vera12 _ style fontNamed: 'Vera 12'.
	vera12 derivativeFont: nil at: 0.
	vera16 _ style fontNamed: 'Vera 16'.
	vera16 derivativeFont: nil at: 0.
	vera18 _ style fontNamed: 'Vera 18'.
	vera18 derivativeFont: nil at: 0.
	keep _ {vera8. vera10. vera12. vera16. vera18}.
	vera _ TextStyle fontArray: keep.
	TextConstants at: #DefaultFixedTextStyle put: vera.
	self actualFamilyNames do: [ :n |
		TextConstants removeKey: n ].
	TextConstants at: #Vera put: vera.
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'Vera' 10)
		(setListFontTo: 'Vera' 8)
		(setMenuFontTo: 'Vera' 10)
		(setWindowTitleFontTo: 'Vera' 12)
		(setBalloonHelpFontTo: 'Vera' 10)
		(setCodeFontTo: 'Vera' 8)
		(setButtonFontTo: 'Vera' 10)).! !

Color class removeSelector: #cachedColormapForAATextColor:depth:!
Color class removeSelector: #clearAAColormaps!
Color class removeSelector: #computeColormapForAATextColor:depth:!
!classDefinition: #Color category: #'Graphics-Primitives'!
Object subclass: #Color
	instanceVariableNames: 'rgb cachedDepth cachedBitPattern'
	classVariableNames: 'Black Blue BlueShift Brown CachedColormaps ColorChart ColorNames ComponentMask ComponentMax Cyan DarkGray Gray GrayToIndexMap Green GreenShift HalfComponentMask HighLightBitmaps IndexedColors LightBlue LightBrown LightCyan LightGray LightGreen LightMagenta LightOrange LightRed LightYellow Magenta MaskingMap Orange PaleBlue PaleBuff PaleGreen PaleMagenta PaleOrange PalePeach PaleRed PaleTan PaleYellow PureBlue PureCyan PureGreen PureMagenta PureRed PureYellow RandomStream Red RedShift TranslucentPatterns Transparent VeryDarkGray VeryLightGray VeryPaleRed VeryVeryDarkGray VeryVeryLightGray White Yellow'
	poolDictionaries: ''
	category: 'Graphics-Primitives'!
!classDefinition: #BitBlt category: #'Graphics-Primitives'!
Object subclass: #BitBlt
	instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight colorMap'
	classVariableNames: 'CachedFontColorMaps ColorConvertingMaps'
	poolDictionaries: ''
	category: 'Graphics-Primitives'!
