[Pkg] The Trunk: GraphicsTests-pre.55.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Aug 24 13:04:19 UTC 2020
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 at 1) = Color red.
self assert: (form colorAt: 1 at 7) = Color green.
self assert: (form colorAt: 7 at 7) = Color blue.
self assert: (form colorAt: 4 at 4) = Color white.
self assert: (form pixelValueAt: 1 at 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 at 1) = Color red.
self assert: (form colorAt: 1 at 7) = Color green.
self assert: (form colorAt: 7 at 7) = Color blue.
self assert: (form colorAt: 4 at 4) = Color white.
self assert: (form pixelValueAt: 1 at 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 at 1) = Color red.
self assert: (form colorAt: 1 at 7) = Color green.
self assert: (form colorAt: 7 at 7) = Color blue.
self assert: (form colorAt: 4 at 4) = Color white.
self assert: (form pixelValueAt: 1 at 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 at 1) = Color black.
self assert: (form colorAt: 7 at 1) = Color red.
self assert: (form colorAt: 1 at 7) = Color green.
self assert: (form colorAt: 7 at 7) = Color blue.
self assert: (form colorAt: 4 at 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 at 1) = Color black.
self assert: (form colorAt: 7 at 1) = Color red.
self assert: (form colorAt: 1 at 7) = Color green.
self assert: (form colorAt: 7 at 7) = Color blue.
self assert: (form colorAt: 4 at 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 at 1 depth: 32.
f2 := Form extent: 1 at 1 depth: 32.
eps := 0.5 / 255.
0 to: 255 do:[:i|
f1 colorAt: 0 at 0 put: Color blue.
mixColor := Color red alpha: i / 255.0.
f2 colorAt: 0 at 0 put: mixColor.
mixColor := f2 colorAt: 0 at 0.
bb := BitBlt toForm: f1.
bb sourceForm: f2.
bb combinationRule: Form blend.
bb copyBits.
result := f1 colorAt: 0 at 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 at 1 depth: 32.
f2 := Form extent: 1 at 1 depth: 32.
eps := 0.5 / 255.
0 to: 255 do:[:i|
f1 colorAt: 0 at 0 put: Color transparent.
mixColor := Color red alpha: i / 255.0.
f2 colorAt: 0 at 0 put: mixColor.
mixColor := f2 colorAt: 0 at 0.
bb := BitBlt toForm: f1.
bb sourceForm: f2.
bb combinationRule: Form blend.
bb copyBits.
result := f1 colorAt: 0 at 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 at 1]
+ raise: Error!
- bitBlt pixelAt: 1 at 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 at 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 at 0 put: pixval.
f pixelValueAt: 16 at 6 put: pixval.
f pixelValueAt: 7 at 3 put: pixval.
self assert: (f pixelValueAt: 0 at 0) = pixval.
self assert: (f pixelValueAt: 1 at 0) = 0.
self assert: (f pixelValueAt: 16 at 6) = pixval.
self assert:(f pixelValueAt: 15 at 6) = 0.
self assert: (f pixelValueAt: 7 at 3) = pixval.
self assert: (f pixelValueAt: 6 at 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 at 1 put: 0]
+ raise: Error.!
- "This should not throw an exception."
- bitBlt pixelAt: 1 at 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 at 0 extent: 10 at 20.
self assert: r1 area = (10*20).
self assert: (r1 translateBy: -20 at 10) area = (10*20) description: 'translation preserves area'.
empty := 10 at 20 corner: 0 at 0.
self assert: empty area = 0 description: 'the area of an empty rectangle is null'.
empty := 10 at 0 corner: 0 at 20.
self assert: empty area = 0 description: 'the area of an empty rectangle is null'.
empty := 0 at 20 corner: 10 at 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 at 0 extent: 300 at 300.
rects := OrderedCollection new: 80.
0 to: 3 do: [:i |
0 to: 2 do: [:j |
rects add: (i at j * 20 extent: 10 at 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 at 0 extent: 300 at 300.
rects := OrderedCollection new: 80.
rects add: (50 at 50 corner: 200 @ 200);
add: (100 at 100 corner: 250 at 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 at 20 corner: 30 at 50.
self assert: (10 at 35 corner: 30 at 50) equals: r bottomHalf.
self assert: (10 at 42 corner: 30 at 50) equals: r bottomHalf bottomHalf!
Item was changed:
+ ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'testing') -----
testBottomLeftQuadrant
| r |
r := 10 at 20 corner: 30 at 50.
self assert: (10 at 35 corner: 20 at 50) equals: r bottomLeftQuadrant.
self assert: (10 at 42 corner: 15 at 50) equals: r bottomLeftQuadrant bottomLeftQuadrant!
Item was changed:
+ ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'testing') -----
testBottomRightQuadrant
| r |
r := 10 at 20 corner: 30 at 50.
self assert: (20 at 35 corner: 30 at 50) equals: r bottomRightQuadrant.
self assert: (25 at 42 corner: 30 at 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 at 0 extent: 10 at 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 at 10) center = (c translateBy: -20 at 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 at 10 corner: 10 at 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 at 10) center = (c translateBy: -20 at 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 at 10 extent: 20 at 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 at 10 extent: 20 at 0.
verticalLine := 20 at 0 extent: 0 at 20.
self assert: (horizontalLine intersects: verticalLine).
outsideRectangle := 100 at 10 extent: 20 at 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 at 10 extent: 10 at 20.
c := 5 at 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 at 10 corner: 10 at 20.
c := 5 at 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 at 10 corner: 20 at 30.
rect2 := rect1 corner extent: 20 at 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 at 0 corner: 40 at 40.
rect2 := 40 at 40 corner: 50 at 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 at 10 corner: 40 at 40.
empty1 := 50 at 50 corner: 0 at 0.
empty2 := 30 at 30 corner: 20 at 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 at 20 corner: 30 at 50.
self assert: (10 at 20 corner: 20 at 50) equals: r leftHalf.
self assert: (10 at 20 corner: 15 at 50) equals: r leftHalf leftHalf!
Item was changed:
+ ----- Method: RectangleTest>>testRightHalf (in category 'tests') -----
- ----- Method: RectangleTest>>testRightHalf (in category 'testing') -----
testRightHalf
| r |
r := 10 at 20 corner: 30 at 50.
self assert: (20 at 20 corner: 30 at 50) equals: r rightHalf.
self assert: (25 at 20 corner: 30 at 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 at 10 extent: 10 at 20.
c := 5 at 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 at 10 corner: 10 at 20.
c := 5 at 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 at 20 corner: 30 at 50.
self assert: (10 at 20 corner: 30 at 35) equals: r topHalf.
self assert: (10 at 20 corner: 30 at 27) equals: r topHalf topHalf!
Item was changed:
+ ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'testing') -----
testTopLeftQuadrant
| r |
r := 10 at 20 corner: 30 at 50.
self assert: (10 at 20 corner: 20 at 35) equals: r topLeftQuadrant.
self assert: (10 at 20 corner: 15 at 27) equals: r topLeftQuadrant topLeftQuadrant!
Item was changed:
+ ----- Method: RectangleTest>>testTopRightQuadrant (in category 'tests') -----
- ----- Method: RectangleTest>>testTopRightQuadrant (in category 'testing') -----
testTopRightQuadrant
| r |
r := 10 at 20 corner: 30 at 50.
self assert: (20 at 20 corner: 30 at 35) equals: r topRightQuadrant.
self assert: (25 at 20 corner: 30 at 27) equals: r topRightQuadrant topRightQuadrant!
More information about the Packages
mailing list