The Trunk: GraphicsTests-pre.55.mcz

Patrick Rein uploaded a new version of GraphicsTests to project The Trunk:
http://source.squeak.org/trunk/GraphicsTests-pre.55.mcz

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

Name: GraphicsTests-pre.55
Author: pre
Time: 24 August 2020, 3:04:18.602786 pm
UUID: 8459435a-1c95-9b46-a745-32f6d373c6a5
Ancestors: GraphicsTests-eem.54

Recategorizes methods throughout the package and improves two test cases which did only state the assertion in a comment.

=============== Diff against GraphicsTests-eem.54 ===============

Item was changed:
+ ----- Method: BMPReadWriterTest>>testBmp16Bit (in category 'tests') -----
- ----- Method: BMPReadWriterTest>>testBmp16Bit (in category 'reading') -----
  testBmp16Bit
  | reader form |
  reader := BMPReadWriter new on: (ReadStream on: self bmpData16bit).
  form := reader nextImage.
  "special black here to compensate for zero-is-transparent effect"
  self assert: (form colorAt: 7@1) = Color red.
  self assert: (form colorAt: 1@7) = Color green.
  self assert: (form colorAt: 7@7) = Color blue.
  self assert: (form colorAt: 4@4) = Color white.
  self assert: (form pixelValueAt: 1@1) = 16r8000.
  !

Item was changed:
+ ----- Method: BMPReadWriterTest>>testBmp24Bit (in category 'tests') -----
- ----- Method: BMPReadWriterTest>>testBmp24Bit (in category 'reading') -----
  testBmp24Bit
  | reader form |
  reader := BMPReadWriter new on: (ReadStream on: self bmpData24bit).
  form := reader nextImage.
  self assert: (form colorAt: 7@1) = Color red.
  self assert: (form colorAt: 1@7) = Color green.
  self assert: (form colorAt: 7@7) = Color blue.
  self assert: (form colorAt: 4@4) = Color white.
  self assert: (form pixelValueAt: 1@1) = 16rFF000001.
  !

Item was changed:
+ ----- Method: BMPReadWriterTest>>testBmp32Bit (in category 'tests') -----
- ----- Method: BMPReadWriterTest>>testBmp32Bit (in category 'reading') -----
  testBmp32Bit
  | reader form |
  reader := BMPReadWriter new on: (ReadStream on: self bmpData32bit).
  form := reader nextImage.
  self assert: (form colorAt: 7@1) = Color red.
  self assert: (form colorAt: 1@7) = Color green.
  self assert: (form colorAt: 7@7) = Color blue.
  self assert: (form colorAt: 4@4) = Color white.
  self assert: (form pixelValueAt: 1@1) = 16rFF000000.
  !

Item was changed:
+ ----- Method: BMPReadWriterTest>>testBmp4Bit (in category 'tests') -----
- ----- Method: BMPReadWriterTest>>testBmp4Bit (in category 'reading') -----
  testBmp4Bit
  | reader form |
  reader := BMPReadWriter new on: (ReadStream on: self bmpData4bit).
  form := reader nextImage.
  self assert: (form colorAt: 1@1) = Color black.
  self assert: (form colorAt: 7@1) = Color red.
  self assert: (form colorAt: 1@7) = Color green.
  self assert: (form colorAt: 7@7) = Color blue.
  self assert: (form colorAt: 4@4) = Color white.
  !

Item was changed:
+ ----- Method: BMPReadWriterTest>>testBmp8Bit (in category 'tests') -----
- ----- Method: BMPReadWriterTest>>testBmp8Bit (in category 'reading') -----
  testBmp8Bit
  | reader form |
  reader := BMPReadWriter new on: (ReadStream on: self bmpData8bit).
  form := reader nextImage.
  self assert: (form colorAt: 1@1) = Color black.
  self assert: (form colorAt: 7@1) = Color red.
  self assert: (form colorAt: 1@7) = Color green.
  self assert: (form colorAt: 7@7) = Color blue.
  self assert: (form colorAt: 4@4) = Color white.
  !

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbAdd (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbAdd (in category 'bugs') -----
  testAllAlphasRgbAdd
  "self run: #testAllAlphasRgbAdd"
  | sourceForm destForm blt correctAlphas |
  <timeout: 15>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 20. "rgbAdd"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha + sourceAlpha min: 255)
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbMax (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbMax (in category 'bugs') -----
  testAllAlphasRgbMax
  "self run: #testAllAlphasRgbMax"
  | sourceForm destForm blt correctAlphas |
  <timeout: 10>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 27. "rgbMax"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha max: sourceAlpha)
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbMin (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbMin (in category 'bugs') -----
  testAllAlphasRgbMin
  "self run: #testAllAlphasRgbMin"
  | sourceForm destForm blt correctAlphas |
  <timeout: 10>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 28. "rgbMin"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: sourceAlpha)
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbMinInvert (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbMinInvert (in category 'bugs') -----
  testAllAlphasRgbMinInvert
  "self run: #testAllAlphasRgbMinInvert"
  | sourceForm destForm blt correctAlphas |
  <timeout: 10>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 29. "rgbMinInvert"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: 255-sourceAlpha)
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbMul (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbMul (in category 'bugs') -----
  testAllAlphasRgbMul
  "self run: #testAllAlphasRgbMul"
  | sourceForm destForm blt correctAlphas |
  <timeout: 10>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 37. "rgbMul"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = ((destAlpha+1) * (sourceAlpha+1)- 1 // 256)
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAllAlphasRgbSub (in category 'tests') -----
- ----- Method: BitBltTest>>testAllAlphasRgbSub (in category 'bugs') -----
  testAllAlphasRgbSub
  "self run: #testAllAlphasRgbSub"
  | sourceForm destForm blt correctAlphas |
  <timeout: 10>
       correctAlphas := 0.
       0  to: 255 do: [:sourceAlpha |
           sourceForm := Form extent: 1 @ 1 depth: 32.
           sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27.
           0 to: 255 do: [:destAlpha |
               destForm := Form extent: 1 @ 1 depth: 32.
               destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255.
                blt := BitBlt new.
                blt sourceForm: sourceForm.
                blt sourceOrigin: 0 @ 0.
                blt setDestForm: destForm.
                blt destOrigin: 0 @ 0.
                blt combinationRule: 21. "rgbSub"
                blt copyBits.
                correctAlphas := correctAlphas
                  + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha - sourceAlpha) abs
                           ifTrue: [1]
                           ifFalse: [0])
        ]].
       self assert: 65536 equals: correctAlphas!

Item was changed:
+ ----- Method: BitBltTest>>testAlphaCompositing (in category 'tests') -----
- ----- Method: BitBltTest>>testAlphaCompositing (in category 'bugs') -----
  testAlphaCompositing
  "self run: #testAlphaCompositing"
 
  | bb f1 f2 mixColor result eps |
  f1 := Form extent: 1@1 depth: 32.
  f2 := Form extent: 1@1 depth: 32.
  eps := 0.5 / 255.
  0 to: 255 do:[:i|
  f1 colorAt: 0@0 put: Color blue.
  mixColor := Color red alpha: i / 255.0.
  f2 colorAt: 0@0 put: mixColor.
  mixColor := f2 colorAt: 0@0.
  bb := BitBlt toForm: f1.
  bb sourceForm: f2.
  bb combinationRule: Form blend.
  bb copyBits.
  result := f1 colorAt: 0@0.
  self assert: (result red - mixColor alpha) abs < eps.
  self assert: (result blue - (1.0 - mixColor alpha)) abs < eps.
  self assert: result alpha = 1.0.
  ].!

Item was changed:
+ ----- Method: BitBltTest>>testAlphaCompositing2 (in category 'tests') -----
- ----- Method: BitBltTest>>testAlphaCompositing2 (in category 'bugs') -----
  testAlphaCompositing2
  "self run: #testAlphaCompositing2"
 
  | bb f1 f2 mixColor result eps |
  f1 := Form extent: 1@1 depth: 32.
  f2 := Form extent: 1@1 depth: 32.
  eps := 0.5 / 255.
  0 to: 255 do:[:i|
  f1 colorAt: 0@0 put: Color transparent.
  mixColor := Color red alpha: i / 255.0.
  f2 colorAt: 0@0 put: mixColor.
  mixColor := f2 colorAt: 0@0.
  bb := BitBlt toForm: f1.
  bb sourceForm: f2.
  bb combinationRule: Form blend.
  bb copyBits.
  result := f1 colorAt: 0@0.
  self assert: (result red - mixColor alpha) abs < eps.
  self assert: result alpha = mixColor alpha.
  ].!

Item was changed:
+ ----- Method: BitBltTest>>testPeekerUnhibernateBug (in category 'tests - bugs') -----
- ----- Method: BitBltTest>>testPeekerUnhibernateBug (in category 'bugs') -----
  testPeekerUnhibernateBug
  "self run: #testPeekerUnhibernateBug"
 
  | bitBlt |
  bitBlt := BitBlt bitPeekerFromForm: Display.
  bitBlt destForm hibernate.
 
  "This should not throw an exception."
+ self
+ shouldnt: [bitBlt pixelAt: 1@1]
+ raise: Error!
- bitBlt pixelAt: 1@1.!

Item was changed:
+ ----- Method: BitBltTest>>testPivelValueAt (in category 'tests') -----
- ----- Method: BitBltTest>>testPivelValueAt (in category 'bugs') -----
  testPivelValueAt
  "tests for the pixel peeking extension to bitBlt"
  " self run: #testPixelValueAt"
  |formList pixels |
  "make a Form of each depth"
  formList := #[1 2 4 8 16 32] collect:[:d| Form extent: 17@7 depth: d] as: Array.
  pixels := Dictionary new.
  pixels at: 1 put: 1; at: 2 put: 3; at:4 put: 7; at: 8 put: 16rFF; at: 16 put: 16rFFFF ; at: 32 put: 16rFFFFFFFF.
 
  "poke pixels to
  topleft (to test handling 0)
  bottomright (to test limits)
  middle (just because)
  peek at each location (to make sure it matches expectations)"
  formList do:[:f| |d pixval|
  d := f depth.
  pixval := pixels at: d.
  f pixelValueAt: 0@0 put: pixval.
  f pixelValueAt: 16@6 put: pixval.
  f pixelValueAt: 7@3 put: pixval.
  self assert: (f pixelValueAt: 0@0) = pixval.
  self assert: (f pixelValueAt: 1@0) = 0.
  self assert: (f pixelValueAt: 16@6) = pixval.
  self assert:(f pixelValueAt: 15@6) = 0.
  self assert: (f pixelValueAt: 7@3) = pixval.
  self assert: (f pixelValueAt: 6@3) = 0.
  ]!

Item was changed:
+ ----- Method: BitBltTest>>testPokerUnhibernateBug (in category 'tests - bugs') -----
- ----- Method: BitBltTest>>testPokerUnhibernateBug (in category 'bugs') -----
  testPokerUnhibernateBug
  "self run: #testPokerUnhibernateBug"
 
  | bitBlt |
  bitBlt := BitBlt bitPokerToForm: Display.
  bitBlt sourceForm hibernate.
 
+ self
+ shouldnt: [bitBlt pixelAt: 1@1 put: 0]
+ raise: Error.!
- "This should not throw an exception."
- bitBlt pixelAt: 1@1 put: 0.!

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakAnywhere (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakAnywhere (in category 'testing') -----
  testBreakAnywhere
  | p text cbs indicesOfM |
  text := ((String new: 2 withAll: $m) , (String space) , (String new: 2 withAll: $m)) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth+1 @ (style lineGrid * 6)).
  indicesOfM := (1 to: text size) select: [:i | (text at: i) = $m].
  self assert: p lines size equals: indicesOfM size description: 'Each m is on a new line'.
  self assert: (p lines collect: #first) equals: indicesOfM description: 'Each line begins with m'.
 
  cbs := indicesOfM collect: [:i | p characterBlockForIndex: i].
  self assert: (cbs collect: #left as: Set) size = 1 description: 'Selecting before each m align on same column'
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakAnywhereWhenFirstCharDoesNotFit (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakAnywhereWhenFirstCharDoesNotFit (in category 'testing') -----
  testBreakAnywhereWhenFirstCharDoesNotFit
  | p text cbs |
  text := ((String new: 2 withAll: $m) , (String space) , (String new: 2 withAll: $m)) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth-1 @ (style lineGrid * 7)).
  self assert: p lines size equals: text size + 1 description: 'Each character is on a new line, past end also'.
  self assert: (p lines collect: #first) equals: (1 to: text size + 1) asArray description: 'Each character is on a new line'.
 
  cbs := (1 to: text size + 1) collect: [:i | p characterBlockForIndex: i].
  self assert: (cbs collect: #left as: Set) size = 1 description: 'Selecting before each character align on left'
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakAtLastCr (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakAtLastCr (in category 'testing') -----
  testBreakAtLastCr
  | p text cbfirst cblast cbend cbend2 |
  text := ((String new: 4 withAll: $m) , (String new: 2 withAll: Character space) , String cr) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)).
  self assert: p lines size = 2 description: 'An empty last line after CR must be materialized'.
  self assert: p lines first last = 7 description: 'The CR is included in the line preceding it'.
 
  cbfirst := p characterBlockForIndex: 1.
  cblast := p characterBlockForIndex: text size.
  self assert: cblast origin y = cbfirst origin y description: 'The CR coordinate is still on the first line'.
  cbend := p characterBlockForIndex: text size + 1.
  self assert: cbend origin y >= cblast corner y description: 'Past end is located on the next line'.
 
  cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid).
  self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'.
  self assert: cbend origin = cbend2 origin.
  self assert: cbend corner = cbend2 corner.
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakAtLastSpace (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakAtLastSpace (in category 'testing') -----
  testBreakAtLastSpace
  | p text cbfirst cblast cbend cbend2 |
  text := ((String new: 4 withAll: $m) , (String new: 3 withAll: Character space)) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)).
  self assert: p lines size = 2 description: 'In leftFlush alignment, spaces at end of line overflowing the right margin should flow on next line'.
  self assert: p lines first last = 7 description: 'The space which is crossing the right margin is included in the first line as if it were a CR'.
 
  cbfirst := p characterBlockForIndex: 1.
  cblast := p characterBlockForIndex: text size.
  self assert: cblast origin y = cbfirst origin y description: 'The last space coordinate is still on the first line'.
  cbend := p characterBlockForIndex: text size + 1.
  self assert: cbend origin y >= cblast corner y description: 'Past end is located on the next line'.
 
  cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid).
  self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'.
  self assert: cbend origin = cbend2 origin.
  self assert: cbend corner = cbend2 corner.
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakAtSpace (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakAtSpace (in category 'testing') -----
  testBreakAtSpace
  | p text cbfirst cblast cbend cbend2 |
  text := ((String new: 4 withAll: $m) , (String new: 4 withAll: Character space)) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)).
  self assert: p lines size = 2 description: 'In leftFlush alignment, spaces at end of line overflowing the right margin should flow on next line'.
  self assert: p lines first last = 7 description: 'The space which is crossing the right margin is included in the first line as if it were a CR'.
 
  cbfirst := p characterBlockForIndex: 1.
  cblast := p characterBlockForIndex: text size.
  self assert: cblast origin y >= cbfirst corner y description: 'The last space coordinate is under the first line'.
  cbend := p characterBlockForIndex: text size + 1.
  self assert: cbend origin x >= cblast corner x description: 'Past end is located right of last space'.
 
  cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid).
  self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'.
  self assert: cbend origin = cbend2 origin.
  self assert: cbend corner = cbend2 corner.
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testBreakBeforeLongWord (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testBreakBeforeLongWord (in category 'testing') -----
  testBreakBeforeLongWord
  | p text cbfirst cblast cbend cbend2 cbend1 cbspace |
  text := ((String with: $m) , (String with: Character space) , (String new: 4 withAll: $m)) asText.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)).
  self assert: p lines size = 2 description: 'In leftFlush alignment, a long word overflowing the right margin should flow on next line'.
  self assert: p lines first last = 2 description: 'The space before the long word is on the first line'.
 
  cbfirst := p characterBlockForIndex: 1.
  cblast := p characterBlockForIndex: text size.
  self assert: cblast origin y >= cbfirst corner y description: 'The long word coordinate is under the first line'.
  cbend := p characterBlockForIndex: text size + 1.
  self assert: cbend origin x >= cblast corner x description: 'Past end is located right of long word'.
 
  cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid).
  self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'.
  self assert: cbend origin = cbend2 origin.
  self assert: cbend corner = cbend2 corner.
 
  cbspace := p characterBlockForIndex: 2.
  self assert: cbspace origin y = cbfirst origin y description: 'The space is on the first line'.
 
  cbend1 := p characterBlockAtPoint: cbspace corner x + 1 @ cbspace center y.
  self assert: cbend1 origin x >= cbspace corner x description: 'Clicking after the space starts right after the space'.
  self assert: cbend1 origin y = cbspace origin y description: 'Clicking after the space starts on same line as the space'.
  self assert: cbend1 stringIndex = 3  description: 'Clicking after the space starts on the long word'.
 
  !

Item was changed:
+ ----- Method: CharacterScannerTest>>testClickLeftOfCenteredText (in category 'tests') -----
- ----- Method: CharacterScannerTest>>testClickLeftOfCenteredText (in category 'testing') -----
  testClickLeftOfCenteredText
  | p text cbfirst cbfirst2 |
  style := TextStyle default.
  mWidth := style defaultFont widthOf: $m.
  spaceWidth := style defaultFont widthOf: Character space.
  text := (String new: 4 withAll: $m) asText.
  text addAttribute: TextAlignment centered from: 1 to: text size.
  p := NewParagraph new.
  p
  compose: text
  style: style
  from: 1
  in: (2 @ 2 extent: mWidth*8 @ (style lineGrid * 2)).
 
  cbfirst := p characterBlockForIndex: 1.
  cbfirst2 := p characterBlockAtPoint: 1 @ cbfirst center y.
  self assert: cbfirst = cbfirst2.
  self assert: cbfirst origin = cbfirst2 origin description: 'Clicking left of the margin shall position the cursor correctly'.!

Item was changed:
+ ----- Method: RectangleTest>>testArea (in category 'tests') -----
- ----- Method: RectangleTest>>testArea (in category 'testing') -----
  testArea
  | r1 empty |
  r1 := 0@0 extent: 10@20.
  self assert: r1 area = (10*20).
  self assert: (r1 translateBy: -20@10) area = (10*20) description: 'translation preserves area'.
 
  empty := 10@20 corner: 0@0.
  self assert: empty area = 0 description: 'the area of an empty rectangle is null'.
  empty := 10@0 corner: 0@20.
  self assert: empty area = 0 description: 'the area of an empty rectangle is null'.
  empty := 0@20 corner: 10@0.
  self assert: empty area = 0 description: 'the area of an empty rectangle is null'.!

Item was changed:
+ ----- Method: RectangleTest>>testAreasOutside1 (in category 'tests') -----
- ----- Method: RectangleTest>>testAreasOutside1 (in category 'testing') -----
  testAreasOutside1
     "RectangleTest new testAreasOutside1"
      | frame rects visibleArea  |
      frame := 0@0 extent: 300@300.
      rects := OrderedCollection new: 80.
      0 to: 3 do: [:i |
        0 to: 2 do: [:j |
              rects add: (i@j * 20 extent: 10@10)
      ]  ].
   
     visibleArea := Array with: frame.
     rects do: [:rect |  | remnants |
        remnants := OrderedCollection new.
        visibleArea do: [:a | remnants addAll: (a areasOutside: rect)].
        visibleArea := remnants.
    ].
    visibleArea := visibleArea asArray.
    self assert: (visibleArea allSatisfy: [:r | r area ~= 0]).
 
     1 to: visibleArea size do: [:idx |
       idx + 1 to: visibleArea size do: [:idx2 |
          self deny: ((visibleArea at: idx) intersects: (visibleArea at: idx2)).
    ]  ].
 
    1 to: rects size do: [:idx |
       1 to: visibleArea size do: [:idx2 |
          self deny: ((rects at: idx) intersects: (visibleArea at: idx2)).
    ]  ].
 
  !

Item was changed:
+ ----- Method: RectangleTest>>testAreasOutside2 (in category 'tests') -----
- ----- Method: RectangleTest>>testAreasOutside2 (in category 'testing') -----
  testAreasOutside2
     "RectangleTest new testAreasOutside2"
      | frame rects visibleArea  |
      frame := 0@0 extent: 300@300.
      rects := OrderedCollection new: 80.
      rects add: (50@50 corner: 200 @ 200);
            add: (100@100 corner: 250@250).
   
     visibleArea := Array with: frame.
     rects do: [:rect |  | remnants |
        remnants := OrderedCollection new.
        visibleArea do: [:a | remnants addAll: (a areasOutside: rect)].
        visibleArea := remnants.
    ].
    visibleArea := visibleArea asArray.
    self assert: (visibleArea allSatisfy: [:r | r area ~= 0]).
 
     1 to: visibleArea size do: [:idx |
       idx + 1 to: visibleArea size do: [:idx2 |
          self deny: ((visibleArea at: idx) intersects: (visibleArea at: idx2)).
    ]  ].
 
    1 to: rects size do: [:idx |
       1 to: visibleArea size do: [:idx2 |
          self deny: ((rects at: idx) intersects: (visibleArea at: idx2)).
    ]  ].
 
  !

Item was changed:
+ ----- Method: RectangleTest>>testBottomHalf (in category 'tests') -----
- ----- Method: RectangleTest>>testBottomHalf (in category 'testing') -----
  testBottomHalf
  | r |
  r := 10@20 corner: 30@50.
  self assert: (10@35 corner: 30@50) equals: r bottomHalf.
  self assert: (10@42 corner: 30@50) equals: r bottomHalf bottomHalf!

Item was changed:
+ ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'testing') -----
  testBottomLeftQuadrant
  | r |
  r := 10@20 corner: 30@50.
  self assert: (10@35 corner: 20@50) equals: r bottomLeftQuadrant.
  self assert: (10@42 corner: 15@50) equals: r bottomLeftQuadrant bottomLeftQuadrant!

Item was changed:
+ ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'testing') -----
  testBottomRightQuadrant
  | r |
  r := 10@20 corner: 30@50.
  self assert: (20@35 corner: 30@50) equals: r bottomRightQuadrant.
  self assert: (25@42 corner: 30@50) equals: r bottomRightQuadrant bottomRightQuadrant!

Item was changed:
+ ----- Method: RectangleTest>>testCenter (in category 'tests') -----
- ----- Method: RectangleTest>>testCenter (in category 'testing') -----
  testCenter
  | r1 c |
  r1 := 0@0 extent: 10@20.
  c := r1 center.
  self assert: (r1 containsPoint: c) description: 'the center is inside the rectangle'.
  self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
  self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
  self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
  self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.!

Item was changed:
+ ----- Method: RectangleTest>>testCenterEmpty (in category 'tests') -----
- ----- Method: RectangleTest>>testCenterEmpty (in category 'testing') -----
  testCenterEmpty
  | r1 c |
  r1 := 30@10 corner: 10@20.
  c := r1 center.
  self deny: (r1 containsPoint: c) description: 'An empty rectangle does not contain any point.'.
  self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c).
  self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c).
  self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c).
  self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.!

Item was changed:
+ ----- Method: RectangleTest>>testCorner1 (in category 'tests') -----
- ----- Method: RectangleTest>>testCorner1 (in category 'testing') -----
  testCorner1
     "RectangleTest new testCorner1"
      | rect |
     rect := 10@10 extent: 20@30.
     self deny: (rect containsPoint: rect corner).!

Item was changed:
+ ----- Method: RectangleTest>>testDegeneratedIntersectionTest (in category 'tests') -----
- ----- Method: RectangleTest>>testDegeneratedIntersectionTest (in category 'testing') -----
  testDegeneratedIntersectionTest
  | horizontalLine verticalLine outsideRectangle |
  horizontalLine := 10@10 extent: 20@0.
  verticalLine := 20@0 extent: 0@20.
  self assert: (horizontalLine intersects: verticalLine).
  outsideRectangle := 100@10 extent: 20@20.
  self deny: (horizontalLine intersects: outsideRectangle).!

Item was changed:
+ ----- Method: RectangleTest>>testFlip (in category 'tests') -----
- ----- Method: RectangleTest>>testFlip (in category 'testing') -----
  testFlip
  | r1 c r1Horiz r1Vert |
  r1 := 30@10 extent: 10@20.
  c := 5@5.
  r1Horiz := r1 flipBy: #horizontal centerAt: c.
  r1Vert := r1 flipBy: #vertical centerAt: c.
 
  self assert: r1 area = r1Horiz area description: 'flip preserves area'.
  self assert: r1 area = r1Vert area description: 'flip preserves area'.
 
  self assert: r1 extent = r1Horiz extent description: 'flip preserves extent'.
  self assert: r1 extent = r1Vert extent description: 'flip preserves extent'.
 
  self assert:  (r1 flipBy: #horizontal centerAt: r1 center) = r1.
  self assert:  (r1 flipBy: #vertical centerAt: r1 center) = r1!

Item was changed:
+ ----- Method: RectangleTest>>testFlipEmpty (in category 'tests') -----
- ----- Method: RectangleTest>>testFlipEmpty (in category 'testing') -----
  testFlipEmpty
  | r1 c r1Horiz r1Vert |
  r1 := 30@10 corner: 10@20.
  c := 5@5.
  r1Horiz := r1 flipBy: #horizontal centerAt: c.
  r1Vert := r1 flipBy: #vertical centerAt: c.
 
  self assert: r1 area = r1Horiz area description: 'flip preserves area'.
  self assert: r1 area = r1Vert area description: 'flip preserves area'.
 
  self assert: r1 extent = r1Horiz extent description: 'flip preserves extent'.
  self assert: r1 extent = r1Vert extent description: 'flip preserves extent'.
 
  self assert:  (r1 flipBy: #horizontal centerAt: r1 center) = r1.
  self assert:  (r1 flipBy: #vertical centerAt: r1 center) = r1!

Item was changed:
+ ----- Method: RectangleTest>>testIntersection1 (in category 'tests') -----
- ----- Method: RectangleTest>>testIntersection1 (in category 'testing') -----
  testIntersection1
     "RectangleTest new testIntersection1"
      | rect1 rect2 |
     rect1 := 10@10 corner: 20@30.
     rect2 := rect1 corner extent: 20@40.
     self deny: (rect1 intersects: rect2).!

Item was changed:
+ ----- Method: RectangleTest>>testIntersection2 (in category 'tests') -----
- ----- Method: RectangleTest>>testIntersection2 (in category 'testing') -----
  testIntersection2
     "RectangleTest new testIntersection2"
      | rect1 rect2 |
     rect1 := 0@0 corner: 40@40.
     rect2 := 40@40 corner: 50@50.
     self deny: (rect1 intersects: rect2);
          deny: (rect2 intersects: rect1).!

Item was changed:
+ ----- Method: RectangleTest>>testIntersectionEmpty (in category 'tests') -----
- ----- Method: RectangleTest>>testIntersectionEmpty (in category 'testing') -----
  testIntersectionEmpty
  | rect1 empty1 empty2 |
  rect1 := 10@10 corner: 40@40.
  empty1 := 50@50 corner: 0@0.
  empty2 := 30@30 corner: 20@20.
  self
  deny: (rect1 intersects: empty1);
  deny: (rect1 intersects: empty2);
  deny: (empty1 intersects: rect1);
  deny: (empty2 intersects: rect1);
  deny: (empty1 intersects: empty2);
  deny: (empty2 intersects: empty1).!

Item was changed:
+ ----- Method: RectangleTest>>testLeftHalf (in category 'tests') -----
- ----- Method: RectangleTest>>testLeftHalf (in category 'testing') -----
  testLeftHalf
  | r |
  r := 10@20 corner: 30@50.
  self assert: (10@20 corner: 20@50) equals: r leftHalf.
  self assert: (10@20 corner: 15@50) equals: r leftHalf leftHalf!

Item was changed:
+ ----- Method: RectangleTest>>testRightHalf (in category 'tests') -----
- ----- Method: RectangleTest>>testRightHalf (in category 'testing') -----
  testRightHalf
  | r |
  r := 10@20 corner: 30@50.
  self assert: (20@20 corner: 30@50) equals: r rightHalf.
  self assert: (25@20 corner: 30@50) equals: r rightHalf rightHalf!

Item was changed:
+ ----- Method: RectangleTest>>testRotate (in category 'tests') -----
- ----- Method: RectangleTest>>testRotate (in category 'testing') -----
  testRotate
  | r1 c r1Left r1Right r1Pi |
  r1 := 30@10 extent: 10@20.
  c := 5@5.
  r1Left := r1 rotateBy: #left centerAt: c.
  r1Right := r1 rotateBy: #right centerAt: c.
  r1Pi := r1 rotateBy: #pi centerAt: c.
 
  self assert: r1 area = r1Left area description: 'rotation preserves area'.
  self assert: r1 area = r1Right area description: 'rotation preserves area'.
  self assert: r1 area = r1Pi area description: 'rotation preserves area'.
 
  self assert: r1 extent transposed = r1Left extent.
  self assert: r1 extent transposed = r1Right extent.
  self assert: r1 extent = r1Pi extent.
 
  self assert:  (r1 rotateBy: #pi centerAt: r1 center) = r1!

Item was changed:
+ ----- Method: RectangleTest>>testRotateEmpty (in category 'tests') -----
- ----- Method: RectangleTest>>testRotateEmpty (in category 'testing') -----
  testRotateEmpty
  | r1 c r1Left r1Right r1Pi |
  r1 := 30@10 corner: 10@20.
  c := 5@5.
  r1Left := r1 rotateBy: #left centerAt: c.
  r1Right := r1 rotateBy: #right centerAt: c.
  r1Pi := r1 rotateBy: #pi centerAt: c.
 
  self assert: r1 area = r1Left area description: 'rotation preserves area'.
  self assert: r1 area = r1Right area description: 'rotation preserves area'.
  self assert: r1 area = r1Pi area description: 'rotation preserves area'.
 
  self assert: r1 extent transposed = r1Left extent.
  self assert: r1 extent transposed = r1Right extent.
  self assert: r1 extent = r1Pi extent.
 
  self assert:  (r1 rotateBy: #pi centerAt: r1 center) = r1!

Item was changed:
+ ----- Method: RectangleTest>>testTopHalf (in category 'tests') -----
- ----- Method: RectangleTest>>testTopHalf (in category 'testing') -----
  testTopHalf
  | r |
  r := 10@20 corner: 30@50.
  self assert: (10@20 corner: 30@35) equals: r topHalf.
  self assert: (10@20 corner: 30@27) equals: r topHalf topHalf!

Item was changed:
+ ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'testing') -----
  testTopLeftQuadrant
  | r |
  r := 10@20 corner: 30@50.
  self assert: (10@20 corner: 20@35) equals: r topLeftQuadrant.
  self assert: (10@20 corner: 15@27) equals: r topLeftQuadrant topLeftQuadrant!

Item was changed:
+ ----- Method: RectangleTest>>testTopRightQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testTopRightQuadrant (in category 'testing') -----
  testTopRightQuadrant
  | r |
  r := 10@20 corner: 30@50.
  self assert: (20@20 corner: 30@35) equals: r topRightQuadrant.
  self assert: (25@20 corner: 30@27) equals: r topRightQuadrant topRightQuadrant!