[Pkg] The Trunk: Graphics-ul.370.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 13 14:44:14 UTC 2017


Levente Uzonyi uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-ul.370.mcz

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

Name: Graphics-ul.370
Author: ul
Time: 13 March 2017, 5:06:02.486181 am
UUID: c1fb77f6-d2f7-4bd2-b669-762585e12bb8
Ancestors: Graphics-ul.369

SortedCollection Whack-a-mole

=============== Diff against Graphics-ul.369 ===============

Item was changed:
  ----- Method: BDFFontReader>>read (in category 'reading') -----
  read
  	| xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx array width blt lastAscii pointSize ret stream |
  	form := encoding := bbx := nil.
  	self readAttributes.
  	height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2).
  	ascent := Integer readFromString: (properties at: #'FONT_ASCENT') first.
  	descent := Integer readFromString: (properties at: #'FONT_DESCENT') first.
  	pointSize := (Integer readFromString: (properties at: #'POINT_SIZE') first) // 10.
  	
  	maxWidth := 0.
  	minAscii := 9999.
  	strikeWidth := 0.
  	maxAscii := 0.
  
  	charsNum := Integer readFromString: (properties at: #CHARS) first.
  	chars := Set new: charsNum.
  
  	1 to: charsNum do: [:i |
  		array := self readOneCharacter.
  		stream := ReadStream on: array.
  		form := stream next.
  		encoding := stream next.
  		bbx := stream next.
  		form ifNotNil: [
  			width := bbx at: 1.
  			maxWidth := maxWidth max: width.
  			minAscii := minAscii min: encoding.
  			maxAscii := maxAscii max: encoding.
  			strikeWidth := strikeWidth + width.
  			chars add: array.
  		].
  	].
  
+ 	chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)].
- 	chars := chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)].
  	charsNum := chars size. "undefined encodings make this different"
  
  	charsNum > 256 ifTrue: [
  		"it should be 94x94 charset, and should be fixed width font"
  		strikeWidth := 94*94*maxWidth.
  		maxAscii := 94*94.
  		minAscii := 0.
  		xTable := XTableForFixedFont new.
  		xTable maxAscii: 94*94.
  		xTable width: maxWidth.
  	] ifFalse: [
  		xTable := (Array new: 258) atAllPut: 0.
  	].
  
  	glyphs := Form extent: strikeWidth at height.
  	blt := BitBlt toForm: glyphs.
  	lastAscii := 0.
  	
  	charsNum > 256 ifTrue: [
  		1 to: charsNum do: [:i |
  			stream := ReadStream on: (chars at: i).
  			form := stream next.
  			encoding := stream next.
  			bbx := stream next.
  			encoding := ((encoding // 256) - 33) * 94 + ((encoding \\ 256) - 33).
  			blt copy: ((encoding * maxWidth)@0 extent: maxWidth at height)
  				from: 0 at 0 in: form.
  		].
  	] ifFalse: [
  		1 to: charsNum do: [:i |
  			stream := ReadStream on: (chars at: i).
  			form := stream next.
  			encoding := stream next.
  			bbx := stream next.
  			lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)].
  			blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4)))
  					extent: (bbx at: 1)@(bbx at: 2))
  				from: 0 at 0 in: form.
  			xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1).
  			lastAscii := encoding.
  		]
  	].
  
  	ret := Array new: 8.
  	ret at: 1 put: xTable.
  	ret at: 2 put: glyphs.
  	ret at: 3 put: minAscii.
  	ret at: 4 put: maxAscii.
  	ret at: 5 put: maxWidth.
  	ret at: 6 put: ascent.
  	ret at: 7 put: descent.
  	ret at: 8 put: pointSize.
  	^ret.
  " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}"
  !

Item was changed:
  ----- Method: BDFFontReader>>readChars (in category 'reading') -----
  readChars
  	| strikeWidth ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx array width pointSize stream |
  	form := encoding := bbx := nil.
  	self readAttributes.
  	height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2).
  	ascent := Integer readFromString: (properties at: #'FONT_ASCENT') first.
  	descent := Integer readFromString: (properties at: #'FONT_DESCENT') first.
  	pointSize := (Integer readFromString: (properties at: #'POINT_SIZE') first) // 10.
  	
  	maxWidth := 0.
  	minAscii := 9999.
  	strikeWidth := 0.
  	maxAscii := 0.
  
  	charsNum := Integer readFromString: (properties at: #CHARS) first.
  	chars := Set new: charsNum.
  
  	1 to: charsNum do: [:i |
  		array := self readOneCharacter.
  		stream := ReadStream on: array.
  		form := stream next.
  		encoding := stream next.
  		bbx := stream next.
  		form ifNotNil: [
  			width := bbx at: 1.
  			maxWidth := maxWidth max: width.
  			minAscii := minAscii min: encoding.
  			maxAscii := maxAscii max: encoding.
  			strikeWidth := strikeWidth + width.
  			chars add: array.
  		].
  	].
  
+ 	^chars sorted: [:x :y | (x at: 2) <= (y at: 2)]!
- 	chars := chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)].
- 
- 	^ chars.
- !

Item was changed:
  ----- Method: FontSet class>>installAsTextStyle (in category 'installing') -----
  installAsTextStyle  "FontSetNewYork installAsTextStyle"
  	| selectors |
  	(TextConstants includesKey: self fontName) ifTrue:
  		[(self confirm: 
  self fontName , ' is already defined in TextConstants.
  Do you want to replace that definition?')
  			ifFalse: [^ self]].
+ 	selectors := (self class selectors select: [:s | s beginsWith: 'size']) sort
+ 		 replace: [:each | self perform: each].
- 	selectors := (self class selectors select: [:s | s beginsWith: 'size']) asSortedCollection.
  	TextConstants
  		at: self fontName
+ 		put: (TextStyle fontArray: selectors)!
- 		put: (TextStyle fontArray: (selectors collect: [:each | self perform: each]))!

Item was changed:
  ----- Method: HostFont class>>fontNameFromUser (in category 'accessing') -----
  fontNameFromUser
  	"HostFont fontNameFromUser"
  	| fontNames index labels |
+ 	fontNames := self listFontNames sort.
- 	fontNames := self listFontNames asSortedCollection.
  	labels := WriteStream on: (String new: 100).
  	fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr].
  	index := (UIManager default chooseFrom: (labels contents substrings) title: 'Choose your font').
  	index = 0 ifTrue:[^nil].
  	^fontNames at: index!

Item was changed:
  ----- Method: StrikeFont class>>hostFontFromUser (in category 'font creation') -----
  hostFontFromUser
  	"StrikeFont hostFontFromUser"
  	| fontNames index labels |
+ 	fontNames := self listFontNames sort.
- 	fontNames := self listFontNames asSortedCollection.
  	labels := WriteStream on: (String new: 100).
  	fontNames do:[:fn| labels nextPutAll: fn] separatedBy:[labels cr].
  	index := (UIManager default chooseFrom: (labels contents substrings) 
  				title: 'Choose your font').
  	index = 0 ifTrue:[^nil].
  	^fontNames at: index!

Item was changed:
  ----- Method: TextStyle class>>changeDefaultFontSizeBy: (in category 'instance creation') -----
  changeDefaultFontSizeBy: delta      "TextStyle changeDefaultFontSizeBy: 1"
  	"This sample method recreates the default textStyle, with font 1 being a size
  	larger than the smallest.  It then initializes most references in the system
  	as well, although most windows will have to beclosed and reopened to get the effect."
  	| allFonts |
+ 	allFonts := TextStyle default fontArray sorted: [:a :b | a height < b height].
- 	allFonts := TextStyle default fontArray asSortedCollection: [:a :b | a height < b height].
  	TextConstants at: #DefaultTextStyle put:
  		(TextStyle fontArray: ((1 to: allFonts size) collect: [:i | allFonts atWrap: i+delta])).
  	#(ListParagraph PopUpMenu StandardSystemView) do:[:className|
  		Smalltalk at: className ifPresent:[:aClass| aClass initialize].
  	].!



More information about the Packages mailing list