The Trunk: Graphics-cmm.125.mcz

Chris Muller uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-cmm.125.mcz

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

Name: Graphics-cmm.125
Author: cmm
Time: 23 March 2010, 3:02:37.668 pm
UUID: 2536cef2-e99b-4a78-9e77-d3724ef5d4c7
Ancestors: Graphics-cmm.124

Ran FixUnderscores on this package.

=============== Diff against Graphics-cmm.124 ===============

Item was changed:
  ----- Method: StrikeFont>>setGlyphsDepthAtMost: (in category 'building') -----
  setGlyphsDepthAtMost: aNumber
  glyphs depth > aNumber ifTrue: [
+ glyphs := glyphs asFormOfDepth: aNumber ]!
- glyphs _ glyphs asFormOfDepth: aNumber ]!

Item was changed:
  ----- Method: StrikeFont>>reset (in category 'emphasis') -----
  reset
  "Reset the cache of derivative emphasized fonts"
 
  fallbackFont class = FixedFaceFont
+ ifTrue: [fallbackFont := nil].
- ifTrue: [fallbackFont _ nil].
 
  derivativeFonts notNil ifTrue: [
  derivativeFonts withIndexDo: [ :f :i |
  (f notNil and: [f isSynthetic]) ifTrue: [derivativeFonts at: i put: nil]]].
  "
+ derivativeFonts := Array new: 32.
- derivativeFonts _ Array new: 32.
  #('B' 'I' 'BI') doWithIndex:
  [:tag :index |
+ (style := TextStyle named: self familyName) ifNotNil:
+ [(font := style fontArray
- (style _ TextStyle named: self familyName) ifNotNil:
- [(font _ style fontArray
  detect: [:each | each name = (self name , tag)]
  ifNone: [nil]) ifNotNil: [derivativeFonts at: index put: font]]]
  "!

Item was changed:
  ----- Method: StrikeFont>>makeItalicGlyphs (in category 'emphasis') -----
  makeItalicGlyphs
  "Make an italic set of glyphs with same widths by skewing left and right.
  In the process, characters would overlap, so we widen them all first.
  "
  | extraWidth newGlyphs newXTable x newX w extraOnLeft |  
+ extraOnLeft := (self height-1-self ascent+4)//4 max: 0.
+ extraWidth := ((self ascent-5+4)//4 max: 0) + extraOnLeft.
+ newGlyphs := Form extent: (glyphs width + (maxAscii + 1 - minAscii*extraWidth)) @ glyphs height depth: glyphs depth.
- extraOnLeft _ (self height-1-self ascent+4)//4 max: 0.
- extraWidth _ ((self ascent-5+4)//4 max: 0) + extraOnLeft.
- newGlyphs _ Form extent: (glyphs width + (maxAscii + 1 - minAscii*extraWidth)) @ glyphs height depth: glyphs depth.
  newGlyphs fillWhite.
+ newXTable := xTable copy.
- newXTable _ xTable copy.
 
  "Copy glyphs into newGlyphs with room on left and right for overlap."
  minAscii to: maxAscii+1 do:
+ [:ascii | x := xTable at: ascii+1.  w := (xTable at: ascii+2) - x.
+ newX := newXTable at: ascii+1.
- [:ascii | x _ xTable at: ascii+1.  w _ (xTable at: ascii+2) - x.
- newX _ newXTable at: ascii+1.
  newGlyphs copy: ((newX + extraOnLeft) @ 0 extent: w @ glyphs height)
  from: x @ 0 in: glyphs rule: Form over.
  newXTable at: ascii+2 put: newX + w + extraWidth].
+ glyphs := newGlyphs.
+ xTable := newXTable.
- glyphs _ newGlyphs.
- xTable _ newXTable.
  "Slide the bitmaps left and right for synthetic italic effect."
  4 to: self ascent-1 by: 4 do:
  [:y | "Slide ascenders right..."
  glyphs copy: (1@0 extent: glyphs width @ (self ascent - y))
  from: 0@0 in: glyphs rule: Form over].
  self ascent to: self height-1 by: 4 do:
  [:y | "Slide descenders left..."
  glyphs copy: (0@y extent: glyphs width @ glyphs height)
  from: 1@y in: glyphs rule: Form over].
  self isSynthetic: true.
  fallbackFont ifNotNil: [
+ fallbackFont := fallbackFont emphasized: 2
- fallbackFont _ fallbackFont emphasized: 2
  ].
 
  !

Item was changed:
  ----- Method: StrikeFont>>stripHighGlyphs (in category 'building') -----
  stripHighGlyphs
  "Remove glyphs for characters above 128"
  | i |
+ maxAscii := 127.
- maxAscii _ 127.
 
+ xTable := xTable copyFrom: 1 to: maxAscii + 3.
+ i := xTable at: maxAscii + 1.
- xTable _ xTable copyFrom: 1 to: maxAscii + 3.
- i _ xTable at: maxAscii + 1.
  xTable at: maxAscii + 2 put: i.
  xTable at: maxAscii + 3 put: i.
+ glyphs := glyphs copy: (0@0 extent: i@glyphs height).
+ maxWidth := 0.
- glyphs _ glyphs copy: (0@0 extent: i@glyphs height).
- maxWidth _ 0.
  2 to: xTable size do: [ :ii |
+ maxWidth := maxWidth max: (xTable at: ii) - (xTable at: ii-1)-1 ].
+ characterToGlyphMap := nil.
- maxWidth _ maxWidth max: (xTable at: ii) - (xTable at: ii-1)-1 ].
- characterToGlyphMap _ nil.
  self reset!

Item was changed:
  ----- Method: StrikeFont>>ensureCleanBold (in category 'character shapes') -----
  ensureCleanBold
  "This ensures that all character glyphs have at least one pixel of white space on the right
  so as not to cause artifacts in neighboring characters in bold or italic."
 
  | wider glyph |
  emphasis = 0 ifFalse: [^ self].
  minAscii to: maxAscii do:
+ [:i | glyph := self characterFormAt: (Character value: i).
- [:i | glyph _ self characterFormAt: (Character value: i).
  (glyph copy: (glyph boundingBox topRight - (1@0)
  corner: glyph boundingBox bottomRight)) isAllWhite ifFalse: [
+ wider := Form extent: (glyph width + 1)@glyph height depth: glyph depth.
- wider _ Form extent: (glyph width + 1)@glyph height depth: glyph depth.
  glyph depth > 1 ifTrue: [wider fillWhite].
  glyph displayOn: wider.
  self characterFormAt: (Character value: i) put: wider]].
  "
  StrikeFont allInstancesDo: [:f | f ensureCleanBold].
  (StrikeFont familyName: 'NewYork' size: 21) ensureCleanBold.
  StrikeFont shutDown.  'Flush synthetic fonts'.
  "
  !

Item was changed:
  ----- Method: StrikeFont>>buildFromForm:data:name: (in category 'building') -----
  buildFromForm: allGlyphs data: data name: aString
 
  | x |
+ pointSize := data first.
+ ascent := data second.
+ descent := data third.
- pointSize _ data first.
- ascent _ data second.
- descent _ data third.
 
+ minAscii := 32.
+ maxAscii := 255.
+ name := aString.
+ type := 0.  "ignored for now"
+ superscript := ascent - descent // 3.
+ subscript := descent - ascent // 3.
+ emphasis := 0.
- minAscii _ 32.
- maxAscii _ 255.
- name _ aString.
- type _ 0.  "ignored for now"
- superscript _ ascent - descent // 3.
- subscript _ descent - ascent // 3.
- emphasis _ 0.
 
+ xTable := (Array new: 258) atAllPut: 0.
+ maxWidth := 0.
+ glyphs := allGlyphs.
+ x := 0.
- xTable _ (Array new: 258) atAllPut: 0.
- maxWidth _ 0.
- glyphs _ allGlyphs.
- x _ 0.
  minAscii to: maxAscii+1 do: [ :i |
+ x := (data at: i-minAscii+4).
- x _ (data at: i-minAscii+4).
  xTable at: i+1 put: x].
  xTable at: 258 put: x.
  self reset.
+ derivativeFonts := Array new: 32!
- derivativeFonts _ Array new: 32!

Item was changed:
  ----- Method: StrikeFont>>makeCondensedGlyphs (in category 'emphasis') -----
  makeCondensedGlyphs
  "Make a condensed set of glyphs with same widths.
  NOTE: this has been superceded by kerning -- should not get called"
  | g newXTable x x1 w |
+ g := glyphs deepCopy.
+ newXTable := Array new: xTable size.
+ newXTable at: 1 put: (x := xTable at: 1).
- g _ glyphs deepCopy.
- newXTable _ Array new: xTable size.
- newXTable at: 1 put: (x _ xTable at: 1).
  1 to: xTable size-1 do:
+ [:i | x1 := xTable at: i.  w := (xTable at: i+1) - x1.
+ w > 1 ifTrue: [w := w-1].  "Shrink every character wider than 1"
- [:i | x1 _ xTable at: i.  w _ (xTable at: i+1) - x1.
- w > 1 ifTrue: [w _ w-1].  "Shrink every character wider than 1"
  g copy: (x@0 extent: w@g height) from: x1@0 in: glyphs rule: Form over.
+ newXTable at: i+1 put: (x := x + w)].
+ xTable := newXTable.
+ glyphs := g.
- newXTable at: i+1 put: (x _ x + w)].
- xTable _ newXTable.
- glyphs _ g.
  self isSynthetic: true.
  fallbackFont ifNotNil: [
  fallbackFont emphasized: 8
  ].
 
  "
  (TextStyle default fontAt: 1) copy makeCondensedGlyphs
  displayLine: 'The quick brown fox jumps over the lazy dog'
  at: Sensor cursorPoint
  "!

Item was changed:
  ----- Method: CharacterScanner>>placeEmbeddedObject: (in category 'scanning') -----
  placeEmbeddedObject: anchoredMorph
  "Place the anchoredMorph or return false if it cannot be placed.
  In any event, advance destX by its width."
  | w |
  "Workaround: The following should really use #textAnchorType"
  anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
+ destX := destX + (w := anchoredMorph width).
- destX _ destX + (w _ anchoredMorph width).
  (destX > rightMargin and: [(leftMargin + w) <= rightMargin])
  ifTrue: ["Won't fit, but would on next line"
  ^ false].
+ lastIndex := lastIndex + 1.
- lastIndex _ lastIndex + 1.
  "self setFont."  "Force recalculation of emphasis for next run"
  ^ true!

Item was changed:
  ----- Method: Color class>>computeIndexedColorConvertingMap:from:to: (in category 'colormaps') -----
  computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
  | map |
 
+ map := (IndexedColors copyFrom: 1 to: (1 bitShift: sourceDepth)) collect: [ :cc | | f c |
+ f := 1.0 - (cc red + cc green + cc blue / 3.0 ).
+ c := targetColor notNil
- map _ (IndexedColors copyFrom: 1 to: (1 bitShift: sourceDepth)) collect: [ :cc | | f c |
- 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 _ map as: Bitmap.
  ^map!

Item was changed:
  ----- Method: StrikeFont>>characterFormAt:put: (in category 'character shapes') -----
  characterFormAt: character put: characterForm
  "Copy characterForm over the glyph for the argument, character."
  | ascii leftX rightX widthDif newGlyphs |
+ ascii := character asciiValue.
- ascii _ character asciiValue.
  ascii < minAscii ifTrue: [^ self error: 'Cant store characters below min ascii'].
  ascii > maxAscii ifTrue:
  [(self confirm:
  'This font does not accomodate ascii values higher than ' , maxAscii printString , '.
  Do you wish to extend it permanently to handle values up to ' , ascii printString)
  ifTrue: [self extendMaxAsciiTo: ascii]
  ifFalse: [^ self error: 'No change made']].
+ leftX := xTable at: ascii + 1.
+ rightX := xTable at: ascii + 2.
+ widthDif := characterForm width - (rightX - leftX).
- leftX _ xTable at: ascii + 1.
- rightX _ xTable at: ascii + 2.
- widthDif _ characterForm width - (rightX - leftX).
  widthDif ~= 0 ifTrue:
  ["Make new glyphs with more or less space for this char"
+ newGlyphs := Form extent: (glyphs width + widthDif) @ glyphs height depth: glyphs depth.
- newGlyphs _ Form extent: (glyphs width + widthDif) @ glyphs height depth: glyphs depth.
  newGlyphs copy: (0@0 corner: leftX@glyphs height)
  from: 0@0 in: glyphs rule: Form over.
  newGlyphs copy: ((rightX+widthDif)@0 corner: newGlyphs width@glyphs height)
  from: rightX@0 in: glyphs rule: Form over.
+ glyphs := newGlyphs.
- glyphs _ newGlyphs.
  "adjust further entries on xTable"
+ xTable := xTable copy.
- xTable _ xTable copy.
  ascii+2 to: xTable size
  do: [:i | xTable at: i put: (xTable at: i) + widthDif]].
  glyphs copy: (leftX @ 0 extent: characterForm extent)
  from: 0@0 in: characterForm rule: Form over
  "
+ | f |  f := TextStyle defaultFont.
- | f |  f _ TextStyle defaultFont.
  f characterFormAt: $  put: (Form extent: (f widthOf: $ )+10@f height)
  "!

Item was changed:
  ----- Method: StrikeFont>>isSynthetic: (in category 'emphasis') -----
  isSynthetic: aBoolean
+ type := aBoolean ifTrue: [3] ifFalse: [0]!
- type _ aBoolean ifTrue: [3] ifFalse: [0]!

Item was changed:
  ----- Method: StrikeFont>>makeStruckOutGlyphs (in category 'emphasis') -----
  makeStruckOutGlyphs
  "Make a struck-out set of glyphs with same widths"
  | g |
+ g := glyphs deepCopy.
- g _ glyphs deepCopy.
  g fillBlack: (0 @ (self ascent - (self ascent//3)) extent: g width @ 1).
+ glyphs := g.
- glyphs _ g.
  self isSynthetic: true.
  fallbackFont ifNotNil: [
+ fallbackFont := fallbackFont emphasized: 16
- fallbackFont _ fallbackFont emphasized: 16
  ].
  !

Item was changed:
  ----- Method: Color class>>computeRGBColorConvertingMap:to:keepSubPixelAA: (in category 'colormaps') -----
  computeRGBColorConvertingMap: targetColor to: destDepth keepSubPixelAA: keepSubPix
  "Builds a colormap intended to convert from subpixelAA black values to targetColor values.
  keepSubPix
  ifTrue: [ Answer colors that also include subpixelAA ]
  ifFalse: [
  Take fullpixel luminance level. Apply it to targetColor.
  I.e. answer colors with NO subpixelAA ]"
 
  | 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.
- bitsPerColor _ bitsPerColor min: Preferences aaFontsColormapDepth.
  mask := (1 bitShift: bitsPerColor) - 1.
+ map := Bitmap new: (1 bitShift: (3 * bitsPerColor)).
- 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: [
  (keepSubPix and: [destDepth > 8]) ifTrue: [
  Color
  r: 1.0 - (r/mask) * targetColor red
  g: 1.0 - (g/mask) * targetColor green
  b: 1.0 - (b/mask) * targetColor blue
  alpha: f * targetColor alpha "alpha will be ignored below, in #pixelValueForDepth: if destDepth ~= 32" ]
  ifFalse: [
  destDepth = 32
  ifTrue: [ targetColor * f alpha: f * targetColor alpha ]
  ifFalse: [ targetColor alphaMixed: f*1.5 with: Color white ]]]
  ifFalse: [ Color r: r g: g b: b range: mask]. "This is currently used only to keep some SubPixelAA on destDepth = 8, using a single pass of rule 25"
  v := destDepth = 32
  ifTrue: [ c pixelValueForDepth: destDepth]
  ifFalse: [
  f < 0.1
  ifTrue: [ 0 ]
  ifFalse: [ c pixelValueForDepth: destDepth ]].
  map at: i + 1 put: v ].
  ^ map!

Item was changed:
  ----- Method: StrikeFont>>makeLfVisible (in category 'character shapes') -----
  makeLfVisible
  | glyph |
  self characterToGlyphMap.
+ glyph := self characterFormAt: (Character value: 163).
- glyph _ self characterFormAt: (Character value: 163).
  glyph border: glyph boundingBox width: 1 fillColor: Color blue.
+ " glyph := glyph reverse."
- " glyph _ glyph reverse."
  self characterFormAt: (Character value: 132) put: glyph.
  characterToGlyphMap at: 11 put: 132!

Item was changed:
  ----- Method: StrikeFont>>makeBoldGlyphs (in category 'emphasis') -----
  makeBoldGlyphs
  "Make a bold set of glyphs with same widths by ORing 1 bit to the right
  (requires at least 1 pixel of intercharacter space)"
  | g bonkForm |
+ g := glyphs deepCopy.
+ bonkForm := (Form extent: 1@16) fillBlack offset: -1@0.
- g _ glyphs deepCopy.
- bonkForm _ (Form extent: 1@16) fillBlack offset: -1@0.
  self bonk: g with: bonkForm.
  glyphs depth = 1 ifTrue: [
  g copyBits: g boundingBox from: g at: (1@0)
  clippingBox: g boundingBox rule: Form under fillColor: nil]
  ifFalse: [
  0 to: g width - 2 do: [ :x | 0 to: g height-1 do: [ :y |
  (glyphs colorAt:  x@y) = Color white ifFalse: [
  g colorAt: x+1@y put:
  ((glyphs colorAt: x+1@y) = Color white
  ifTrue: [glyphs colorAt:  x@y]
  ifFalse: [Color black])]]]].
+ glyphs := g.
- glyphs _ g.
  self isSynthetic: true.
  fallbackFont ifNotNil: [
+ fallbackFont := fallbackFont emphasized: 1
- fallbackFont _ fallbackFont emphasized: 1
  ].!

Item was changed:
  ----- Method: BitBlt class>>recreateColorMaps (in category 'private') -----
  recreateColorMaps
+ CachedFontColorMaps := ColorConvertingMaps := nil!
- CachedFontColorMaps _ ColorConvertingMaps _ nil!

Item was changed:
  ----- Method: StrikeFont>>makeUnderlinedGlyphs (in category 'emphasis') -----
  makeUnderlinedGlyphs
  "Make an underlined set of glyphs with same widths"
  | g |
+ g := glyphs deepCopy.
- g _ glyphs deepCopy.
  g fillBlack: (0 @ (self ascent+1) extent: g width @ 1).
+ glyphs := g.
- glyphs _ g.
  self isSynthetic: true.
  fallbackFont ifNotNil: [
+ fallbackFont := fallbackFont emphasized: 4
- fallbackFont _ fallbackFont emphasized: 4
  ].
  !

Item was changed:
  ----- Method: BitBlt>>colorConvertingMap:from:to:keepSubPixelAA: (in category 'private') -----
  colorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix
 
  | srcIndex map mapsForSource mapsForSourceAndDest |
  ColorConvertingMaps class == Array
+ ifFalse: [ColorConvertingMaps := (1 to: 10) collect: [:i | Array new: 32]].
- ifFalse: [ColorConvertingMaps _ (1 to: 10) collect: [:i | Array new: 32]].
 
+ srcIndex := sourceDepth.
+ sourceDepth > 8 ifTrue: [ srcIndex := keepSubPix ifTrue: [9] ifFalse: [10] ].
+ mapsForSource := ColorConvertingMaps at: srcIndex.
+ (mapsForSourceAndDest := mapsForSource at: destDepth) isNil ifTrue: [
+ mapsForSourceAndDest := mapsForSource at: destDepth put: Dictionary new ].
- srcIndex _ sourceDepth.
- sourceDepth > 8 ifTrue: [ srcIndex _ keepSubPix ifTrue: [9] ifFalse: [10] ].
- mapsForSource _ ColorConvertingMaps at: srcIndex.
- (mapsForSourceAndDest _ mapsForSource at: destDepth) isNil ifTrue: [
- mapsForSourceAndDest _ mapsForSource at: destDepth put: Dictionary new ].
 
+ map := mapsForSourceAndDest at: targetColor ifAbsentPut: [
- map _ mapsForSourceAndDest at: targetColor ifAbsentPut: [
  Color computeColorConvertingMap: targetColor from: sourceDepth to: destDepth keepSubPixelAA: keepSubPix ].
 
  ^ map!

Item was changed:
  ----- Method: StrikeFont>>makeControlCharsVisible (in category 'character shapes') -----
  makeControlCharsVisible
  | glyph d|
  self characterToGlyphMap.
+ glyph := self characterFormAt: (Character space).
- glyph _ self characterFormAt: (Character space).
  glyph border: glyph boundingBox width: 1 fillColor: Color blue.
  self characterFormAt: (Character value: 133) put: glyph.
 
  "Keep tab(9), lf(10), cr(13) and space(32) transparent or whatever the user chose"
  #(0 1 2 3 4 5 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31)
  do: [ :ascii |
  characterToGlyphMap at: ascii + 1 put: 133 ]!