The Trunk: Graphics-nice.95.mcz

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

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

Name: Graphics-nice.95
Author: nice
Time: 27 December 2009, 5:18:02 am
UUID: 0448a80e-65cd-4f79-9fcf-1e607f25b813
Ancestors: Graphics-nice.94

Cosmetic: move or remove a few temps inside closures

=============== Diff against Graphics-nice.94 ===============

Item was changed:
  ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector:highlight: (in category 'user interface') -----
  promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont
  "Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a
  message with selector aSelector."
  "TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector:
  #setSystemFontTo: "
  "Derived from a method written by Robin Gibson"
+ | menu currentTextStyle |
- | menu subMenu currentTextStyle |
  currentTextStyle := currentFont
  ifNotNil: [currentFont textStyleName].
  menu := MenuMorph entitled: aPrompt.
  self actualTextStyles keysSortedSafely
+ do: [:styleName | | subMenu |
- do: [:styleName |
  subMenu := self
  fontMenuForStyle: styleName
  target: aTarget
  selector: aSelector
  highlight: currentFont.
  menu add: styleName subMenu: subMenu.
  menu lastItem
  font: ((self named: styleName)
  fontOfSize: 18).
  styleName = currentTextStyle
  ifTrue: [menu lastItem color: Color blue darker]].
  menu popUpInWorld: self currentWorld!

Item was changed:
  ----- Method: Pen>>print:withFont: (in category 'operations') -----
  print: str withFont: font
  "Print the given string in the given font at the current heading"
+ | lineStart scale wasDown |
- | lineStart form charStart rowStart scale wasDown bb pix |
  scale := sourceForm width.
  wasDown := penDown.
  lineStart := location.
  str do:
+ [:char | | charStart pix rowStart form bb |
- [:char |
  char = Character cr ifTrue:
  [self place: lineStart; up; turn: 90; go: font height*scale; turn: -90; down]
  ifFalse:
  [form := font characterFormAt: char.
  charStart := location.
  wasDown ifTrue: [
  self up; turn: -90; go: font descent*scale; turn: 90; down.
  0 to: form height-1 do:
  [:y |
  rowStart := location.
  bb := BitBlt current bitPeekerFromForm: form.
  pix := RunArray newFrom:
  ((0 to: form width-1) collect: [:x | bb pixelAt: x@y]).
  pix runs with: pix values do:
  [:run :value |
  value = 0
  ifTrue: [self up; go: run*scale; down]
  ifFalse: [self go: run*scale]].
  self place: rowStart; up; turn: 90; go: scale; turn: -90; down].
  ].
  self place: charStart; up; go: form width*scale; down].
  ].
  wasDown ifFalse: [self up]
  "
  Display restoreAfter:
  [Pen new squareNib: 2; color: Color red; turn: 45;
  print: 'The owl and the pussycat went to sea
  in a beautiful pea green boat.' withFont: TextStyle defaultFont]
  "!

Item was changed:
  ----- Method: Form>>cgForPixelValue:orNot: (in category 'analyzing') -----
  cgForPixelValue: pv orNot: not
  "Return the center of gravity for all pixels of value pv.
  Note:  If orNot is true, then produce the center of gravity for all pixels
  that are DIFFERENT from the supplied (background) value"
+ | xAndY |
- | pixCount weighted xAndY |
  xAndY := (Array with: (self xTallyPixelValue: pv orNot: not)
  with: (self yTallyPixelValue: pv orNot: not)) collect:
+ [:profile | | pixCount weighted | "For both x and y profiles..."
- [:profile | "For both x and y profiles..."
  pixCount := 0.  weighted := 0.
  profile doWithIndex:
  [:t :i | pixCount := pixCount + t.
  weighted := weighted + (t*i)].
  pixCount = 0  "Produce average of nPixels weighted by coordinate"
  ifTrue: [0.0]
  ifFalse: [weighted asFloat / pixCount asFloat - 1.0]].
 
  ^ xAndY first @ xAndY last
  "
  | f cg |
  [Sensor anyButtonPressed] whileFalse:
  [f := Form fromDisplay: (Sensor cursorPoint extent: 50@50).
  cg := f cgForPixelValue: (Color black pixelValueForDepth: f depth) orNot: false.
  f displayAt: 0@0.
  Display fill: (cg extent: 2@2) fillColor: Color red].
  ScheduledControllers restore
  "!

Item was changed:
  ----- Method: WarpBlt class>>test3 (in category 'examples') -----
  test3   "Display restoreAfter: [WarpBlt test3]"
 
  "The Squeak Release Mandala - 9/23/96 di"
 
  "Move the mouse near the center of the square.
  Up and down affects shrink/grow
  Left and right affect rotation angle"
+ | warp pts p0 box map d p |
- | warp pts p0 p box map d t |
  box := 100@100 extent: 300@300.
  Display border: (box expandBy: 2) width: 2.
 
  "Make a color map that steps through the color space"
  map := (Display depth > 8
  ifTrue: ["RGB is a bit messy..."
  d := Display depth = 16 ifTrue: [5] ifFalse: [8].
+ (1 to: 512) collect: [:i | | t |
+ t := i bitAnd: 511.
- (1 to: 512) collect: [:i | t := i bitAnd: 511.
  ((t bitAnd: 16r7) bitShift: d-3)
  + ((t bitAnd: 16r38) bitShift: d-3*2)
  + ((t bitAnd: 16r1C0) bitShift: d-3*3)]]
  ifFalse: ["otherwise simple"
  1 to: (1 bitShift: Display depth)])
  as: Bitmap.
  warp := (WarpBlt toForm: Display)
  clipRect: box;
  sourceForm: Display;
  colorMap: map;
  combinationRule: Form over.
  p0 := box center.
  [Sensor anyButtonPressed] whileFalse:
  [p := Sensor cursorPoint.
  pts := (box insetBy: p y - p0 y) innerCorners
  collect: [:pt | pt rotateBy: p x - p0 x / 50.0 about: p0].
  warp copyQuad: pts toRect: box]!

Item was changed:
  ----- Method: Color>>wheel: (in category 'groups of shades') -----
  wheel: thisMany
  "An array of thisMany colors around the color wheel starting at self and ending all the way around the hue space just before self.  Array is of length thisMany.  Very useful for displaying color based on a variable in your program.  "
 
+ | sat bri step hue |
- | sat bri hue step c |
  sat := self saturation.
  bri := self brightness.
  hue := self hue.
  step := 360.0 / (thisMany max: 1).
+ ^ (1 to: thisMany) collect: [:num | | c |
- ^ (1 to: thisMany) collect: [:num |
  c := Color h: hue s: sat v: bri.  "hue is taken mod 360"
  hue := hue + step.
  c].
  "
  (Color wheel: 8) withIndexDo: [:c :i | Display fill: (i*10@20 extent: 10@20) fillColor: c]
  "!

Item was changed:
  ----- Method: PNGReadWriter class>>test1 (in category 'as yet unclassified') -----
  test1
  "PNGReadWriter test1"
+ | d0 d1 fileInfo book d2 f |
- | data t error d0 d1 f fileInfo book result d2 |
 
  Debugging _ true.
  1 = 1 ifTrue: [
  book _ BookMorph new.
  book setProperty: #transitionSpec toValue: {'silence'. #none. #none}.
  ].
  d0 _ FileDirectory default.
  d1 _ d0 directoryNamed: 'PngSuite Folder'.
  d2 _ d0 directoryNamed: 'BIG PNG'.
  {d0. d1. d2}. "keep compiler quiet"
  "==
  citrus_none_sub.png
  citrus_adm7_adap.png
  citrus_adm7_aver.png
  citrus_adm7_non.png
  citrus_adm7_paeth.png
  pngs-img-ie5mac.png
  =="
  fileInfo _ {
  d2. {'citrus_adm7_adap.png'}.
  "d1. d1 fileNames."
  }.
  fileInfo pairsDo: [ :dir :fileNames |
+ fileNames do: [ :each | | error data t |
- fileNames do: [ :each |
  Transcript cr; show: each.
  data _ (dir fileNamed: each) contentsOfEntireFile.
  error _ ''.
  MessageTally spyOn: [
+ t _ [ | result |
- t _ [
  result _ self createAFormFrom: data.
  f_ result first.
  error _ result second.
  ] timeToRun.].
  self insertMorph: f asMorph named: each into: book.
  Transcript show: each,'  ',data size printString,' = ',t printString,' ms',error; cr.
  ].
  ].
  book ifNotNil: [book openInWorld].
  Debugging _ false.!

Item was changed:
  ----- Method: TextStyle class>>importFontsFromStyleFiles (in category 'user interface') -----
  importFontsFromStyleFiles
  "Import any and all of the fonts found in the default directory in files named ComicBold.style, ComicPlain.style, NewYork.style, Palatino.style, Courier.style"
 
+
- | aName |
  #('ComicBold' 'ComicPlain' 'NewYork' 'Palatino' 'Courier') do:
+ [:frag | | aName |
- [:frag |
  (TextStyle knownTextStyles includes: frag) ifFalse:
  [(FileDirectory default fileExists: (aName := frag, '.style'))
  ifTrue:
  [TextStyle default collectionFromFileNamed: aName]]].!

Item was changed:
  ----- Method: Color class>>initializeTranslucentPatterns (in category 'class initialization') -----
  initializeTranslucentPatterns
  "Color initializeTranslucentPatterns"
+
- | mask bits pattern patternList |
  TranslucentPatterns := Array new: 8.
+ #(1 2 4 8) do:[:d| | pattern patternList mask bits |
- #(1 2 4 8) do:[:d|
  patternList := Array new: 5.
  mask := (1 bitShift: d) - 1.
  bits := 2 * d.
  [bits >= 32] whileFalse: [
  mask := mask bitOr: (mask bitShift: bits).  "double the length of mask"
  bits := bits + bits].
  "0% pattern"
  pattern := Bitmap with: 0 with: 0.
  patternList at: 1 put: pattern.
  "25% pattern"
  pattern := Bitmap with: mask with: 0.
  patternList at: 2 put: pattern.
  "50% pattern"
  pattern := Bitmap with: mask with: mask bitInvert32.
  patternList at: 3 put: pattern.
  "75% pattern"
  pattern := Bitmap with: mask with: 16rFFFFFFFF.
  patternList at: 4 put: pattern.
  "100% pattern"
  pattern := Bitmap with: 16rFFFFFFFF with: 16rFFFFFFFF.
  patternList at: 5 put: pattern.
  TranslucentPatterns at: d put: patternList.
  ].!

Item was changed:
  ----- Method: BitBlt class>>benchmark (in category 'benchmarks') -----
  benchmark "BitBlt benchmark"
  "Run a benchmark on different combinations rules, source/destination depths and BitBlt modes. Note: This benchmark doesn't give you any 'absolute' value - it is intended only for benchmarking improvements in the bitblt code and nothing else.
  Attention: *this*may*take*a*while*"
+ | destRect log |
- | bb source dest destRect log t |
  log := WriteStream on: String new.
  destRect := 0@0 extent: 600@600.
  "Form paint/Form over - the most common rules"
  #( 25 3 ) do:[:rule|
  Transcript cr; show:'---- Combination rule: ', rule printString,' ----'.
  log cr; nextPutAll:'---- Combination rule: ', rule printString,' ----'.
+ #(1 2 4 8 16 32) do:[:destDepth| | dest |
- #(1 2 4 8 16 32) do:[:destDepth|
  dest := nil.
  dest := Form extent: destRect extent depth: destDepth.
  Transcript cr.
  log cr.
+ #(1 2 4 8 16 32) do:[:sourceDepth| | t source bb |
- #(1 2 4 8 16 32) do:[:sourceDepth|
  Transcript cr; show: sourceDepth printString, ' => ', destDepth printString.
  log cr; nextPutAll: sourceDepth printString, ' => ', destDepth printString.
  source := nil. bb := nil.
  source := Form extent: destRect extent depth: sourceDepth.
  (source getCanvas) fillOval: dest boundingBox color: Color yellow borderWidth: 30 borderColor: Color black.
  bb := WarpBlt toForm: dest.
  bb sourceForm: source.
  bb sourceRect: source boundingBox.
  bb destRect: dest boundingBox.
  bb colorMap: (source colormapIfNeededFor: dest).
  bb combinationRule: rule.
 
  "Measure speed of copyBits"
  t := Time millisecondsToRun:[bb copyBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  bb sourceForm: source destRect: source boundingBox.
 
  "Measure speed of 1x1 warpBits"
  bb cellSize: 1.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 2x2 warpBits"
  bb cellSize: 2.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 3x3 warpBits"
  bb cellSize: 3.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
  ].
  ].
  ].
  ^log contents!

Item was changed:
  ----- Method: BDFFontReader class>>installX11Fonts (in category 'resource download') -----
  installX11Fonts "BDFFontReader installX11Fonts"
  "Installs previously-converted .sf2 fonts into the TextConstants dictionary.  This makes them available as TextStyles everywhere in the image."
 
+ | families |
- | families fontArray textStyle |
  families := #( 'Courier' 'Helvetica' 'LucidaBright' 'Lucida' 'LucidaTypewriter' 'NewCenturySchoolbook' 'TimesRoman' ).
 
+ families do: [:family | | fontArray textStyle |
- families do: [:family |
  fontArray := StrikeFont readStrikeFont2Family: family.
  textStyle := TextStyle fontArray: fontArray.
  TextConstants at: family asSymbol put: textStyle.
  ].
  !

Item was changed:
  ----- Method: Form class>>extent:fromStipple: (in category 'instance creation') -----
  extent: extentPoint fromStipple: fourNibbles
  "Answer an instance of me with bitmap initialized from
  a repeating 4x4 bit stipple encoded in a 16-bit constant."
+
- | nibble |
  ^ (self extent: extentPoint depth: 1)
  initFromArray: ((1 to: 4) collect:
+ [:i | | nibble |
+ nibble := (fourNibbles bitShift: -4*(4-i)) bitAnd: 16rF.
- [:i | nibble := (fourNibbles bitShift: -4*(4-i)) bitAnd: 16rF.
  16r11111111 * nibble])  "fill 32 bits with each 4-bit nibble"
  !

Item was changed:
  ----- Method: TextStyle class>>collectionFromCompressedMIMEString: (in category 'mime file in/out') -----
  collectionFromCompressedMIMEString: aString
  "aString holds a compressed, Base64 representation of a SmartRefStream storage of a TextStyle.
  Install the TextStyle."
 
+ | this newName style data |
- | this newName style heights data |
  data := (Base64MimeConverter mimeDecode: aString as: String) unzipped.
  (RWBinaryOrTextStream with: data) reset; fileIn.
  this := SmartRefStream scannedObject.
 
  "now install it"
 
  newName := this fontArray first familyName.
  this fontArray do: [:aFont | aFont familyName = newName ifFalse: [
  self error: 'All must be same family']].
  style := TextConstants at: newName asSymbol ifAbsent: [
  ^ TextConstants at: newName asSymbol put: this]. "new family"
+ this fontArray do: [:aFont | | heights | "add new fonts"
- this fontArray do: [:aFont | "add new fonts"
  heights := style fontArray collect: [:bFont | bFont height].
  (heights includes: aFont height) ifFalse: [
  style fontAt: style fontArray size + 1 put: aFont]].
  !

Item was changed:
  ----- Method: Pen class>>feltTip:cellSize: (in category 'tablet drawing examples') -----
  feltTip: width cellSize: cellSize
  "Warning: This example potentially uses a large amount of memory--it creates a Form with cellSize squared bits for every Display pixel."
  "In this example, all drawing is done into a large, monochrome Form and then scaled down onto the Display using smoothing. The larger the cell size, the more possible shades of gray can be generated, and the smoother the resulting line appears. A cell size of 8 yields 64 possible grays, while a cell size of 16 gives 256 levels, which is about the maximum number of grays that the human visual system can distinguish. The width parameter determines the maximum line thickness. Requires the optional tablet support primitives which may not be supported on all platforms. Works best in full screen mode. Shift-mouse to exit."
  "Pen feltTip: 2.7 cellSize: 8"
 
+ | tabletScale bitForm pen warp |
- | tabletScale bitForm pen warp p srcR dstR nibSize startP r |
  tabletScale := self tabletScaleFactor.
  bitForm := Form extent: Display extent * cellSize depth: 1.
  pen := Pen newOnForm: bitForm.
  pen color: Color black.
  warp := (WarpBlt current toForm: Display)
  sourceForm: bitForm;
  colorMap: (bitForm colormapIfNeededFor: Display);
  cellSize: cellSize;
  combinationRule: Form over.
  Display fillColor: Color white.
+ Display restoreAfter: [ | p r nibSize srcR startP dstR |
- Display restoreAfter: [
  [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [
  p := (Sensor tabletPoint * cellSize * tabletScale) rounded.
  nibSize := (Sensor tabletPressure * (cellSize * width)) rounded.
      nibSize > 0
  ifTrue: [
  pen squareNib: nibSize.
  startP := pen location.
  pen goto: p.
  r := startP rect: pen location.
  dstR := (r origin // cellSize) corner: ((r corner + nibSize + (cellSize - 1)) // cellSize).
  srcR := (dstR origin * cellSize) corner: (dstR corner * cellSize).
  warp copyQuad: srcR innerCorners toRect: dstR]
  ifFalse: [
  pen place: p]]].
  !

Item was changed:
  ----- Method: BitBlt class>>benchmark2 (in category 'benchmarks') -----
  benchmark2 "BitBlt benchmark"
  "Run a benchmark on different combinations rules, source/destination depths and BitBlt modes. Note: This benchmark doesn't give you any 'absolute' value - it is intended only for benchmarking improvements in the bitblt code and nothing else.
  Attention: *this*may*take*a*while*"
+ | destRect log |
- | bb source dest destRect log t |
  log := WriteStream on: String new.
  destRect := 0@0 extent: 600@600.
  "Form paint/Form over - the most common rules"
  #( 25 3 ) do:[:rule|
  Transcript cr; show:'---- Combination rule: ', rule printString,' ----'.
  log cr; nextPutAll:'---- Combination rule: ', rule printString,' ----'.
+ #(1 2 4 8 16 32) do:[:destDepth| | dest |
- #(1 2 4 8 16 32) do:[:destDepth|
  dest := nil.
  dest := Form extent: destRect extent depth: destDepth.
  Transcript cr.
  log cr.
+ #(1 2 4 8 16 32) do:[:sourceDepth| | t bb source |
- #(1 2 4 8 16 32) do:[:sourceDepth|
  Transcript cr; show: sourceDepth printString, ' => ', destDepth printString.
  log cr; nextPutAll: sourceDepth printString, ' => ', destDepth printString.
  source := nil. bb := nil.
  source := Form extent: destRect extent depth: sourceDepth.
  (source getCanvas) fillOval: dest boundingBox color: Color yellow borderWidth: 30 borderColor: Color black.
  bb := WarpBlt toForm: dest.
  bb sourceForm: source.
  bb sourceRect: source boundingBox.
  bb destRect: dest boundingBox.
  bb colorMap: (source colormapIfNeededFor: dest).
  bb combinationRule: rule.
 
  "Measure speed of copyBits"
  t := Time millisecondsToRun:[1 to: 10 do:[:i| bb copyBits]].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  bb sourceForm: source destRect: source boundingBox.
 
  "Measure speed of 1x1 warpBits"
  bb cellSize: 1.
  t := Time millisecondsToRun:[1 to: 4 do:[:i| bb warpBits]].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 2x2 warpBits"
  bb cellSize: 2.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 3x3 warpBits"
  bb cellSize: 3.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
  ].
  ].
  ].
  ^log contents!

Item was changed:
  ----- Method: Pen class>>inkBrush (in category 'tablet drawing examples') -----
  inkBrush
  "Similar to simplePressurePen, but this example uses the average of the recent pen pressure values. The effect is that of a Japanese ink brush that comes up gradually off the paper as the brush is lifted, causing end (and beginning) of each stroke to taper. Requires the optional tablet support primitives which may not be supported on all platforms. Works best in full screen mode. Shift-mouse to exit."
  "Pen inkBrush"
 
+ | tabletScale historyMSecs pressureHistory pen |
- | tabletScale historyMSecs pressureHistory pen now currentPressure sum averagePressure p |
  tabletScale := self tabletScaleFactor.
  historyMSecs := 120.
  pressureHistory := OrderedCollection new.
  pen := Pen newOnForm: Display.
  pen color: Color black.
  Display fillColor: Color white.
+ Display restoreAfter: [ | sum p averagePressure now currentPressure |
- Display restoreAfter: [
  [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [
  "compute the average pressure over last historyMSecs milliseconds"
  now := Time millisecondClockValue.
  currentPressure := (20.0 * Sensor tabletPressure) rounded.
  pressureHistory addLast: (Array with: now with: currentPressure).
  [pressureHistory size > 0 and:
  [(pressureHistory first first + historyMSecs) < now]]
  whileTrue: [pressureHistory removeFirst].  "prune old entries"
  sum := pressureHistory inject: 0 into: [:t :e | t + e last].
  averagePressure := sum // pressureHistory size.
 
  p := (Sensor tabletPoint * tabletScale) rounded.
      averagePressure > 0
  ifTrue: [
  pen roundNib: averagePressure.
  pen goto: p]
  ifFalse: [
  pen place: p]]].
  !

Item was changed:
  ----- Method: Color>>mix:shades: (in category 'groups of shades') -----
  mix: color2 shades: thisMany
  "Return an array of thisMany colors from self to color2. Very useful for displaying color based on a variable in your program.  "
  "Color showColors: (Color red mix: Color green shades: 12)"
 
+ | redInc greenInc blueInc out rr gg bb |
- | redInc greenInc blueInc rr gg bb c out |
  thisMany = 1 ifTrue: [^ Array with: color2].
  redInc := color2 red - self red / (thisMany-1).
  greenInc := color2 green - self green / (thisMany-1).
  blueInc := color2 blue - self blue / (thisMany-1).
  rr := self red.  gg := self green.  bb := self blue.
+ out := (1 to: thisMany) collect: [:num | | c |
- out := (1 to: thisMany) collect: [:num |
  c := Color r: rr g: gg b: bb.
  rr := rr + redInc.
  gg := gg + greenInc.
  bb := bb + blueInc.
  c].
  out at: out size put: color2. "hide roundoff errors"
  ^ out
  !

Item was changed:
  ----- Method: Form>>store15To24HexBitsOn: (in category 'fileIn/Out') -----
  store15To24HexBitsOn:aStream
 
+ | buf lineWidth |
- | buf i lineWidth |
 
  "write data for 16-bit form, optimized for encoders writing directly to files to do one single file write rather than 12. I'm not sure I understand the significance of the shifting pattern, but I think I faithfully translated it from the original"
 
  lineWidth := 0.
  buf := String new: 12.
+ bits do: [:word | | i |
- bits do: [:word |
  i := 0.
  "upper pixel"
  buf at: (i := i + 1) put: ((word bitShift: -27) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -32) bitAnd: 8) asHexDigit.
 
  buf at: (i := i + 1) put: ((word bitShift: -22) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -27) bitAnd: 8) asHexDigit.
 
  buf at: (i := i + 1) put: ((word bitShift: -17) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -22) bitAnd: 8) asHexDigit.
 
  "lower pixel"
 
  buf at: (i := i + 1) put: ((word bitShift: -11) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -16) bitAnd: 8) asHexDigit.
 
  buf at: (i := i + 1) put: ((word bitShift: -6) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -11) bitAnd: 8) asHexDigit.
 
  buf at: (i := i + 1) put: ((word bitShift: -1) bitAnd: 15) asHexDigit.
  buf at: (i := i + 1) put: ((word bitShift: -6) bitAnd: 8) asHexDigit.
  aStream nextPutAll: buf.
  lineWidth := lineWidth + 12.
  lineWidth > 100 ifTrue: [ aStream cr. lineWidth := 0 ].
  "#( 31 26 21 15 10 5 )  do:[:startBit | ]"
  ].!

Item was changed:
  ----- Method: Form>>rotateBy:magnify:smoothing: (in category 'scaling, rotation') -----
  rotateBy: deg magnify: scale smoothing: cellSize
  "Rotate the receiver by the indicated number of degrees and magnify. scale can be a Point to make for interesting 3D effects "
  "rot is the destination form, big enough for any angle."
 
+ | side rot warp r1 pts bigSide |
- | side rot warp r1 pts p bigSide |
  side := 1 + self extent r asInteger.
  bigSide := (side asPoint * scale) rounded.
  rot := self blankCopyOf: self boundingBox scaledBy: ( bigSide / self extent ).
  warp := (WarpBlt current toForm: rot)
  sourceForm: self;
  colorMap: (self colormapIfNeededFor: rot);
  cellSize: cellSize;  "installs a new colormap if cellSize > 1"
  combinationRule: Form paint.
  r1 := (0@0 extent: side@side) align: (side@side)//2 with: self boundingBox center.
 
  "Rotate the corners of the source rectangle."
  pts := r1 innerCorners collect:
+ [:pt | | p |
+ p := pt - r1 center.
- [:pt | p := pt - r1 center.
  (r1 center x asFloat + (p x asFloat*deg degreeCos) + (p y asFloat*deg degreeSin)) @
  (r1 center y asFloat - (p x asFloat*deg degreeSin) + (p y asFloat*deg degreeCos))].
  warp copyQuad: pts toRect: rot boundingBox.
  ^ rot
  "
   | a f |  f := Form fromDisplay: (0@0 extent: 200@200).  a := 0.
  [Sensor anyButtonPressed] whileFalse:
  [((Form fromDisplay: (Sensor cursorPoint extent: 130@66))
  rotateBy: (a := a+5) magnify: 0.75@2 smoothing: 2) display].
  f display
  "!

Item was changed:
  ----- Method: Form>>copyWithColorsReducedTo: (in category 'converting') -----
  copyWithColorsReducedTo: nColors
  "Note: this has not been engineered.
  There are better solutions in the literature."
+ | palette colorMap |
- | palette colorMap pc closest |
  palette := self reducedPaletteOfSize: nColors.
  colorMap := (1 to: (1 bitShift: depth)) collect:
+ [:i | | pc closest |
+ pc := Color colorFromPixelValue: i-1 depth: depth.
- [:i | pc := Color colorFromPixelValue: i-1 depth: depth.
  closest := palette detectMin: [:c | c diff: pc].
  closest pixelValueForDepth: depth].
  ^ self deepCopy copyBits: self boundingBox from: self at: 0@0 colorMap: (colorMap as: Bitmap)
  !

Item was changed:
  ----- Method: PNGReadWriter>>copyPixelsIndexed:at:by: (in category 'pixel copies') -----
  copyPixelsIndexed: y at: startX by: incX
  "Handle interlaced indexed color mode (colorType = 3)"
 
+ | offset bits pixPerByte shifts blitter pixel mask pixelNumber |
- | offset b bits w pixel mask pixPerByte shifts blitter pixelNumber rawByte |
  offset := y*rowSize+1.
  bits := form bits.
  bitsPerChannel = 8
  ifTrue: [
+ startX to: width-1 by: incX do: [ :x | | b w |
- startX to: width-1 by: incX do: [ :x |
  w := offset + (x>>2).
  b := 3 - (x \\ 4) * 8.
  pixel := (thisScanline at: x // incX + 1)<<b.
  mask := (255<<b) bitInvert32.
  bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)].
  ^ self ].
  bitsPerChannel = 1 ifTrue: [
  pixPerByte := 8.
  mask := 1.
  shifts := #(7 6 5 4 3 2 1 0).
  ].
  bitsPerChannel = 2 ifTrue: [
  pixPerByte := 4.
  mask := 3.
  shifts := #(6 4 2 0).
  ].
  bitsPerChannel = 4 ifTrue: [
  pixPerByte := 2.
  mask := 15.
  shifts := #(4 0).
  ].
 
  blitter := BitBlt current bitPokerToForm: form.
  pixelNumber := 0.
+ startX to: width-1 by: incX do: [ :x | | rawByte |
- startX to: width-1 by: incX do: [ :x |
  rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
  pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
  blitter pixelAt: (x@y) put: pixel.
  pixelNumber := pixelNumber + 1.
  ].
  !

Item was changed:
  ----- Method: Pen class>>testMouseTracking (in category 'tablet drawing examples') -----
  testMouseTracking
  "A very simple example of drawing using the mouse. Compare the tracking speed of this example with that of testTabletTracking. Mouse down to draw a stroke, shift-mouse to exit."
  "Pen testMouseTracking"
 
+ | pen |
- | pen p |
  pen := Pen newOnForm: Display.
  pen roundNib: 8.
  pen color: Color black.
  Display fillColor: Color white.
+ Display restoreAfter: [ | p |
- Display restoreAfter: [
  [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [
  p := Sensor cursorPoint.
      Sensor anyButtonPressed
  ifTrue: [pen goto: p]
  ifFalse: [
  pen color: Color random.
  pen place: p]]].
  !

Item was changed:
  ----- Method: TextStyle class>>fontMenuForStyle:target:selector:highlight: (in category 'user interface') -----
  fontMenuForStyle: styleName target: target selector: selector highlight: currentFont
  "Offer a font menu for the given style. If one is selected, pass
  that font to target with a  
  call to selector. The fonts will be displayed in that font."
+ | aMenu |
- | aMenu displayFont |
  aMenu := MenuMorph entitled: styleName.
  (TextStyle named: styleName)
  ifNotNil: [:s | s isTTCStyle
  ifTrue: [aMenu
  add: 'New Size'
  target: self
  selector: #chooseTTCFontSize:
  argument: {styleName. target. selector}]].
  (self pointSizesFor: styleName)
  do: [:pointSize |
+ | font subMenu displayFont |
- | font subMenu |
  font := (self named: styleName)
  fontOfPointSize: pointSize.
  subMenu := self
  emphasisMenuForFont: font
  target: target
  selector: selector
  highlight: (currentFont
  ifNotNil: [:cf | (cf familyName = styleName
  and: [cf pointSize = font pointSize])
  ifTrue: [currentFont emphasis]]).
  subMenu
  ifNil: [aMenu
  add: pointSize asString , ' Point'
  target: target
  selector: selector
  argument: font]
  ifNotNil: [aMenu add: pointSize asString , ' Point' subMenu: subMenu].
  displayFont := font.
  (font isSymbolFont or:[(font hasDistinctGlyphsForAll: pointSize asString , ' Point') not])
  ifTrue:[
  "don't use a symbol font to display its own name!!!!"
  displayFont := self default fontOfPointSize: pointSize].
  aMenu lastItem font: displayFont.
  currentFont
  ifNotNil: [:cf | (cf familyName = styleName
  and: [cf pointSize = font pointSize])
  ifTrue: [aMenu lastItem color: Color blue darker]]].
  ^ aMenu!

Item was changed:
  ----- Method: StrikeFont class>>fromUser:allowKeyboard: (in category 'instance creation') -----
  fromUser: priorFont allowKeyboard: aBoolean "StrikeFont fromUser"
  "Present a menu of available fonts, and if one is chosen, return it.
  Otherwise return nil. Using ToolBuilder for added abstraction."
+ | fontList fontMenu font builder resultBlock widget style result item |
- | fontList fontMenu style active ptMenu label font builder resultBlock result item widget |
  builder := ToolBuilder default.
  fontList := StrikeFont actualFamilyNames.
  fontMenu := builder pluggableMenuSpec new.
  resultBlock := [:value| result := value].
+ fontList do: [:fontName | | active ptMenu |
- fontList do: [:fontName |
  style := TextStyle named: fontName.
  active := priorFont familyName sameAs: fontName.
  ptMenu := builder pluggableMenuSpec new.
+ style pointSizes do: [:pt | | label |
- style pointSizes do: [:pt |
  label := pt printString, ' pt'.
  item := ptMenu add: label
  target: resultBlock
  selector: #value:
  argumentList: {{fontName. pt}}.
  item checked: (active and:[pt = priorFont pointSize]).
  ].
  style isTTCStyle ifTrue: [
  ptMenu add: 'new size'
  target: style
  selector: #addNewFontSizeDialog:
  argumentList: {{fontName. fontMenu}}.
  ].
  item := fontMenu add: fontName action: nil.
  item subMenu: ptMenu.
  item checked: active.
  ].
  TTFileDescription offerNonPortableFonts ifTrue:[
  fontMenu addSeparator.
  item := fontMenu add: 'More (non-portable) Fonts...'
  target: resultBlock
  selector: #value:
  argumentList: #(TTFileDescription).
  ].
  widget := builder open: fontMenu.
  builder runModal: widget.
  result ifNil:[^nil].
  "Pick a non-portable font if requested"
  result == #TTFileDescription ifTrue:[
  ^Smalltalk at: #TTFileDescription ifPresent:[:ttf|
  ttf fontFromUser: priorFont allowKeyboard: aBoolean]].
  style := TextStyle named: result first.
  style ifNil: [^ self].
  font := style fonts detect: [:any | any pointSize = result last] ifNone: [nil].
  ^ font!

Item was changed:
  ----- Method: Form>>zoomIn:orOutTo:at:vanishingPoint: (in category 'transitions') -----
  zoomIn: goingIn orOutTo: otherImage at: topLeft vanishingPoint: vp
  "Display zoomInTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40.
  Display zoomOutTo: (Form fromDisplay: (40@40 extent: 300@300)) reverse at: 40@40."
+ | nSteps minTime startTime |
- | nSteps j bigR lilR minTime startTime lead |
  nSteps := 16.
  minTime := 500.  "milliseconds"
  startTime := Time millisecondClockValue.
  ^ self wipeImage: otherImage at: topLeft clippingBox: nil rectForIndex:
+ [:i | | lead bigR j lilR | "i runs from 1 to nsteps"
- [:i | "i runs from 1 to nsteps"
  i > nSteps
  ifTrue: [nil "indicates all done"]
  ifFalse:
  ["If we are going too fast, delay for a bit"
  lead := startTime + (i-1*minTime//nSteps) - Time millisecondClockValue.
  lead > 10 ifTrue: [(Delay forMilliseconds: lead) wait].
 
  "Return an array with the difference rectangles for this step."
  j := goingIn ifTrue: [i] ifFalse: [nSteps+1-i].
  bigR := vp - (vp*(j)//nSteps) corner:
  vp + (otherImage extent-vp*(j)//nSteps).
  lilR := vp - (vp*(j-1)//nSteps) corner:
  vp + (otherImage extent-vp*(j-1)//nSteps).
  bigR areasOutside: lilR]]!

Item was changed:
  ----- Method: DisplayObject>>slideFrom:to:nSteps:delay:andStay: (in category 'displaying-Display') -----
  slideFrom: startPoint to: stopPoint nSteps: nSteps delay: milliSecs andStay: stayAtEnd
  "Does not display at the first point, but does at the last.
  Moreover, if stayAtEnd is true, it leaves the dragged image at the stopPoint"
+ | i |
- | i done |
  i := 0.
  ^ self follow: [startPoint + ((stopPoint-startPoint) * i // nSteps)]
+ while: [ | done |
+ milliSecs ifNotNil: [(Delay forMilliseconds: milliSecs) wait].
- while: [milliSecs ifNotNil: [(Delay forMilliseconds: milliSecs) wait].
  ((done := (i := i+1) > nSteps) and: [stayAtEnd])
  ifTrue: [^ self "Return without clearing the image"].
  done not]!

Item was changed:
  ----- Method: ImageReadWriter class>>formFromServerFile: (in category 'image reading/writing') -----
  formFromServerFile: fileName
  "Answer a ColorForm stored on the file with the given name.  Meant to be called from during the getting of updates from the server.  That assures that (Utilities serverUrls) returns the right group of servers."
 
+ | urls |
- | form urls doc |
  urls := Utilities serverUrls collect:
  [:url | url, fileName].  " fileName starts with: 'updates/'  "
+ urls do: [:aURL | | form doc |
- urls do: [:aURL |
  (fileName findTokens: '.') last asLowercase = 'gif' ifTrue: [
  form := HTTPSocket httpGif: aURL.
  form = (ColorForm extent: 20@20 depth: 8)
  ifTrue: [self inform: 'The file ',aURL,' is ill formed.'].
  ^ form].
  (fileName findTokens: '.') last asLowercase = 'bmp' ifTrue: [
  doc := HTTPSocket httpGet: aURL accept: 'image/bmp'.
  form := Form fromBMPFile: doc.
  doc close.
  form ifNil: [self inform: 'The file ',aURL,' is ill formed.'. ^ Form new]
  ifNotNil: [^ form]].
  self inform: 'File ', fileName, 'does not end with .gif or .bmp'].
  self inform: 'That file not found on any server we know'.!

Item was changed:
  ----- Method: Color class>>colorTest:extent:colorMapper: (in category 'color from user') -----
  colorTest: depth extent: chartExtent colorMapper: colorMapper
  "Create a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
  "Note: It is slow to build this palette, so it should be cached for quick access."
  "(Color colorTest: 32 extent: 570@180 colorMapper: [:c | c]) display"
  "(Color colorTest: 32 extent: 570@180 colorMapper:
  [:c | Color
  r: (c red * 7) asInteger / 7
  g: (c green * 7) asInteger / 7
  b: (c blue * 3) asInteger / 3]) display"
  "(Color colorTest: 32 extent: 570@180 colorMapper:
  [:c | Color
  r: (c red * 5) asInteger / 5
  g: (c green * 5) asInteger / 5
  b: (c blue * 5) asInteger / 5]) display"
  "(Color colorTest: 32 extent: 570@180 colorMapper:
  [:c | Color
  r: (c red * 15) asInteger / 15
  g: (c green * 15) asInteger / 15
  b: (c blue * 15) asInteger / 15]) display"
  "(Color colorTest: 32 extent: 570@180 colorMapper:
  [:c | Color
  r: (c red * 31) asInteger / 31
  g: (c green * 31) asInteger / 31
  b: (c blue * 31) asInteger / 31]) display"
 
+ | startHue palette transHt vSteps transCaption grayWidth hSteps y c x |
- | basicHue x y c startHue palette transHt vSteps transCaption grayWidth hSteps |
  palette := Form extent: chartExtent depth: depth.
  transCaption := "(DisplayText text: 'no color' asText textStyle: (TextConstants at: #ComicPlain)) form storeString"
  (Form extent: 34@9 depth: 1
  fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
  offset: 0@0).
  transHt := transCaption height.
  palette fillWhite: (0@0 extent: palette width@transHt).
  palette fillBlack: (0@transHt extent: palette width@1).
  transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
  grayWidth := 10.
  startHue := 338.0.
  vSteps := palette height - transHt // 2.
  hSteps := palette width - grayWidth.
  x := 0.
+ startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h | | basicHue |
- startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h |
  basicHue := Color h: h asFloat s: 1.0 v: 1.0.
  y := transHt+1.
  0 to: vSteps do: [:n |
    c := basicHue mixed: (n asFloat / vSteps asFloat) with: Color white.
  c := colorMapper value: c.
  palette fill: (x@y extent: 1@1) fillColor: c.
  y := y + 1].
  1 to: vSteps do: [:n |
    c := Color black mixed: (n asFloat / vSteps asFloat) with: basicHue.
  c := colorMapper value: c.
  palette fill: (x@y extent: 1@1) fillColor: c.
  y := y + 1].
  x := x + 1].
  y := transHt + 1.
  1 to: vSteps * 2 do: [:n |
    c := Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white.
  c := colorMapper value: c.
  palette fill: (x@y extent: 10@1) fillColor: c.
  y := y + 1].
  ^ palette
  !

Item was changed:
  ----- Method: BitBlt class>>benchmark3 (in category 'benchmarks') -----
  benchmark3 "BitBlt benchmark"
  "Run a benchmark on different combinations rules, source/destination depths and BitBlt modes. Note: This benchmark doesn't give you any 'absolute' value - it is intended only for benchmarking improvements in the bitblt code and nothing else.
  Attention: *this*may*take*a*while*"
+ | destRect log |
- | bb source dest destRect log t |
  log := WriteStream on: String new.
  destRect := 0@0 extent: 600@600.
  "Form paint/Form over - the most common rules"
  #( 25 3 ) do:[:rule|
  Transcript cr; show:'---- Combination rule: ', rule printString,' ----'.
  log cr; nextPutAll:'---- Combination rule: ', rule printString,' ----'.
+ #(1 2 4 8 16 32) do:[:destDepth| | dest |
- #(1 2 4 8 16 32) do:[:destDepth|
  dest := nil.
  dest := Form extent: destRect extent depth: destDepth.
  Transcript cr.
  log cr.
+ #(1 2 4 8 16 32) do:[:sourceDepth| | t source bb |
- #(1 2 4 8 16 32) do:[:sourceDepth|
  Transcript cr; show: sourceDepth printString, ' => ', destDepth printString.
  log cr; nextPutAll: sourceDepth printString, ' => ', destDepth printString.
  source := nil. bb := nil.
  source := Form extent: destRect extent depth: sourceDepth.
  (source getCanvas) fillOval: dest boundingBox color: Color yellow borderWidth: 30 borderColor: Color black.
  bb := WarpBlt toForm: dest.
  bb sourceForm: source.
  bb sourceRect: source boundingBox.
  bb destRect: dest boundingBox.
  bb colorMap: (source colormapIfNeededFor: dest).
  bb combinationRule: rule.
 
  "Measure speed of copyBits"
  t := Time millisecondsToRun:[1 to: 10 do:[:i| bb copyBits]].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  bb sourceForm: source destRect: source boundingBox.
 
  "Measure speed of 1x1 warpBits"
  bb cellSize: 1.
  t := Time millisecondsToRun:[1 to: 4 do:[:i| bb warpBits]].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 2x2 warpBits"
  bb cellSize: 2.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
 
  "Measure speed of 3x3 warpBits"
  bb cellSize: 3.
  t := Time millisecondsToRun:[bb warpBits].
  Transcript tab; show: t printString.
  log tab; nextPutAll: t printString.
  ].
  ].
  ].
  ^log contents!

Item was changed:
  ----- Method: Pen class>>simplePressurePen (in category 'tablet drawing examples') -----
  simplePressurePen
  "An example of using a pressure sensitive pen to control the thickness of the pen. This requires the optional tablet support primitives which may not be supported on all platforms. Works best in full screen mode. Shift-mouse to exit."
  "Pen simplePressurePen"
 
+ | tabletScale pen |
- | tabletScale pen pressure p |
  tabletScale := self tabletScaleFactor.
  pen := Pen newOnForm: Display.
  pen color: Color black.
  Display fillColor: Color white.
+ Display restoreAfter: [ | p pressure |
- Display restoreAfter: [
  [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [
  p := (Sensor tabletPoint * tabletScale) rounded.
  pressure := (15.0 * Sensor tabletPressure) rounded.
      pressure > 0
  ifTrue: [
  pen roundNib: pressure.
  pen goto: p]
  ifFalse: [
  pen place: p]]].
  !

Item was changed:
  ----- Method: DisplayScreen>>forceDamageToScreen: (in category 'displaying') -----
  forceDamageToScreen: allDamage
  "Force all the damage rects to the screen."
+ | regions rectList |
- | rectList excluded remaining regions |
  rectList := allDamage.
  "Note: Reset extra regions at the beginning to prevent repeated errors"
  regions := extraRegions.
  extraRegions := nil.
  regions ifNotNil:[
  "exclude extra regions"
+ regions do:[:drawerAndRect| | excluded remaining |
- regions do:[:drawerAndRect|
  excluded := drawerAndRect at: 2.
  remaining := WriteStream on: #().
  rectList do:[:r|
  remaining nextPutAll:(r areasOutside: excluded)].
  rectList := remaining contents].
  ].
  rectList do:[:r| self forceToScreen: r].
  regions ifNotNil:[
  "Have the drawers paint what is needed"
  regions do:[:drawerAndRect| (drawerAndRect at: 1) forceToScreen].
  ].!

Item was changed:
  ----- Method: Color class>>fromString: (in category 'instance creation') -----
  fromString: aString
  "for HTML color spec: #FFCCAA or white/black"
  "Color fromString: '#FFCCAA'.
  Color fromString: 'white'.
  Color fromString: 'orange'"
+ | aColorHex |
- | aColorHex red green blue |
  aString isEmptyOrNil ifTrue: [^ Color white].
  aString first = $#
  ifTrue: [aColorHex := aString copyFrom: 2 to: aString size]
  ifFalse: [aColorHex := aString].
+ [ | green red blue |
+ aColorHex size = 6
- [aColorHex size = 6
  ifTrue:
  [aColorHex := aColorHex asUppercase.
  red := ('16r', (aColorHex copyFrom: 1 to: 2)) asNumber/255.
  green := ('16r', (aColorHex copyFrom: 3 to: 4)) asNumber/255.
  blue := ('16r', (aColorHex copyFrom: 5 to: 6)) asNumber/255.
  ^ self r: red g: green b: blue]]
  ifError: [:err :rcvr | "not a hex color triplet" ].
 
  "try to match aColorHex with known named colors"
  aColorHex := aColorHex asLowercase.
 
  ^self perform: (ColorNames detect: [:i | i asString asLowercase = aColorHex]
  ifNone: [#white])!

Item was changed:
  ----- Method: BDFFontReader class>>convertFilesNamed:toFamilyNamed:inDirectoryNamed: (in category 'file creation') -----
  convertFilesNamed: fileName toFamilyNamed: familyName inDirectoryNamed: dirName
  "BDFFontReader convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: '' "
 
  "This utility converts X11 BDF font files to Squeak .sf2 StrikeFont files."
 
  "For this utility to work as is, the BDF files must be named 'familyNN.bdf',
  and must reside in the directory named by dirName (use '' for the current directory).
  The output StrikeFont files will be named familyNN.sf2, and will be placed in the
  current directory."
 
+ | allFontNames dir |
- | f allFontNames sizeChars dir |
  "Check for matching file names."
  dir := dirName isEmpty
  ifTrue: [FileDirectory default]
  ifFalse: [FileDirectory default directoryNamed: dirName].
  allFontNames := dir fileNamesMatching: fileName , '##.bdf'.
  allFontNames isEmpty ifTrue: [^ self error: 'No files found like ' , fileName , 'NN.bdf'].
 
  Utilities informUserDuring: [:info |
+ allFontNames do: [:fname | | f sizeChars |
- allFontNames do: [:fname |
  info value: 'Converting ', familyName, ' BDF file ', fname, ' to SF2 format'.
  sizeChars := (fname copyFrom: fileName size + 1 to: fname size) copyUpTo: $. .
 
  f := StrikeFont new readBDFFromFile: (dir fullNameFor: fname) name: familyName, sizeChars.
  f writeAsStrike2named: familyName, sizeChars, '.sf2'.
  ].
  ]!

Item was changed:
  ----- Method: BDFFontReader class>>downloadFonts (in category 'resource download') -----
  downloadFonts  "BDFFontReader downloadFonts"
  "Download a standard set of BDF sources from x.org.  
  The combined size of these source files is around 1.2M; after conversion
  to .sf2 format they may be deleted."
 
+ | heads tails filenames baseUrl basePath |
- | heads tails filenames baseUrl basePath newUrl newPath document f |
  heads := #( 'charR' 'courR' 'helvR' 'lubR' 'luRS' 'lutRS' 'ncenR' 'timR' ).
  tails := #( '08' '10' '12' '14' '18' '24').
 
  filenames := OrderedCollection new.
  heads do: [:head |
  filenames addAll: (tails collect: [:tail | head , tail , '.bdf'])
  ].
 
  baseUrl := Url absoluteFromText: 'http://ftp.x.org/pub/R6.4/xc/fonts/bdf/75dpi/'.
  basePath := baseUrl path.
 
+ filenames do: [:filename | | document f newPath newUrl |
- filenames do: [:filename |
  newUrl := baseUrl clone.
  newPath := OrderedCollection newFrom: basePath.
 
  newPath addLast: filename.
  newUrl path: newPath.
 
  Utilities informUser: 'Fetching ' , filename during:
  [document := newUrl retrieveContents].
 
  f := CrLfFileStream newFileNamed: filename.
  f nextPutAll: document content.
  f close.
  ].
  !

Item was changed:
  ----- Method: JPEGReadWriter>>decompressionTest (in category 'public access') -----
  decompressionTest
  "Test decompression; don't generate actual image"
+
+ MessageTally spyOn:[ | x xStep yStep y |
- | xStep yStep x y |
- MessageTally spyOn:[
  ditherMask := DitherMasks at: 32.
  residuals := WordArray new: 3.
  sosSeen := false.
  self parseFirstMarker.
  [sosSeen] whileFalse: [self parseNextMarker].
  xStep := mcuWidth * DCTSize.
  yStep := mcuHeight * DCTSize.
  y := 0.
  1 to: mcuRowsInScan do:
  [:row |
  x := 0.
  1 to: mcusPerRow do:
  [:col |
  self decodeMCU.
  self idctMCU.
  self colorConvertMCU.
  x := x + xStep].
  y := y + yStep].
  ].!

Item was changed:
  ----- Method: PNMReadWriter>>readHeaderPAM (in category 'reading') -----
  readHeaderPAM
  "read pam header, not tested"
+ | loop |
- | loop line tokens key val |
  tupleType := ''.
  loop := true.
+ loop whileTrue:[ | key val tokens line |
- loop whileTrue:[
  line := self pbmGetLine.
  tokens := line findTokens: ' '.
  tokens size = 2 ifTrue:[
  key := tokens at: 1 asUppercase.
  val := tokens at: 2.
  key caseOf: {
  ['WIDTH'] -> [cols := val asInteger].
  ['HEIGHT'] -> [rows := val asInteger].
  ['DEPTH'] -> [depth := val asInteger].
  ['MAXVAL'] -> [maxValue := val asInteger].
  ['TUPLETYPE'] -> [tupleType := tupleType, ' ', val].
  ['ENDHDR'] -> [loop := false].
  }
  ]
  ].
  Transcript cr; show: 'PAM file class ', type asString, ' size ', cols asString, ' x ',
  rows asString, ' maxValue =', maxValue asString, ' depth=', depth asString.
  !

Item was changed:
  ----- Method: StrikeFont>>characters:in:displayAt:clippedBy:rule:fillColor:kernDelta:on: (in category 'displaying') -----
  characters: anInterval in: sourceString displayAt: aPoint clippedBy: clippingRectangle rule: ruleInteger fillColor: aForm kernDelta: kernDelta on: aBitBlt
  "Simple, slow, primitive method for displaying a line of characters.
  No wrap-around is provided."
+ | destPoint |
- | ascii destPoint leftX rightX sourceRect |
  destPoint := aPoint.
  anInterval do:
+ [:i | | sourceRect leftX ascii rightX |
- [:i |
  self flag: #yoDisplay.
  "if the char is not supported, fall back to the specified fontset."
  ascii := (sourceString at: i) charCode.
  (ascii < minAscii or: [ascii > maxAscii])
  ifTrue: [ascii := maxAscii].
  leftX := xTable at: ascii + 1.
  rightX := xTable at: ascii + 2.
  sourceRect := leftX@0 extent: (rightX-leftX) @ self height.
  aBitBlt copyFrom: sourceRect in: glyphs to: destPoint.
  destPoint := destPoint + ((rightX-leftX+kernDelta)@0).
  "destPoint printString displayAt: 0@(i*20)"].
  ^ destPoint!

Item was changed:
  ----- Method: HostFont>>testEmbeddingFlags (in category 'accessing') -----
  testEmbeddingFlags
  "HostFont basicNew testEmbeddingFlags"
+ | list |
- | list fontHandle |
  list := self class listFontNames.
+ list do:[:fName| | fontHandle |
- list do:[:fName|
  fontHandle := self primitiveCreateFont: fName size: 12 emphasis: 0.
  fontHandle ifNotNil:[
  type := self primitiveFontEmbeddingFlags: fontHandle.
  Transcript cr; show: fName,': ', type printString.
  self primitiveDestroyFont: fontHandle.
  ].
  ].!

Item was changed:
  ----- Method: PNGReadWriter>>copyPixelsGray:at:by: (in category 'pixel copies') -----
  copyPixelsGray: y at: startX by: incX
  "Handle interlaced grayscale color mode (colorType = 0)"
 
+ | offset bits blitter pixPerByte shifts b pixel mask pixelNumber |
- | b offset bits w pixel mask blitter pixelNumber pixPerByte rawByte
- shifts |
  bitsPerChannel = 16
  ifTrue: [
  b := BitBlt current bitPokerToForm: form.
  startX to: width-1 by: incX do: [ :x |
  b pixelAt: x@y put: 255 - (thisScanline at: (x//incX<<1)+1).
  ].
  ^ self
  ].
  offset := y*rowSize+1.
  bits := form bits.
  bitsPerChannel = 8 ifTrue: [
+ startX to: width-1 by: incX do: [ :x | | w |
- startX to: width-1 by: incX do: [ :x |
  w := offset + (x>>2).
  b := 3- (x \\ 4) * 8.
  pixel := (thisScanline at: x // incX + 1)<<b.
  mask := (255<<b) bitInvert32.
  bits at: w put: (((bits at: w) bitAnd: mask) bitOr: pixel)
  ].
  ^ self
  ].
  bitsPerChannel = 1 ifTrue: [
  pixPerByte := 8.
  mask := 1.
  shifts := #(7 6 5 4 3 2 1 0).
  ].
  bitsPerChannel = 2 ifTrue: [
  pixPerByte := 4.
  mask := 3.
  shifts := #(6 4 2 0).
  ].
  bitsPerChannel = 4 ifTrue: [
  pixPerByte := 2.
  mask := 15.
  shifts := #(4 0).
  ].
 
  blitter := BitBlt current bitPokerToForm: form.
  pixelNumber := 0.
+ startX to: width-1 by: incX do: [ :x | | rawByte |
- startX to: width-1 by: incX do: [ :x |
  rawByte := thisScanline at: (pixelNumber // pixPerByte) + 1.
  pixel := (rawByte >> (shifts at: (pixelNumber \\ pixPerByte) + 1)) bitAnd: mask.
  blitter pixelAt: (x@y) put: pixel.
  pixelNumber := pixelNumber + 1.
  ].
  !

Item was changed:
  ----- Method: Color class>>computeIndexedColorConvertingMap:from:to: (in category 'colormaps') -----
  computeIndexedColorConvertingMap: targetColor from: sourceDepth to: destDepth
+ | map |
- | map f c |
 
+ map _ (IndexedColors copyFrom: 1 to: (1 bitShift: sourceDepth)) collect: [ :cc | | f c |
- map _ (IndexedColors copyFrom: 1 to: (1 bitShift: sourceDepth)) collect: [ :cc |
  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!

Item was changed:
  ----- Method: TextStyle>>collectionFromFileNamed: (in category 'fonts and font indexes') -----
  collectionFromFileNamed: fileName
  "Read the file.  It is an TextStyle whose StrikeFonts are to be added to the system.  (Written by fooling SmartRefStream, so it won't write a DiskProxy!!)  These fonts will be added to the master TextSytle for this font family.  
  To write out fonts:
  | ff | ff := ReferenceStream fileNamed: 'new fonts'.
  TextConstants at: #forceFontWriting put: true.
  ff nextPut: (TextConstants at: #AFontName).
  'do not mix font families in the TextStyle written out'.
  TextConstants at: #forceFontWriting put: false.
  ff close.
 
  To read: (TextStyle default collectionFromFileNamed: 'new fonts')
  *** Do not remove this method *** "
 
+ | ff this newName style |
- | ff this newName style heights |
  ff := ReferenceStream fileNamed: fileName.
  this := ff nextAndClose. "Only works if file created by special code above"
  newName := this fontArray first familyName.
  this fontArray do: [:aFont | aFont familyName = newName ifFalse: [
  self error: 'All must be same family']].
  style := TextConstants at: newName asSymbol ifAbsent: [
  ^ TextConstants at: newName asSymbol put: this]. "new family"
+ this fontArray do: [:aFont | | heights | "add new fonts"
- this fontArray do: [:aFont | "add new fonts"
  heights := style fontArray collect: [:bFont | bFont height].
  (heights includes: aFont height) ifFalse: [
  style fontAt: style fontArray size + 1 put: aFont]].
  !

Item was changed:
  ----- Method: Pen class>>testTabletTracking (in category 'tablet drawing examples') -----
  testTabletTracking
  "A very simple example of drawing using the pen of a digitizing tablet such as a Wacom ArtZ tablet. This requires the optional tablet support primitives which may not be supported on all platforms. Compare the tracking speed of this example with that of testMouseTracking. On a Macintosh, the tablet primitives provide roughly 120 samples/second versus only 60 mouse samples/second, and the difference is noticable. Works best in full screen mode. Mouse down to draw a stroke, shift-mouse to exit."
  "Pen testTabletTracking"
 
+ | tabletScale pen |
- | tabletScale pen p |
  tabletScale := self tabletScaleFactor.
  pen := Pen newOnForm: Display.
  pen roundNib: 8.
  pen color: Color black.
  Display fillColor: Color white.
+ Display restoreAfter: [ | p |
- Display restoreAfter: [
  [Sensor shiftPressed and: [Sensor anyButtonPressed]] whileFalse: [
  p := (Sensor tabletPoint * tabletScale) rounded.
      Sensor tabletPressure > 0
  ifTrue: [pen goto: p]
  ifFalse: [
  pen color: Color random.
  pen place: p]]].
  !