Hans-Martin Mosner wrote:

> The attached changeset modifies selection in MVC such that the value
> with which the reverse is computed depends on the active view's
> background color, giving better contrast. In addition, the text
> insertion caret is always displayed in red to stand out better.

... and forgot to really test it. Did not work with symbolic insideColors.
This one fixes it.

Hans-Martin
-------------- next part --------------
'From Squeak2.7alpha of 11 October 1999 [latest update: #1716] on 7 January 2000 at 8:29:01 am'!
"Change Set:		ContrastMVC-hmm
Date:			7 January 2000
Author:			Hans-Martin Mosner

Enhances readability in MVC by making all selections bgColor-on-black, and making the text insertion caret red when possible."!


!Color class methodsFor: 'class initialization' stamp: 'hmm 1/5/2000 17:23'!
updateHighLightForBackground: bgColor
	| xor |
	xor _ self xorBetween: Color black and: bgColor.
	HighLightBitmaps at: Display depth put: (Bitmap with: xor)! !

!Color class methodsFor: 'class initialization' stamp: 'hmm 1/5/2000 13:13'!
updateHighLightForBackground: bgColor during: aBlock
	| old |
	old _ HighLightBitmaps at: Display depth.
	self updateHighLightForBackground: bgColor.
	aBlock value.
	HighLightBitmaps at: Display depth put: old! !

!Color class methodsFor: 'class initialization' stamp: 'hmm 1/5/2000 17:13'!
xorBetween: fgColor and: bgColor
	| fore back xor |
	fore _ fgColor pixelValueForDepth: Display depth.
	back _ bgColor pixelValueForDepth: Display depth.
	xor _ fore bitXor: back.
	32 / Display depth -1 timesRepeat: [
		xor _ (xor bitShift: Display depth) bitOr: xor].
	^xor! !


!FillInTheBlank class methodsFor: 'instance creation' stamp: 'hmm 1/5/2000 13:17'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint
	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
	"FillInTheBlank request: 'Type something, then type CR.'
		initialAnswer: 'yo ho ho!!'
		centerAt: Display center"

	| model fillInView savedArea |
	World ifNotNil:
		[^ FillInTheBlankMorph
			request: queryString
			initialAnswer: defaultAnswer
			centerAt: aPoint].

	model _ self new initialize.
	model contents: defaultAnswer.
	fillInView _
		FillInTheBlankView
			on: model
			message: queryString
			centerAt: aPoint.
	savedArea _ Form fromDisplay: fillInView displayBox.
	Color updateHighLightForBackground: Color white during: [
		fillInView display.
		defaultAnswer isEmpty
			ifFalse: [fillInView lastSubView controller selectFrom: 1 to: defaultAnswer size].
		(fillInView lastSubView containsPoint: Sensor cursorPoint)
			ifFalse: [fillInView lastSubView controller centerCursorInView].
		fillInView controller startUp.
		fillInView release.
		savedArea displayOn: Display at: fillInView viewport topLeft].
	^ model contents
! !


!Paragraph methodsFor: 'selecting' stamp: 'hmm 1/5/2000 17:23'!
caretFormForDepth: depth
	"Return a caret form for the given depth."
	"(Paragraph new caretFormForDepth: Display depth) displayOn: Display at: 0 at 0 rule: Form reverse"

	| box f bb map |
	box _ CaretForm boundingBox.
	f _ Form extent: box extent depth: depth.
	map _ (Color cachedColormapFrom: CaretForm depth to: depth) copy.
	map at: 1 put: (Color transparent pixelValueForDepth: depth).
	map at: 2 put: ((Color xorBetween: Color red and: Color black) bitXor: (Color quickHighLight: depth) first).  "pixel value for reversing"
	bb _ BitBlt toForm: f.
	bb
		sourceForm: CaretForm;
		sourceRect: box;
		destOrigin: 0 at 0;
		colorMap: map;
 		combinationRule: Form over;
		copyBits.
	^ f! !


!PopUpMenu methodsFor: 'displaying' stamp: 'hmm 1/5/2000 13:12'!
displayAt: aPoint withCaption: captionOrNil during: aBlock
	"Display the receiver just to the right of aPoint while aBlock is evaluated.  If the receiver is forced off screen, display it just to the right."
	| delta savedArea captionForm captionSave outerFrame captionText tFrame frameSaveLoc captionBox |
	marker ifNil: [self computeForm].
	frame _ frame align: marker leftCenter with: aPoint + (2 at 0).
	outerFrame _ frame.
	captionOrNil notNil ifTrue:
		[captionText _ (DisplayText
				text: captionOrNil asText
				textStyle: MenuStyle copy centered)
					foregroundColor: Color black
					backgroundColor: Color white.
		tFrame _ captionText boundingBox insetBy: -2.
		outerFrame _ frame merge: (tFrame align: tFrame bottomCenter
					with: frame topCenter + (0 at 2))].
	delta _ outerFrame amountToTranslateWithin: Display boundingBox.
	frame right > Display boundingBox right
		ifTrue: [delta _ 0 - frame width @ delta y].
	frame _ frame translateBy: delta.
	captionOrNil notNil ifTrue:
		[captionForm _ captionText form.
		captionBox _ captionForm boundingBox expandBy: 4.
		captionBox _ captionBox align: captionBox bottomCenter
								with: frame topCenter + (0 at 2).
		captionSave _ Form fromDisplay: captionBox.
		Display border: captionBox width: 4 fillColor: Color white.
		Display border: captionBox width: 2 fillColor: Color black.
		captionForm displayAt: captionBox topLeft + 4].
	marker _ marker align: marker leftCenter with: aPoint + delta +  (2 at 0).
	savedArea _ Form fromDisplay: frame.
	self menuForm displayOn: Display at: (frameSaveLoc _ frame topLeft).
	Color updateHighLightForBackground: Color white during: [
		selection ~= 0 ifTrue: [Display reverse: marker].
		Cursor normal showWhile: [aBlock value]].
	savedArea displayOn: Display at: frameSaveLoc.
	captionOrNil notNil ifTrue:
		[captionSave displayOn: Display at: captionBox topLeft]! !


!StandardSystemView methodsFor: 'displaying' stamp: 'hmm 1/7/2000 08:28'!
emphasizeLabel
	"Highlight the label."
	Color updateHighLightForBackground: self backgroundColor.
	labelFrame height = 0 ifTrue: [^ self].  "no label"
	self displayLabelBackground: true.
	self displayLabelBoxes.
	self displayLabelText.
! !