[squeak-dev] The Trunk: Graphics-nice.266.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Oct 11 21:21:57 UTC 2013


Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-nice.266.mcz

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

Name: Graphics-nice.266
Author: nice
Time: 11 October 2013, 11:20:55.611 pm
UUID: eac0f210-7121-4396-86bf-55ba4c4aa3dd
Ancestors: Graphics-nice.265

Make the DisplayScanner abstract - part 1:
Create a BitBltDisplayScanner, which is a copy of DisplayScanner.
Make DisplayScanner a factory which creates a BitBltDisplayScanner by default.
We'll later remove the BitBlt stuff from abstract DisplayScanner.

=============== Diff against Graphics-nice.265 ===============

Item was added:
+ CharacterScanner subclass: #BitBltDisplayScanner
+ 	instanceVariableNames: 'bitBlt lineY foregroundColor backgroundColor fillBlt paragraphColor morphicOffset ignoreColorChanges lastDisplayableIndex stopConditionsMustBeReset'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Graphics-Text'!
+ 
+ !BitBltDisplayScanner commentStamp: 'nice 10/9/2013 23:56' prior: 0!
+ A BitBltDisplayScanner displays characters on Screen or other Form with help of a BitBlt.
+ 
+ Instance Variables
+ 	backgroundColor:		<Color>
+ 	bitBlt:		<BitBlt>
+ 	fillBlt:		<BitBlt>
+ 	foregroundColor:		<Color>
+ 	ignoreColorChanges:		<Boolean>
+ 	lastDisplayableIndex:		<Integer>
+ 	lineY:		<Number>
+ 	morphicOffset:		<Point>
+ 	paragraphColor:		<Color>
+ 	stopConditionsMustBeReset:		<Boolean>
+ 
+ backgroundColor
+ 	- the background color for displaying text.
+ 	Note that this can be set to Color transparent, in which case no background is displayed.
+ 
+ bitBlt
+ 	- the object which knows how to copy bits from one Form (the font glyph data) to another (the destination Form)
+ 
+ fillBlt
+ 	- another object for copying form bits, initialized for displaying the background.
+ 
+ foregroundColor
+ 	- the foreground color for displaying text
+ 
+ ignoreColorChanges
+ 	- indicates that any change of color specified in text attributes shall be ignored.
+ 	This is used for displaying text in a shadow mode, when dragging text for example.
+ 
+ lastDisplayableIndex
+ 	- the index of last character to be displayed.
+ 	A different index than lastIndex is required in order to avoid display of control characters.
+ 	This variable must be updated by the stop condition at each inner scan loop.
+ 
+ lineY
+ 	- the distance between destination form top and current line top
+ 
+ morphicOffset
+ 	- an offset for positionning the embedded morphs.
+ 	THE EXACT SPECIFICATION YET REMAINS TO BE WRITTEN
+ 
+ paragraphColor
+ 	- the default foreground color for displaying text in absence of other text attributes specification 
+ 
+ stopConditionsMustBeReset
+ 	- indicates that it's necessary to call setStopConditions in next scan loop.
+ 
+ Notes:
+ In order to correctly set the lastDisplayableIndex, the display scanner performs the stopCondition BEFORE displaying the string being scanned.
+ This explains why the stopCondition must not reset the font immediately, but differ this reset AFTER the display, thanks to stopConditionsMustBeReset.
+ !

Item was added:
+ ----- Method: BitBltDisplayScanner class>>defaultFont (in category 'queries') -----
+ defaultFont
+ 	^ TextStyle defaultFont!

Item was added:
+ ----- Method: BitBltDisplayScanner>>cr (in category 'stop conditions') -----
+ cr
+ 	"When a carriage return is encountered, simply increment the pointer 
+ 	into the paragraph."
+ 
+ 	pendingKernX := 0.
+ 	lastDisplayableIndex := lastIndex - 1.
+ 	(lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]])
+ 		ifTrue: [lastIndex := lastIndex + 2]
+ 		ifFalse: [lastIndex := lastIndex + 1].
+ 	^false!

Item was added:
+ ----- Method: BitBltDisplayScanner>>crossedX (in category 'stop conditions') -----
+ crossedX
+ 	"This condition will sometimes be reached 'legally' during display, when, 
+ 	for instance the space that caused the line to wrap actually extends over 
+ 	the right boundary. This character is allowed to display, even though it 
+ 	is technically outside or straddling the clipping rectangle since it is in 
+ 	the normal case not visible and is in any case appropriately clipped by 
+ 	the scanner."
+ 
+ 	self advanceIfFirstCharOfLine.
+ 	lastDisplayableIndex := lastIndex - 1.
+ 	^ true !

Item was added:
+ ----- Method: BitBltDisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') -----
+ displayLine: textLine offset: offset leftInRun: leftInRun
+ 	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
+ 	| stopCondition nowLeftInRun startIndex string lastPos lineHeight stop |
+ 	line := textLine.
+ 	morphicOffset := offset.
+ 	lineY := line top + offset y.
+ 	lineHeight := line lineHeight.
+ 	rightMargin := line rightMargin + offset x.
+ 	lastIndex := line first.
+ 	leftInRun <= 0 ifTrue: [self setStopConditions].
+ 	leftMargin := (line leftMarginForAlignment: alignment) + offset x.
+ 	destX := leftMargin.
+ 	fillBlt == nil ifFalse:
+ 		["Not right"
+ 		fillBlt destX: line left destY: lineY
+ 			width: line width left height: lineHeight; copyBits].
+ 	lastDisplayableIndex := lastIndex := line first.
+ 	leftInRun <= 0
+ 		ifTrue: [nowLeftInRun := text runLengthFor: lastIndex]
+ 		ifFalse: [nowLeftInRun := leftInRun].
+ 	destY := lineY + line baseline - font ascent.
+ 	runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last.
+ 	spaceCount := 0.
+ 	string := text string.
+ 	[
+ 		"remember where this portion of the line starts"
+ 		startIndex := lastIndex.
+ 		lastPos := destX at destY.
+ 		
+ 		"reset the stopping conditions of this displaying loop, and also the font."
+ 		stopConditionsMustBeReset
+ 			ifTrue:[self setStopConditions].
+ 		
+ 		"find the end of this portion of the line"
+ 		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
+ 						in: string rightX: rightMargin stopConditions: stopConditions
+ 						kern: kern.
+ 		"handle the stop condition - this will also set lastDisplayableIndex"
+ 		stop := self perform: stopCondition.
+ 		
+ 		"display that portion of the line"
+ 		lastDisplayableIndex >= startIndex ifTrue:[
+ 			font displayString: string on: bitBlt 
+ 				from: startIndex 
+ 				to: lastDisplayableIndex 
+ 				at: lastPos kern: kern].
+ 		
+ 		"if the stop condition were true, stop the loop"
+ 		stop
+ 	] whileFalse.
+ 	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"!

Item was added:
+ ----- Method: BitBltDisplayScanner>>endOfRun (in category 'stop conditions') -----
+ endOfRun
+ 	"The end of a run in the display case either means that there is actually 
+ 	a change in the style (run code) to be associated with the string or the 
+ 	end of this line has been reached."
+ 	| runLength |
+ 	lastDisplayableIndex := lastIndex.
+ 	lastIndex = line last ifTrue: [^true].
+ 	runLength := text runLengthFor: (lastIndex := lastIndex + 1).
+ 	runStopIndex := lastIndex + (runLength - 1) min: line last.
+ 	"differ reset of stopConditions and font AFTER the dispaly of last scanned string"
+ 	stopConditionsMustBeReset := true.
+ 	^ false!

Item was added:
+ ----- Method: BitBltDisplayScanner>>paddedSpace (in category 'stop conditions') -----
+ paddedSpace
+ 	"Each space is a stop condition when the alignment is right justified. 
+ 	Padding must be added to the base width of the space according to 
+ 	which space in the line this space is and according to the amount of 
+ 	space that remained at the end of the line when it was composed."
+ 
+ 	lastDisplayableIndex := lastIndex - 1.
+ 	spaceCount := spaceCount + 1.
+ 	destX := destX + spaceWidth + kern + (line justifiedPadFor: spaceCount font: font).
+ 	lastIndex := lastIndex + 1.
+ 	pendingKernX := 0.
+ 	^ false!

Item was added:
+ ----- Method: BitBltDisplayScanner>>placeEmbeddedObject: (in category 'private') -----
+ placeEmbeddedObject: anchoredMorph
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[
+ 		anchoredMorph position: 
+ 			anchoredMorph relativeTextAnchorPosition +
+ 			(anchoredMorph owner textBounds origin x @ 0)
+ 			- (0 at morphicOffset y) + (0 at lineY).
+ 		^true
+ 	].
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
+ 	(anchoredMorph isMorph or: [anchoredMorph isPrimitiveCostume]) ifTrue: [
+ 		anchoredMorph position: (destX at lineY) - morphicOffset
+ 	] ifFalse: [
+ 		destY := lineY.
+ 		anchoredMorph 
+ 			displayOn: bitBlt destForm 
+ 			at: destX @ destY
+ 			clippingBox: bitBlt clipRect
+ 	].
+ 	destX := destX + anchoredMorph width + kern.
+ 	^ true!

Item was added:
+ ----- Method: BitBltDisplayScanner>>plainTab (in category 'stop conditions') -----
+ plainTab
+ 	| oldX |
+ 	oldX := destX.
+ 	super plainTab.
+ 	fillBlt == nil ifFalse:
+ 		[fillBlt destX: oldX destY: destY width: destX - oldX height: font height; copyBits]!

Item was added:
+ ----- Method: BitBltDisplayScanner>>setDestForm: (in category 'private') -----
+ setDestForm: df
+ 	bitBlt setDestForm: df.!

Item was added:
+ ----- Method: BitBltDisplayScanner>>setFont (in category 'private') -----
+ setFont 
+ 	foregroundColor := paragraphColor.
+ 	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
+ 	font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent.
+ 	text ifNotNil:[destY := lineY + line baseline - font ascent]!

Item was added:
+ ----- Method: BitBltDisplayScanner>>setPort: (in category 'private') -----
+ setPort: aBitBlt
+ 	"Install the BitBlt to use"
+ 	bitBlt := aBitBlt.
+ 	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
+ 	bitBlt sourceForm: nil. "Make sure font installation won't be confused"
+ !

Item was added:
+ ----- Method: BitBltDisplayScanner>>setStopConditions (in category 'private') -----
+ setStopConditions
+ 	super setStopConditions.
+ 	stopConditionsMustBeReset := false!

Item was added:
+ ----- Method: BitBltDisplayScanner>>tab (in category 'stop conditions') -----
+ tab
+ 	lastDisplayableIndex := lastIndex - 1.
+ 	self plainTab.
+ 	lastIndex := lastIndex + 1.
+ 	^ false!

Item was added:
+ ----- Method: BitBltDisplayScanner>>text:textStyle:foreground:background:fillBlt:ignoreColorChanges: (in category 'private') -----
+ text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
+ 	text := t.
+ 	textStyle := ts. 
+ 	foregroundColor := paragraphColor := foreColor.
+ 	(backgroundColor := backColor) isTransparent ifFalse:
+ 		[fillBlt := blt.
+ 		fillBlt fillColor: backgroundColor].
+ 	ignoreColorChanges := shadowMode!

Item was added:
+ ----- Method: BitBltDisplayScanner>>textColor: (in category 'text attributes') -----
+ textColor: textColor
+ 	ignoreColorChanges ifTrue: [^ self].
+ 	foregroundColor := textColor!

Item was added:
+ ----- Method: DisplayScanner class>>new (in category 'instance creation') -----
+ new
+ 	"Use default concrete class"
+ 	^BitBltDisplayScanner new!



More information about the Squeak-dev mailing list