[Pkg] The Trunk: Graphics-ul.393.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Feb 5 23:20:59 UTC 2018
Levente Uzonyi uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-ul.393.mcz
==================== Summary ====================
Name: Graphics-ul.393
Author: ul
Time: 6 February 2018, 12:20:48.141659 am
UUID: 161806a5-4c44-4739-9e86-3c0b5d2676ab
Ancestors: Graphics-ul.392
- reverted some of the ByteArray literal changes as requested by Tobias
- slightly improved GIFReadWriter>>writeHeader
=============== Diff against Graphics-ul.392 ===============
Item was changed:
----- Method: BMPReadWriter>>nextPutImage: (in category 'writing') -----
nextPutImage: aForm
| bhSize rowBytes rgb data colorValues depth image ppw scanLineLen pixline |
depth := aForm depth.
+ depth := #(1 4 8 32 ) detect: [ :each | each >= depth].
- depth := #[1 4 8 32] detect: [ :each | each >= depth].
image := aForm asFormOfDepth: depth.
image unhibernate.
bhSize := 14. "# bytes in file header"
biSize := 40. "info header size in bytes"
biWidth := image width.
biHeight := image height.
biClrUsed := depth = 32 ifTrue: [0] ifFalse:[1 << depth]. "No. color table entries"
bfOffBits := biSize + bhSize + (4*biClrUsed).
rowBytes := ((depth min: 24) * biWidth + 31 // 32) * 4.
biSizeImage := biHeight * rowBytes.
"Write the file header"
stream position: 0.
stream nextLittleEndianNumber: 2 put: 19778. "bfType = BM"
stream nextLittleEndianNumber: 4 put: bfOffBits + biSizeImage. "Entire file size in bytes"
stream nextLittleEndianNumber: 4 put: 0. "bfReserved"
stream nextLittleEndianNumber: 4 put: bfOffBits. "Offset of bitmap data from start of hdr (and file)"
"Write the bitmap info header"
stream position: bhSize.
stream nextLittleEndianNumber: 4 put: biSize. "info header size in bytes"
stream nextLittleEndianNumber: 4 put: image width. "biWidth"
stream nextLittleEndianNumber: 4 put: image height. "biHeight"
stream nextLittleEndianNumber: 2 put: 1. "biPlanes"
stream nextLittleEndianNumber: 2 put: (depth min: 24). "biBitCount"
stream nextLittleEndianNumber: 4 put: 0. "biCompression"
stream nextLittleEndianNumber: 4 put: biSizeImage. "size of image section in bytes"
stream nextLittleEndianNumber: 4 put: 2800. "biXPelsPerMeter"
stream nextLittleEndianNumber: 4 put: 2800. "biYPelsPerMeter"
stream nextLittleEndianNumber: 4 put: biClrUsed.
stream nextLittleEndianNumber: 4 put: 0. "biClrImportant"
biClrUsed > 0 ifTrue: [
"write color map; this works for ColorForms, too"
colorValues := image colormapIfNeededForDepth: 32.
1 to: biClrUsed do: [:i |
rgb := colorValues at: i.
0 to: 24 by: 8 do: [:j | stream nextPut: (rgb >> j bitAnd: 16rFF)]]].
depth < 32 ifTrue: [
"depth = 1, 4 or 8."
data := image bits asByteArray.
ppw := 32 // depth.
scanLineLen := biWidth + ppw - 1 // ppw * 4. "# of bytes in line"
1 to: biHeight do: [:i |
stream next: scanLineLen putAll: data startingAt: (biHeight-i)*scanLineLen+1.
].
] ifFalse: [
data := image bits.
pixline := ByteArray new: (((biWidth * 3 + 3) // 4) * 4).
1 to: biHeight do:[:i |
self store24BitBmpLine: pixline from: data startingAt: (biHeight-i)*biWidth+1 width: biWidth.
stream nextPutAll: pixline.
].
].
stream position = (bfOffBits + biSizeImage) ifFalse: [self error:'Write failure'].
stream close.!
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 |
log := WriteStream on: String new.
destRect := 0 at 0 extent: 600 at 600.
"Form paint/Form over - the most common rules"
+ #( 25 3 ) do:[:rule|
- #[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 |
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| | t source bb |
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: 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 |
log := WriteStream on: String new.
destRect := 0 at 0 extent: 600 at 600.
"Form paint/Form over - the most common rules"
+ #( 25 3 ) do:[:rule|
- #[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 |
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| | t bb source |
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: 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 |
log := WriteStream on: String new.
destRect := 0 at 0 extent: 600 at 600.
"Form paint/Form over - the most common rules"
+ #( 25 3 ) do:[:rule|
- #[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 |
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| | t source bb |
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: GIFReadWriter>>writeHeader (in category 'private-encoding') -----
writeHeader
| byte |
stream position = 0 ifTrue: [
"For first image only"
+ self
+ nextPutAll: #[71 73 70 56 57 97]; "'GIF89a' asByteArray"
+ writeWord: width; "Screen Width"
+ writeWord: height. "Screen Height"
- self nextPutAll: 'GIF89a' asByteArray.
- self writeWord: width. "Screen Width"
- self writeWord: height. "Screen Height"
byte := 16r80. "has color map"
byte := byte bitOr: ((bitsPerPixel - 1) bitShift: 5). "color resolution"
byte := byte bitOr: bitsPerPixel - 1. "bits per pixel"
+ self
+ nextPut: byte;
+ nextPut: 0; "background color."
+ nextPut: 0. "reserved"
- self nextPut: byte.
- self nextPut: 0. "background color."
- self nextPut: 0. "reserved"
colorPalette do: [:pixelValue |
self nextPut: ((pixelValue bitShift: -16) bitAnd: 255);
nextPut: ((pixelValue bitShift: -8) bitAnd: 255);
nextPut: (pixelValue bitAnd: 255)].
+ loopCount ifNotNil: [
- loopCount notNil ifTrue: [
"Write a Netscape loop chunk"
+ self
+ nextPut: Extension;
+ nextPutAll: #[255 11 78 69 84 83 67 65 80 69 50 46 48 3 1];
+ writeWord: loopCount;
+ nextPut: 0]].
- self nextPut: Extension.
- self nextPutAll: #[255 11 78 69 84 83 67 65 80 69 50 46 48 3 1].
- self writeWord: loopCount.
- self nextPut: 0]].
+ (delay notNil and: [ transparentIndex notNil ]) ifTrue: [
- delay notNil | transparentIndex notNil ifTrue: [
self nextPut: Extension;
+ nextPutAll: #[16rF9 4];
+ nextPut: (transparentIndex ifNil: [0] ifNotNil: [9]);
+ writeWord: (delay ifNil: [0] ifNotNil: [delay]);
+ nextPut: (transparentIndex ifNil: [0] ifNotNil: [transparentIndex]);
- nextPutAll: #(16rF9 4) asByteArray;
- nextPut: (transparentIndex isNil ifTrue: [0] ifFalse: [9]);
- writeWord: (delay isNil ifTrue: [0] ifFalse: [delay]);
- nextPut: (transparentIndex isNil ifTrue: [0] ifFalse: [transparentIndex]);
nextPut: 0].
+ self
+ nextPut: ImageSeparator;
+ writeWord: 0; "Image Left"
+ writeWord: 0; "Image Top"
+ writeWord: width; "Image Width"
+ writeWord: height. "Image Height"
- self nextPut: ImageSeparator.
- self writeWord: 0. "Image Left"
- self writeWord: 0. "Image Top"
- self writeWord: width. "Image Width"
- self writeWord: height. "Image Height"
byte := interlace ifTrue: [16r40] ifFalse: [0].
self nextPut: byte.
!
More information about the Packages
mailing list