The Trunk: Graphics-nice.374.mcz

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

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

Name: Graphics-nice.374
Author: nice
Time: 26 April 2017, 11:03:04.6544 pm
UUID: 7b1aeafa-4b31-4143-9add-cba95d9617f1
Ancestors: Graphics-ul.373

Classify a few 'as yet unclassified' methods

=============== Diff against Graphics-ul.373 ===============

Item was changed:
+ ----- Method: Color>>alpha (in category 'accessing') -----
- ----- Method: Color>>alpha (in category 'access') -----
  alpha
  "Return the opacity ('alpha') value of opaque so that normal colors can be compared to TransparentColors."
 
  ^ 1.0
  !

Item was changed:
+ ----- Method: Color>>blue (in category 'accessing') -----
- ----- Method: Color>>blue (in category 'access') -----
  blue
  "Return the blue component of this color, a float in the range [0.0..1.0]."
 
  ^ self privateBlue asFloat / ComponentMax!

Item was changed:
+ ----- Method: Color>>brightness (in category 'accessing') -----
- ----- Method: Color>>brightness (in category 'access') -----
  brightness
  "Return the brightness of this color, a float in the range [0.0..1.0]."
 
  ^ ((self privateRed max:
     self privateGreen) max:
     self privateBlue) asFloat / ComponentMax!

Item was changed:
+ ----- Method: Color>>green (in category 'accessing') -----
- ----- Method: Color>>green (in category 'access') -----
  green
  "Return the green component of this color, a float in the range [0.0..1.0]."
 
  ^ self privateGreen asFloat / ComponentMax!

Item was changed:
+ ----- Method: Color>>hue (in category 'accessing') -----
- ----- Method: Color>>hue (in category 'access') -----
  hue
  "Return the hue of this color, an angle in the range [0.0..360.0]."
 
  | r g b max min span h |
  r := self privateRed.
  g := self privateGreen.
  b := self privateBlue.
 
  max := ((r max: g) max: b).
  min := ((r min: g) min: b).
  span := (max - min) asFloat.
  span = 0.0 ifTrue: [ ^ 0.0 ].
 
  r = max ifTrue: [
  h := ((g - b) asFloat / span) * 60.0.
  ] ifFalse: [
  g = max
  ifTrue: [ h := 120.0 + (((b - r) asFloat / span) * 60.0). ]
  ifFalse: [ h := 240.0 + (((r - g) asFloat / span) * 60.0). ].
  ].
 
  h < 0.0 ifTrue: [ h := 360.0 + h ].
  ^ h!

Item was changed:
+ ----- Method: Color>>luminance (in category 'accessing') -----
- ----- Method: Color>>luminance (in category 'access') -----
  luminance
  "Return the luminance of this color, a brightness value weighted by the human eye's color sensitivity."
 
  ^ ((299 * self privateRed) +
    (587 * self privateGreen) +
    (114 * self privateBlue)) / (1000 * ComponentMax)
  !

Item was changed:
+ ----- Method: Color>>red (in category 'accessing') -----
- ----- Method: Color>>red (in category 'access') -----
  red
  "Return the red component of this color, a float in the range [0.0..1.0]."
 
  ^ self privateRed asFloat / ComponentMax!

Item was changed:
+ ----- Method: Color>>saturation (in category 'accessing') -----
- ----- Method: Color>>saturation (in category 'access') -----
  saturation
  "Return the saturation of this color, a value between 0.0 and 1.0."
 
  | r g b max min |
  r := self privateRed.
  g := self privateGreen.
  b := self privateBlue.
 
  max := min := r.
  g > max ifTrue: [max := g].
  b > max ifTrue: [max := b].
  g < min ifTrue: [min := g].
  b < min ifTrue: [min := b].
 
  max = 0
  ifTrue: [ ^ 0.0 ]
  ifFalse: [ ^ (max - min) asFloat / max asFloat ].
  !

Item was changed:
+ ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'displaying') -----
- ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'as yet unclassified') -----
  displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta
  "Draw the given string from startIndex to stopIndex "
 
  combinationRule ifNotNil: [:r | aBitBlt combinationRule: r].
  tintable == false ifTrue: [aBitBlt colorMap: nil].
 
  ^ super displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta!

Item was changed:
+ ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'initialize-release') -----
- ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'as yet unclassified') -----
  fromFormArray: formArray asciiStart: asciiStart ascent: ascentVal
  | height width x badChar |
  type := 2.
  name := 'aFormFont'.
  minAscii := asciiStart.
  maxAscii := minAscii + formArray size - 1.
  ascent := ascentVal.
  subscript := superscript := emphasis := 0.
  height := width := 0.
  maxWidth := 0.
  formArray do:
  [:f | width := width + f width.
  maxWidth := maxWidth max: f width.
  height := height max: f height + f offset y].
  badChar := (Form extent: 7@height) borderWidth: 1.
  width := width + badChar width.
  descent := height - ascent.
  pointSize := height.
  glyphs := Form extent: width @ height depth: formArray first depth.
  xTable := Array new: maxAscii + 3 withAll: 0.
  x := 0.
  formArray doWithIndex:
  [:f :i | f displayOn: glyphs at: x@0.
  xTable at: minAscii + i+1 put: (x := x + f width)].
  badChar displayOn: glyphs at: x@0.
  xTable at: maxAscii + 3 put: x + badChar width.
  characterToGlyphMap := nil.!

Item was changed:
+ ----- Method: FormSetFont>>initialize (in category 'initialize-release') -----
- ----- Method: FormSetFont>>initialize (in category 'as yet unclassified') -----
  initialize
 
  super initialize.
  self preserveColors.!

Item was changed:
+ ----- Method: FormSetFont>>reset (in category 'emphasis') -----
- ----- Method: FormSetFont>>reset (in category 'as yet unclassified') -----
  reset  "Ignored by FormSetFonts"!

Item was changed:
+ ----- Method: IdentityGlyphMap>>at: (in category 'accessing') -----
- ----- Method: IdentityGlyphMap>>at: (in category 'as yet unclassified') -----
  at: index
 
  ^ index - 1.
  !

Item was changed:
+ ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'Morphic menu') -----
- ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'as yet unclassified') -----
  addFillStyleMenuItems: aMenu hand: aHand from: aMorph
  "Add the items for changing the current fill style of the receiver"
 
  "prevents a walkback when control menu is built for morph with me as color"!

Item was changed:
+ ----- Method: StaticForm>>isStatic (in category 'testing') -----
- ----- Method: StaticForm>>isStatic (in category 'as yet unclassified') -----
  isStatic
 
  ^true!

Item was changed:
+ ----- Method: TextComposer>>addNullLineForIndex: (in category 'private') -----
- ----- Method: TextComposer>>addNullLineForIndex: (in category 'as yet unclassified') -----
  addNullLineForIndex: index
  "This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."
 
  | oldLastLine r |
 
  oldLastLine := lines last.
  oldLastLine last - oldLastLine first >= 0 ifFalse: [^self].
  oldLastLine last = (index - 1) ifFalse: [^self].
 
  r := oldLastLine left @ oldLastLine bottom
  extent: 0@(oldLastLine bottom - oldLastLine top).
  "Even though we may be below the bottom of the container,
  it is still necessary to compose the last line for consistency..."
 
  self addNullLineWithIndex: index andRectangle: r.
  !

Item was changed:
+ ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'private') -----
- ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'as yet unclassified') -----
  addNullLineWithIndex: index andRectangle: r
 
  lines addLast: (
  (
  TextLine
  start: index
  stop: index - 1
  internalSpaces: 0
  paddingWidth: 0
  )
  rectangle: r;
  lineHeight: defaultLineHeight baseline: theTextStyle baseline
  )
  !

Item was changed:
+ ----- Method: TextComposer>>checkIfReadyToSlide (in category 'private') -----
- ----- Method: TextComposer>>checkIfReadyToSlide (in category 'as yet unclassified') -----
  checkIfReadyToSlide
 
  "Check whether we are now in sync with previously composed lines"
 
  (possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self].
 
  [prevIndex < prevLines size
  and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]]
  whileTrue: [prevIndex := prevIndex + 1].
 
  (prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [
  "Yes -- next line will have same start as prior line."
  prevIndex := prevIndex - 1.
  possibleSlide := false.
  nowSliding := true
  ] ifFalse: [
  prevIndex = prevLines size ifTrue: [
  "Weve reached the end of prevLines, so no use to keep looking for lines to slide."
  possibleSlide := false
  ]
  ]!

Item was changed:
+ ----- Method: TextComposer>>composeAllLines (in category 'private') -----
- ----- Method: TextComposer>>composeAllLines (in category 'as yet unclassified') -----
  composeAllLines
 
  [currCharIndex <= theText size and:
  [(currentY + defaultLineHeight) <= theContainer bottom]] whileTrue: [
 
  nowSliding ifTrue: [
  self slideOneLineDown ifNil: [^nil].
  ] ifFalse: [
  self composeOneLine ifNil: [^nil].
  ]
  ].
  !

Item was changed:
+ ----- Method: TextComposer>>composeAllRectangles: (in category 'private') -----
- ----- Method: TextComposer>>composeAllRectangles: (in category 'as yet unclassified') -----
  composeAllRectangles: rectangles
 
  | charIndexBeforeLine numberOfLinesBefore reasonForStopping |
 
  actualHeight := defaultLineHeight.
  charIndexBeforeLine := currCharIndex.
  numberOfLinesBefore := lines size.
  reasonForStopping := self composeEachRectangleIn: rectangles.
 
  currentY := currentY + actualHeight.
  currentY > theContainer bottom ifTrue: [
  "Oops -- the line is really too high to fit -- back out"
  currCharIndex := charIndexBeforeLine.
  lines size - numberOfLinesBefore timesRepeat: [lines removeLast].
  ^self
  ].
 
  "It's OK -- the line still fits."
  maxRightX := maxRightX max: scanner rightX.
  1 to: rectangles size - 1 do: [ :i | |lineIndex|
  "Adjust heights across rectangles if necessary"
  lineIndex:=lines size - rectangles size + i.
  (lines size between: 1 and: lineIndex) ifTrue:
  [(lines at: lineIndex)
  lineHeight: lines last lineHeight
  baseline: lines last baseline]
  ].
  isFirstLine := false.
  reasonForStopping == #columnBreak ifTrue: [^nil].
  currCharIndex > theText size ifTrue: [
  ^nil "we are finished composing"
  ].
  !

Item was changed:
+ ----- Method: TextComposer>>composeEachRectangleIn: (in category 'private') -----
- ----- Method: TextComposer>>composeEachRectangleIn: (in category 'as yet unclassified') -----
  composeEachRectangleIn: rectangles
 
  | myLine lastChar |
 
  1 to: rectangles size do: [:i |
  currCharIndex <= theText size ifFalse: [^false].
  myLine := scanner
  composeFrom: currCharIndex
  inRectangle: (rectangles at: i)
  firstLine: isFirstLine
  leftSide: i=1
  rightSide: i=rectangles size.
  lines addLast: myLine.
  actualHeight := actualHeight max: myLine lineHeight.  "includes font changes"
  currCharIndex := myLine last + 1.
  lastChar := theText at: myLine last.
  (CharacterSet crlf includes: lastChar) ifTrue: [^#cr].
  wantsColumnBreaks ifTrue: [
  lastChar = Character characterForColumnBreak ifTrue: [^#columnBreak].
  ].
  ].
  ^false!

Item was changed:
+ ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'composing') -----
- ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') -----
  composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks
 
  wantsColumnBreaks := argWantsColumnBreaks.
  lines := argLinesCollection.
  theTextStyle := argTextStyle.
  theText := argText.
  theContainer := argContainer.
  deltaCharIndex := argDelta.
  currCharIndex := startCharIndex := argStart.
  stopCharIndex := argStop.
  prevLines := argPriorLines.
  currentY := argStartY.
  maxRightX := theContainer left.
  possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
  nowSliding := false.
  prevIndex := 1.
  "choose an appropriate scanner - should go away soon, when they can be unified"
  scanner := CompositionScanner new.
  scanner text: theText textStyle: theTextStyle.
  scanner wantsColumnBreaks: wantsColumnBreaks.
  defaultLineHeight := scanner computeDefaultLineHeight.
  isFirstLine := true.
  self composeAllLines.
  isFirstLine ifTrue: ["No space in container or empty text"
  self
  addNullLineWithIndex: startCharIndex
  andRectangle: (theContainer left @ theContainer top extent: 0@defaultLineHeight)
  ] ifFalse: [
  (lines last last = theText size and: [scanner doesTheLineBreaksAfterLastChar])
  ifTrue: [self addNullLineForIndex: theText size + 1]
  ].
  ^{lines asArray. maxRightX}
  !

Item was changed:
+ ----- Method: TextComposer>>composeOneLine (in category 'private') -----
- ----- Method: TextComposer>>composeOneLine (in category 'as yet unclassified') -----
  composeOneLine
  | rectangles |
  rectangles := theContainer rectanglesAt: currentY height: defaultLineHeight.
  rectangles notEmpty
  ifTrue: [(self composeAllRectangles: rectangles) ifNil: [^nil]]
  ifFalse: [currentY := currentY + defaultLineHeight].
  self checkIfReadyToSlide!

Item was changed:
+ ----- Method: TextComposer>>slideOneLineDown (in category 'private') -----
- ----- Method: TextComposer>>slideOneLineDown (in category 'as yet unclassified') -----
  slideOneLineDown
 
  | priorLine |
 
  "Having detected the end of rippling recoposition, we are only sliding old lines"
  prevIndex < prevLines size ifFalse: [
  "There are no more prevLines to slide."
  ^nowSliding := possibleSlide := false
  ].
 
  "Adjust and re-use previously composed line"
  prevIndex := prevIndex + 1.
  priorLine := (prevLines at: prevIndex)
  slideIndexBy: deltaCharIndex andMoveTopTo: currentY.
  lines addLast: priorLine.
  currentY := priorLine bottom.
  currCharIndex := priorLine last + 1.
  wantsColumnBreaks ifTrue: [
  priorLine first to: priorLine last do: [ :i |
  (theText at: i) = Character characterForColumnBreak ifTrue: [
  nowSliding := possibleSlide := false.
  ^nil
  ].
  ].
  ].
  !