NearestPaint subclass: #ShapeRenderer instanceVariableNames: '' classVariableNames: 'BlackPixel WhitePixel ' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! ShapeRenderer comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.'! !ShapeRenderer methodsFor: 'rendering'! renderLuminance: luminance usingPalette: aPalette luminance = 1 ifTrue: [^aPalette indexOfPaintNearest: WhitePixel] ifFalse: [^aPalette indexOfPaintNearest: BlackPixel]! renderPaint: aColorValue usingPalette: aPalette aColorValue = WhitePixel ifTrue: [^aPalette indexOfPaintNearest: WhitePixel] ifFalse: [^aPalette indexOfPaintNearest: BlackPixel]! ! !ShapeRenderer methodsFor: 'private-rendering'! genericPaletteRepresentImage: srcImage as: destImage paintTransfer: paintTransferBlockOrNil "Store a rendering of srcImage into destImage. If paintTransferBlockOrNil is non-nil, it should be a single-argument block used to transform each source paint in srcImage before applying the rendering algorithm. This version is generic and correct for all types of palettes. Answer destImage." | srcPalette destPalette srcPixels destPixels | srcPalette := srcImage palette. destPalette := destImage palette. srcPixels := srcImage pixelArraySpecies new: srcImage width. destPixels := destImage pixelArraySpecies new: destImage width. 0 to: srcImage height - 1 do: [:row | srcImage rowAt: row into: srcPixels. 1 to: srcImage width do: [:i | | srcPaint | srcPaint := srcPalette at: (srcPixels at: i) ifAbsent: [ColorValue black]. paintTransferBlockOrNil == nil ifFalse: [srcPaint := paintTransferBlockOrNil value: srcPaint]. destPixels at: i put: (self renderPaint: srcPaint usingPalette: destPalette)]. destImage rowAt: row putAll: destPixels]. ^destImage! smallPaletteRepresentImage: srcImage as: destImage paintTransfer: paintTransferBlockOrNil "Store a rendering of srcImage into destImage. If paintTransferBlockOrNil is non-nil, it should be a single-argument block used to transform each source paint in srcImage before applying the rendering algorithm. This version is specialized for small palettes. Answer destImage." | srcPalette destPalette srcPixels destPixels pixelMap | srcPalette := srcImage palette. destPalette := destImage palette. srcPixels := srcImage pixelArraySpecies new: srcImage width. destPixels := destImage pixelArraySpecies new: destImage width. pixelMap := destImage pixelArraySpecies new: srcPalette maxIndex + 1. 1 to: pixelMap size do: [:i | | srcPaint | srcPaint := srcPalette at: i - 1 ifAbsent: [ColorValue black]. paintTransferBlockOrNil == nil ifFalse: [srcPaint := paintTransferBlockOrNil value: srcPaint]. pixelMap at: i put: (self renderPaint: srcPaint usingPalette: destPalette)]. 0 to: srcImage height - 1 do: [:row | srcImage rowAt: row into: srcPixels. 1 to: srcImage width do: [:i | destPixels at: i put: (pixelMap at: (srcPixels at: i) + 1)]. destImage rowAt: row putAll: destPixels]. ^destImage! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ShapeRenderer class instanceVariableNames: ''! !ShapeRenderer class methodsFor: 'class initialization'! initialize "self initialize." WhitePixel := ColorValue white. BlackPixel := ColorValue black.! ! Object subclass: #XColorValue instanceVariableNames: 'red green blue ' classVariableNames: 'NamedColors ' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! XColorValue comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !XColorValue methodsFor: 'accessing'! blue ^blue! green ^green! red ^red! ! !XColorValue methodsFor: 'comparing'! = aColor ^aColor class == self class and: [aColor red = red and: [aColor green = green and: [aColor blue = blue]]]! hash ^red hash + green hash + blue hash! ! !XColorValue methodsFor: 'converting'! asColorValue | scalingValue | scalingValue := ColorValue scalingValue. ^ColorValue scaledRed: (self scalingValue: red from: 255 to: scalingValue) scaledGreen: (self scalingValue: green from: 255 to: scalingValue) scaledBlue: (self scalingValue: blue from: 255 to: scalingValue)! ! !XColorValue methodsFor: 'private'! scalingValue: value from: fromScale to: toScale ^value = 0 ifTrue: [0] ifFalse: [value = fromScale ifTrue: [toScale] ifFalse: [(value + 1 * (toScale + 1) / (fromScale + 1)) rounded - 1 max: 0]]! setRed: r setGreen: g setBlue: b red := (r max: 0) min: 255. green := (g max: 0) min: 255. blue := (b max: 0) min: 255.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! XColorValue class instanceVariableNames: ''! !XColorValue class methodsFor: 'class initialization'! initialize "self initialize." NamedColors := Dictionary new. self parseRGBText: self rgbText into: NamedColors.! ! !XColorValue class methodsFor: 'instance creation'! fromString: aString "self fromString: 'blue'." "self fromString: '#ff00ff'." "self fromString: 'ff00ff'." | string xcolor rgbStr | aString isEmpty ifTrue: [^nil]. xcolor := NamedColors at: aString ifAbsent: [nil]. xcolor notNil ifTrue: [^xcolor]. aString first = $# ifTrue: [string := aString copyFrom: 2 to: aString size] ifFalse: [string := aString]. string size = 12 ifTrue: "#rrrrggggbbbb" [rgbStr := (string copyFrom: 1 to: 2), (string copyFrom: 5 to: 6), (string copyFrom: 9 to: 10)] ifFalse: [string size = 9 ifTrue: "#rrrgggbbb" [rgbStr := (string copyFrom: 1 to: 2), (string copyFrom: 4 to: 5), (string copyFrom: 7 to: 8)] ifFalse: [string size = 6 ifTrue: "#rrggbb" [rgbStr := (string copyFrom: 1 to: 2), (string copyFrom: 3 to: 4), (string copyFrom: 5 to: 6)] ifFalse: [string size = 3 ifTrue: "#rgb" [rgbStr := '0', (string copyFrom: 1 to: 1), '0', (string copyFrom: 2 to: 2), '0', (string copyFrom: 3 to: 3)] ifFalse: [^nil]]]]. rgbStr do: [:ch | ('0123456789abcdefABCDEF' includes: ch) ifFalse: [^nil]]. ^self rgbInteger: (Number readFrom: ('16r', rgbStr) readStream)! red: r green: g blue: b "Answer a XColorValue with the supplied RGB intensity (between 0 and 255)." ^self new setRed: r setGreen: g setBlue: b! rgbInteger: rgbInteger "Answer a XColorValue with a 3 byte integer that represents RGB." ^self new setRed: ((rgbInteger bitShift: -16) bitAnd: 255) setGreen: ((rgbInteger bitShift: -8) bitAnd: 255) setBlue: (rgbInteger bitAnd: 255)! ! !XColorValue class methodsFor: 'private'! parseRGBText: aString into: aDictionary | stream | stream := aString readStream. [stream atEnd] whileFalse: [| lstream r g b colorName write noSpaceName xcolor | lstream := (stream upTo: Character cr) readStream. lstream skipSeparators. r := Number readFrom: lstream. lstream skipSeparators. g := Number readFrom: lstream. lstream skipSeparators. b := Number readFrom: lstream. lstream skipSeparators. colorName := lstream upToEnd. lstream := colorName readStream. write := WriteStream on: (String new: colorName size). [lstream atEnd] whileFalse: [| ch | (ch := lstream next) isSeparator ifFalse: [write nextPut: ch]]. noSpaceName := write contents. xcolor := self red: r green: g blue: b. aDictionary at: colorName put: xcolor. aDictionary at: noSpaceName put: xcolor]! rgbText ^'255 250 250 snow 248 248 255 ghost white 248 248 255 GhostWhite 245 245 245 white smoke 245 245 245 WhiteSmoke 220 220 220 gainsboro 255 250 240 floral white 255 250 240 FloralWhite 253 245 230 old lace 253 245 230 OldLace 250 240 230 linen 250 235 215 antique white 250 235 215 AntiqueWhite 255 239 213 papaya whip 255 239 213 PapayaWhip 255 235 205 blanched almond 255 235 205 BlanchedAlmond 255 228 196 bisque 255 218 185 peach puff 255 218 185 PeachPuff 255 222 173 navajo white 255 222 173 NavajoWhite 255 228 181 moccasin 255 248 220 cornsilk 255 255 240 ivory 255 250 205 lemon chiffon 255 250 205 LemonChiffon 255 245 238 seashell 240 255 240 honeydew 245 255 250 mint cream 245 255 250 MintCream 240 255 255 azure 240 248 255 alice blue 240 248 255 AliceBlue 230 230 250 lavender 255 240 245 lavender blush 255 240 245 LavenderBlush 255 228 225 misty rose 255 228 225 MistyRose 255 255 255 white 0 0 0 black 47 79 79 dark slate gray 47 79 79 DarkSlateGray 47 79 79 dark slate grey 47 79 79 DarkSlateGrey 105 105 105 dim gray 105 105 105 DimGray 105 105 105 dim grey 105 105 105 DimGrey 112 128 144 slate gray 112 128 144 SlateGray 112 128 144 slate grey 112 128 144 SlateGrey 119 136 153 light slate gray 119 136 153 LightSlateGray 119 136 153 light slate grey 119 136 153 LightSlateGrey 190 190 190 gray 190 190 190 grey 211 211 211 light grey 211 211 211 LightGrey 211 211 211 light gray 211 211 211 LightGray 25 25 112 midnight blue 25 25 112 MidnightBlue 0 0 128 navy 0 0 128 navy blue 0 0 128 NavyBlue 100 149 237 cornflower blue 100 149 237 CornflowerBlue 72 61 139 dark slate blue 72 61 139 DarkSlateBlue 106 90 205 slate blue 106 90 205 SlateBlue 123 104 238 medium slate blue 123 104 238 MediumSlateBlue 132 112 255 light slate blue 132 112 255 LightSlateBlue 0 0 205 medium blue 0 0 205 MediumBlue 65 105 225 royal blue 65 105 225 RoyalBlue 0 0 255 blue 30 144 255 dodger blue 30 144 255 DodgerBlue 0 191 255 deep sky blue 0 191 255 DeepSkyBlue 135 206 235 sky blue 135 206 235 SkyBlue 135 206 250 light sky blue 135 206 250 LightSkyBlue 70 130 180 steel blue 70 130 180 SteelBlue 176 196 222 light steel blue 176 196 222 LightSteelBlue 173 216 230 light blue 173 216 230 LightBlue 176 224 230 powder blue 176 224 230 PowderBlue 175 238 238 pale turquoise 175 238 238 PaleTurquoise 0 206 209 dark turquoise 0 206 209 DarkTurquoise 72 209 204 medium turquoise 72 209 204 MediumTurquoise 64 224 208 turquoise 0 255 255 cyan 224 255 255 light cyan 224 255 255 LightCyan 95 158 160 cadet blue 95 158 160 CadetBlue 102 205 170 medium aquamarine 102 205 170 MediumAquamarine 127 255 212 aquamarine 0 100 0 dark green 0 100 0 DarkGreen 85 107 47 dark olive green 85 107 47 DarkOliveGreen 143 188 143 dark sea green 143 188 143 DarkSeaGreen 46 139 87 sea green 46 139 87 SeaGreen 60 179 113 medium sea green 60 179 113 MediumSeaGreen 32 178 170 light sea green 32 178 170 LightSeaGreen 152 251 152 pale green 152 251 152 PaleGreen 0 255 127 spring green 0 255 127 SpringGreen 124 252 0 lawn green 124 252 0 LawnGreen 0 255 0 green 127 255 0 chartreuse 0 250 154 medium spring green 0 250 154 MediumSpringGreen 173 255 47 green yellow 173 255 47 GreenYellow 50 205 50 lime green 50 205 50 LimeGreen 154 205 50 yellow green 154 205 50 YellowGreen 34 139 34 forest green 34 139 34 ForestGreen 107 142 35 olive drab 107 142 35 OliveDrab 189 183 107 dark khaki 189 183 107 DarkKhaki 240 230 140 khaki 238 232 170 pale goldenrod 238 232 170 PaleGoldenrod 250 250 210 light goldenrod yellow 250 250 210 LightGoldenrodYellow 255 255 224 light yellow 255 255 224 LightYellow 255 255 0 yellow 255 215 0 gold 238 221 130 light goldenrod 238 221 130 LightGoldenrod 218 165 32 goldenrod 184 134 11 dark goldenrod 184 134 11 DarkGoldenrod 188 143 143 rosy brown 188 143 143 RosyBrown 205 92 92 indian red 205 92 92 IndianRed 139 69 19 saddle brown 139 69 19 SaddleBrown 160 82 45 sienna 205 133 63 peru 222 184 135 burlywood 245 245 220 beige 245 222 179 wheat 244 164 96 sandy brown 244 164 96 SandyBrown 210 180 140 tan 210 105 30 chocolate 178 34 34 firebrick 165 42 42 brown 233 150 122 dark salmon 233 150 122 DarkSalmon 250 128 114 salmon 255 160 122 light salmon 255 160 122 LightSalmon 255 165 0 orange 255 140 0 dark orange 255 140 0 DarkOrange 255 127 80 coral 240 128 128 light coral 240 128 128 LightCoral 255 99 71 tomato 255 69 0 orange red 255 69 0 OrangeRed 255 0 0 red 255 105 180 hot pink 255 105 180 HotPink 255 20 147 deep pink 255 20 147 DeepPink 255 192 203 pink 255 182 193 light pink 255 182 193 LightPink 219 112 147 pale violet red 219 112 147 PaleVioletRed 176 48 96 maroon 199 21 133 medium violet red 199 21 133 MediumVioletRed 208 32 144 violet red 208 32 144 VioletRed 255 0 255 magenta 238 130 238 violet 221 160 221 plum 218 112 214 orchid 186 85 211 medium orchid 186 85 211 MediumOrchid 153 50 204 dark orchid 153 50 204 DarkOrchid 148 0 211 dark violet 148 0 211 DarkViolet 138 43 226 blue violet 138 43 226 BlueViolet 160 32 240 purple 147 112 219 medium purple 147 112 219 MediumPurple 216 191 216 thistle 255 250 250 snow1 238 233 233 snow2 205 201 201 snow3 139 137 137 snow4 255 245 238 seashell1 238 229 222 seashell2 205 197 191 seashell3 139 134 130 seashell4 255 239 219 AntiqueWhite1 238 223 204 AntiqueWhite2 205 192 176 AntiqueWhite3 139 131 120 AntiqueWhite4 255 228 196 bisque1 238 213 183 bisque2 205 183 158 bisque3 139 125 107 bisque4 255 218 185 PeachPuff1 238 203 173 PeachPuff2 205 175 149 PeachPuff3 139 119 101 PeachPuff4 255 222 173 NavajoWhite1 238 207 161 NavajoWhite2 205 179 139 NavajoWhite3 139 121 94 NavajoWhite4 255 250 205 LemonChiffon1 238 233 191 LemonChiffon2 205 201 165 LemonChiffon3 139 137 112 LemonChiffon4 255 248 220 cornsilk1 238 232 205 cornsilk2 205 200 177 cornsilk3 139 136 120 cornsilk4 255 255 240 ivory1 238 238 224 ivory2 205 205 193 ivory3 139 139 131 ivory4 240 255 240 honeydew1 224 238 224 honeydew2 193 205 193 honeydew3 131 139 131 honeydew4 255 240 245 LavenderBlush1 238 224 229 LavenderBlush2 205 193 197 LavenderBlush3 139 131 134 LavenderBlush4 255 228 225 MistyRose1 238 213 210 MistyRose2 205 183 181 MistyRose3 139 125 123 MistyRose4 240 255 255 azure1 224 238 238 azure2 193 205 205 azure3 131 139 139 azure4 131 111 255 SlateBlue1 122 103 238 SlateBlue2 105 89 205 SlateBlue3 71 60 139 SlateBlue4 72 118 255 RoyalBlue1 67 110 238 RoyalBlue2 58 95 205 RoyalBlue3 39 64 139 RoyalBlue4 0 0 255 blue1 0 0 238 blue2 0 0 205 blue3 0 0 139 blue4 30 144 255 DodgerBlue1 28 134 238 DodgerBlue2 24 116 205 DodgerBlue3 16 78 139 DodgerBlue4 99 184 255 SteelBlue1 92 172 238 SteelBlue2 79 148 205 SteelBlue3 54 100 139 SteelBlue4 0 191 255 DeepSkyBlue1 0 178 238 DeepSkyBlue2 0 154 205 DeepSkyBlue3 0 104 139 DeepSkyBlue4 135 206 255 SkyBlue1 126 192 238 SkyBlue2 108 166 205 SkyBlue3 74 112 139 SkyBlue4 176 226 255 LightSkyBlue1 164 211 238 LightSkyBlue2 141 182 205 LightSkyBlue3 96 123 139 LightSkyBlue4 198 226 255 SlateGray1 185 211 238 SlateGray2 159 182 205 SlateGray3 108 123 139 SlateGray4 202 225 255 LightSteelBlue1 188 210 238 LightSteelBlue2 162 181 205 LightSteelBlue3 110 123 139 LightSteelBlue4 191 239 255 LightBlue1 178 223 238 LightBlue2 154 192 205 LightBlue3 104 131 139 LightBlue4 224 255 255 LightCyan1 209 238 238 LightCyan2 180 205 205 LightCyan3 122 139 139 LightCyan4 187 255 255 PaleTurquoise1 174 238 238 PaleTurquoise2 150 205 205 PaleTurquoise3 102 139 139 PaleTurquoise4 152 245 255 CadetBlue1 142 229 238 CadetBlue2 122 197 205 CadetBlue3 83 134 139 CadetBlue4 0 245 255 turquoise1 0 229 238 turquoise2 0 197 205 turquoise3 0 134 139 turquoise4 0 255 255 cyan1 0 238 238 cyan2 0 205 205 cyan3 0 139 139 cyan4 151 255 255 DarkSlateGray1 141 238 238 DarkSlateGray2 121 205 205 DarkSlateGray3 82 139 139 DarkSlateGray4 127 255 212 aquamarine1 118 238 198 aquamarine2 102 205 170 aquamarine3 69 139 116 aquamarine4 193 255 193 DarkSeaGreen1 180 238 180 DarkSeaGreen2 155 205 155 DarkSeaGreen3 105 139 105 DarkSeaGreen4 84 255 159 SeaGreen1 78 238 148 SeaGreen2 67 205 128 SeaGreen3 46 139 87 SeaGreen4 154 255 154 PaleGreen1 144 238 144 PaleGreen2 124 205 124 PaleGreen3 84 139 84 PaleGreen4 0 255 127 SpringGreen1 0 238 118 SpringGreen2 0 205 102 SpringGreen3 0 139 69 SpringGreen4 0 255 0 green1 0 238 0 green2 0 205 0 green3 0 139 0 green4 127 255 0 chartreuse1 118 238 0 chartreuse2 102 205 0 chartreuse3 69 139 0 chartreuse4 192 255 62 OliveDrab1 179 238 58 OliveDrab2 154 205 50 OliveDrab3 105 139 34 OliveDrab4 202 255 112 DarkOliveGreen1 188 238 104 DarkOliveGreen2 162 205 90 DarkOliveGreen3 110 139 61 DarkOliveGreen4 255 246 143 khaki1 238 230 133 khaki2 205 198 115 khaki3 139 134 78 khaki4 255 236 139 LightGoldenrod1 238 220 130 LightGoldenrod2 205 190 112 LightGoldenrod3 139 129 76 LightGoldenrod4 255 255 224 LightYellow1 238 238 209 LightYellow2 205 205 180 LightYellow3 139 139 122 LightYellow4 255 255 0 yellow1 238 238 0 yellow2 205 205 0 yellow3 139 139 0 yellow4 255 215 0 gold1 238 201 0 gold2 205 173 0 gold3 139 117 0 gold4 255 193 37 goldenrod1 238 180 34 goldenrod2 205 155 29 goldenrod3 139 105 20 goldenrod4 255 185 15 DarkGoldenrod1 238 173 14 DarkGoldenrod2 205 149 12 DarkGoldenrod3 139 101 8 DarkGoldenrod4 255 193 193 RosyBrown1 238 180 180 RosyBrown2 205 155 155 RosyBrown3 139 105 105 RosyBrown4 255 106 106 IndianRed1 238 99 99 IndianRed2 205 85 85 IndianRed3 139 58 58 IndianRed4 255 130 71 sienna1 238 121 66 sienna2 205 104 57 sienna3 139 71 38 sienna4 255 211 155 burlywood1 238 197 145 burlywood2 205 170 125 burlywood3 139 115 85 burlywood4 255 231 186 wheat1 238 216 174 wheat2 205 186 150 wheat3 139 126 102 wheat4 255 165 79 tan1 238 154 73 tan2 205 133 63 tan3 139 90 43 tan4 255 127 36 chocolate1 238 118 33 chocolate2 205 102 29 chocolate3 139 69 19 chocolate4 255 48 48 firebrick1 238 44 44 firebrick2 205 38 38 firebrick3 139 26 26 firebrick4 255 64 64 brown1 238 59 59 brown2 205 51 51 brown3 139 35 35 brown4 255 140 105 salmon1 238 130 98 salmon2 205 112 84 salmon3 139 76 57 salmon4 255 160 122 LightSalmon1 238 149 114 LightSalmon2 205 129 98 LightSalmon3 139 87 66 LightSalmon4 255 165 0 orange1 238 154 0 orange2 205 133 0 orange3 139 90 0 orange4 255 127 0 DarkOrange1 238 118 0 DarkOrange2 205 102 0 DarkOrange3 139 69 0 DarkOrange4 255 114 86 coral1 238 106 80 coral2 205 91 69 coral3 139 62 47 coral4 255 99 71 tomato1 238 92 66 tomato2 205 79 57 tomato3 139 54 38 tomato4 255 69 0 OrangeRed1 238 64 0 OrangeRed2 205 55 0 OrangeRed3 139 37 0 OrangeRed4 255 0 0 red1 238 0 0 red2 205 0 0 red3 139 0 0 red4 255 20 147 DeepPink1 238 18 137 DeepPink2 205 16 118 DeepPink3 139 10 80 DeepPink4 255 110 180 HotPink1 238 106 167 HotPink2 205 96 144 HotPink3 139 58 98 HotPink4 255 181 197 pink1 238 169 184 pink2 205 145 158 pink3 139 99 108 pink4 255 174 185 LightPink1 238 162 173 LightPink2 205 140 149 LightPink3 139 95 101 LightPink4 255 130 171 PaleVioletRed1 238 121 159 PaleVioletRed2 205 104 137 PaleVioletRed3 139 71 93 PaleVioletRed4 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 139 28 98 maroon4 255 62 150 VioletRed1 238 58 140 VioletRed2 205 50 120 VioletRed3 139 34 82 VioletRed4 255 0 255 magenta1 238 0 238 magenta2 205 0 205 magenta3 139 0 139 magenta4 255 131 250 orchid1 238 122 233 orchid2 205 105 201 orchid3 139 71 137 orchid4 255 187 255 plum1 238 174 238 plum2 205 150 205 plum3 139 102 139 plum4 224 102 255 MediumOrchid1 209 95 238 MediumOrchid2 180 82 205 MediumOrchid3 122 55 139 MediumOrchid4 191 62 255 DarkOrchid1 178 58 238 DarkOrchid2 154 50 205 DarkOrchid3 104 34 139 DarkOrchid4 155 48 255 purple1 145 44 238 purple2 125 38 205 purple3 85 26 139 purple4 171 130 255 MediumPurple1 159 121 238 MediumPurple2 137 104 205 MediumPurple3 93 71 139 MediumPurple4 255 225 255 thistle1 238 210 238 thistle2 205 181 205 thistle3 139 123 139 thistle4 0 0 0 gray0 0 0 0 grey0 3 3 3 gray1 3 3 3 grey1 5 5 5 gray2 5 5 5 grey2 8 8 8 gray3 8 8 8 grey3 10 10 10 gray4 10 10 10 grey4 13 13 13 gray5 13 13 13 grey5 15 15 15 gray6 15 15 15 grey6 18 18 18 gray7 18 18 18 grey7 20 20 20 gray8 20 20 20 grey8 23 23 23 gray9 23 23 23 grey9 26 26 26 gray10 26 26 26 grey10 28 28 28 gray11 28 28 28 grey11 31 31 31 gray12 31 31 31 grey12 33 33 33 gray13 33 33 33 grey13 36 36 36 gray14 36 36 36 grey14 38 38 38 gray15 38 38 38 grey15 41 41 41 gray16 41 41 41 grey16 43 43 43 gray17 43 43 43 grey17 46 46 46 gray18 46 46 46 grey18 48 48 48 gray19 48 48 48 grey19 51 51 51 gray20 51 51 51 grey20 54 54 54 gray21 54 54 54 grey21 56 56 56 gray22 56 56 56 grey22 59 59 59 gray23 59 59 59 grey23 61 61 61 gray24 61 61 61 grey24 64 64 64 gray25 64 64 64 grey25 66 66 66 gray26 66 66 66 grey26 69 69 69 gray27 69 69 69 grey27 71 71 71 gray28 71 71 71 grey28 74 74 74 gray29 74 74 74 grey29 77 77 77 gray30 77 77 77 grey30 79 79 79 gray31 79 79 79 grey31 82 82 82 gray32 82 82 82 grey32 84 84 84 gray33 84 84 84 grey33 87 87 87 gray34 87 87 87 grey34 89 89 89 gray35 89 89 89 grey35 92 92 92 gray36 92 92 92 grey36 94 94 94 gray37 94 94 94 grey37 97 97 97 gray38 97 97 97 grey38 99 99 99 gray39 99 99 99 grey39 102 102 102 gray40 102 102 102 grey40 105 105 105 gray41 105 105 105 grey41 107 107 107 gray42 107 107 107 grey42 110 110 110 gray43 110 110 110 grey43 112 112 112 gray44 112 112 112 grey44 115 115 115 gray45 115 115 115 grey45 117 117 117 gray46 117 117 117 grey46 120 120 120 gray47 120 120 120 grey47 122 122 122 gray48 122 122 122 grey48 125 125 125 gray49 125 125 125 grey49 127 127 127 gray50 127 127 127 grey50 130 130 130 gray51 130 130 130 grey51 133 133 133 gray52 133 133 133 grey52 135 135 135 gray53 135 135 135 grey53 138 138 138 gray54 138 138 138 grey54 140 140 140 gray55 140 140 140 grey55 143 143 143 gray56 143 143 143 grey56 145 145 145 gray57 145 145 145 grey57 148 148 148 gray58 148 148 148 grey58 150 150 150 gray59 150 150 150 grey59 153 153 153 gray60 153 153 153 grey60 156 156 156 gray61 156 156 156 grey61 158 158 158 gray62 158 158 158 grey62 161 161 161 gray63 161 161 161 grey63 163 163 163 gray64 163 163 163 grey64 166 166 166 gray65 166 166 166 grey65 168 168 168 gray66 168 168 168 grey66 171 171 171 gray67 171 171 171 grey67 173 173 173 gray68 173 173 173 grey68 176 176 176 gray69 176 176 176 grey69 179 179 179 gray70 179 179 179 grey70 181 181 181 gray71 181 181 181 grey71 184 184 184 gray72 184 184 184 grey72 186 186 186 gray73 186 186 186 grey73 189 189 189 gray74 189 189 189 grey74 191 191 191 gray75 191 191 191 grey75 194 194 194 gray76 194 194 194 grey76 196 196 196 gray77 196 196 196 grey77 199 199 199 gray78 199 199 199 grey78 201 201 201 gray79 201 201 201 grey79 204 204 204 gray80 204 204 204 grey80 207 207 207 gray81 207 207 207 grey81 209 209 209 gray82 209 209 209 grey82 212 212 212 gray83 212 212 212 grey83 214 214 214 gray84 214 214 214 grey84 217 217 217 gray85 217 217 217 grey85 219 219 219 gray86 219 219 219 grey86 222 222 222 gray87 222 222 222 grey87 224 224 224 gray88 224 224 224 grey88 227 227 227 gray89 227 227 227 grey89 229 229 229 gray90 229 229 229 grey90 232 232 232 gray91 232 232 232 grey91 235 235 235 gray92 235 235 235 grey92 237 237 237 gray93 237 237 237 grey93 240 240 240 gray94 240 240 240 grey94 242 242 242 gray95 242 242 242 grey95 245 245 245 gray96 245 245 245 grey96 247 247 247 gray97 247 247 247 grey97 250 250 250 gray98 250 250 250 grey98 252 252 252 gray99 252 252 252 grey99 255 255 255 gray100 255 255 255 grey100 169 169 169 dark grey 169 169 169 DarkGrey 169 169 169 dark gray 169 169 169 DarkGray 0 0 139 dark blue 0 0 139 DarkBlue 0 139 139 dark cyan 0 139 139 DarkCyan 139 0 139 dark magenta 139 0 139 DarkMagenta 139 0 0 dark red 139 0 0 DarkRed 144 238 144 light green 144 238 144 LightGreen'! ! Object subclass: #ImageReadWriter instanceVariableNames: 'stream ' classVariableNames: 'ImageNotStoredSignal MagicNumberErrorSignal ' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! ImageReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. I am an abstract class to provide for encoding and/or decoding an image on a stream. Instance Variables: stream stream for image storages Class Variables: ImageNotStoredSignal image not stored error signal MagicNumberErrorSignal magic number error signal Subclasses must implement the following messages: accessing nextImage nextPutImage:'! !ImageReadWriter methodsFor: 'accessing'! nextImage "Dencoding an image on stream and answer the image." ^self subclassResponsibility! nextImageFromFileNamed: aFileName "Dencoding an image stored on a file named aFileName." | image | stream := aFileName asFilename readStream binary. [image := self nextImage] valueNowOrOnUnwindDo: [self close]. ^image! nextPutImage: anImage "Encoding anImage on stream." ^self subclassResponsibility! nextPutImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." | fname preExist | fname := aFileName asFilename. preExist := fname exists. stream := fname writeStream binary. [self nextPutImage: anImage] valueOnUnwindDo: [self close. preExist ifFalse: [fname delete]]. self close. ^anImage! ! !ImageReadWriter methodsFor: 'stream access'! atEnd ^stream atEnd! close stream == nil ifFalse: [stream close]! contents ^stream contents! cr ^stream nextPut: Character cr asInteger! lf "PPM and PBM are used LF as CR." ^stream nextPut: Character lf asInteger! next ^stream next! next: size ^stream next: size! nextLong "Read a 32-bit quantity from the input stream." ^(stream next bitShift: 24) + (stream next bitShift: 16) + (stream next bitShift: 8) + stream next! nextLongPut: a32BitW "Write out a 32-bit integer as 32 bits." stream nextPut: ((a32BitW bitShift: -24) bitAnd: 16rFF). stream nextPut: ((a32BitW bitShift: -16) bitAnd: 16rFF). stream nextPut: ((a32BitW bitShift: -8) bitAnd: 16rFF). stream nextPut: (a32BitW bitAnd: 16rFF). ^a32BitW! nextPut: aByte ^stream nextPut: aByte! nextPutAll: aByteArray ^stream nextPutAll: aByteArray! nextWord "Read a 16-bit quantity from the input stream." ^(stream next bitShift: 8) + stream next! nextWordPut: a16BitW "Write out a 16-bit integer as 16 bits." stream nextPut: ((a16BitW bitShift: -8) bitAnd: 16rFF). stream nextPut: (a16BitW bitAnd: 16rFF). ^a16BitW! position ^stream position! position: anInteger ^stream position: anInteger! size ^stream size! skip: anInteger ^stream skip: anInteger! space ^stream nextPut: Character space asInteger! tab ^stream nextPut: Character tab asInteger! ! !ImageReadWriter methodsFor: 'private'! changePadOfBits: bits width: width height: height depth: depth from: oldPad to: newPad "Change padding size of bits." | srcRowByteSize dstRowByteSize newBits srcRowBase rowEndOffset | (#(8 16 32) includes: oldPad) ifFalse: [^self error: 'Invalid pad: ', oldPad printString]. (#(8 16 32) includes: newPad) ifFalse: [^self error: 'Invalid pad: ', newPad printString]. srcRowByteSize := width * depth + oldPad - 1 // oldPad * (oldPad / 8). srcRowByteSize * height = bits size ifFalse: [^self error: 'Incorrect bitmap array size.']. dstRowByteSize := width * depth + newPad - 1 // newPad * (newPad / 8). newBits := ByteArray new: dstRowByteSize * height. srcRowBase := 1. rowEndOffset := dstRowByteSize - 1. 1 to: newBits size by: dstRowByteSize do: [:dstRowBase | newBits replaceFrom: dstRowBase to: dstRowBase + rowEndOffset with: bits startingAt: srcRowBase. srcRowBase := srcRowBase + srcRowByteSize]. ^newBits! colorValueFrom: rgbInteger "Answer a colorValue from a 3 byte integer that represents RGB." ^self class colorValueFrom: rgbInteger! hasMagicNumber: aByteArray | position | position := stream position. ((stream size - position) >= aByteArray size and: [(stream next: aByteArray size) = aByteArray]) ifTrue: [^true]. stream position: position. ^false! imageNotStoredError ^self class imageNotStoredSignal raise! magicNumberError ^self class magicNumberErrorSignal raise! on: aStream stream := aStream. (stream respondsTo: #binary) ifTrue: [stream binary]! packBits: bits depthFrom8To: depth with: width height: height pad: pad "Pack bits of depth 8 image to it of depth 1, 2, or 4 image." | maxPixelVal pixelInByte bitsWidth pBitsWidth pBits | (#(1 2 4) includes: depth) ifFalse: [^self error: 'depth must be 1, 2, or 4']. (#(8 16 32) includes: pad) ifFalse: [^self error: 'pad must be 8, 16, or 32']. maxPixelVal := (1 bitShift: depth) - 1. pixelInByte := 8 / depth. bitsWidth := width * 8 + pad - 1 // pad * (pad / 8). pBitsWidth := width * depth + pad - 1 // pad * (pad / 8). pBits := ByteArray new: pBitsWidth * height. 1 to: height do: [:i | | bitIndex pBitIndex pixelVal count | bitIndex := i - 1 * bitsWidth. pBitIndex := i - 1 * pBitsWidth. pixelVal := 0. count := 0. 1 to: width do: [:j | | val | val := bits at: (bitIndex := bitIndex + 1). val > maxPixelVal ifTrue: [^self error: 'can''t pack bits']. pixelVal := (pixelVal bitShift: depth) + val. (count := count + 1) >= pixelInByte ifTrue: [pBits at: (pBitIndex := pBitIndex + 1) put: pixelVal. pixelVal := 0. count := 0]]. count > 0 ifTrue: [pBits at: (pBitIndex := pBitIndex + 1) put: (pixelVal bitShift: depth * (pixelInByte - count))]]. ^pBits! rgbIntegerArrayFor: aPalette | colors | colors := Array new: aPalette maxIndex + 1. 1 to: colors size do: [:i | colors at: i put: (self rgbIntegerFrom: (aPalette at: i - 1 ifAbsent: [ColorValue white]))]. ^colors! rgbIntegerFrom: aColorValue "Answer a 3 byte integer that represents RGB from a colorValue." ^self class rgbIntegerFrom: aColorValue! scalingValue: value from: fromScale to: toScale ^self class scalingValue: value from: fromScale to: toScale! unpackBits: bits depthTo8From: depth with: width height: height pad: pad "Unpack bits of depth 1, 2, or 4 image to it of depth 8 image." | bitMask pixelInByte bitsWidth upBitsWidth stopWidth trailingSize upBits | (#(1 2 4) includes: depth) ifFalse: [^self error: 'depth must be 1, 2, or 4']. (#(8 16 32) includes: pad) ifFalse: [^self error: 'pad must be 8, 16, or 32']. bitMask := (1 bitShift: depth) - 1. pixelInByte := 8 / depth. bitsWidth := width * depth + pad - 1 // pad * (pad / 8). upBitsWidth := width * 8 + pad - 1 // pad * (pad / 8). stopWidth := width * depth + 7 // 8. trailingSize := width - (stopWidth - 1 * pixelInByte). upBits := ByteArray new: upBitsWidth * height. 1 to: height do: [:i | | bitIndex upBitIndex val | bitIndex := i - 1 * bitsWidth. upBitIndex := i - 1 * upBitsWidth. 1 to: stopWidth - 1 do: [:j | val := bits at: (bitIndex := bitIndex + 1). upBitIndex := upBitIndex + pixelInByte. 1 to: pixelInByte do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. val := (bits at: (bitIndex := bitIndex + 1)) bitShift: depth negated * (pixelInByte - trailingSize). upBitIndex := upBitIndex + trailingSize. 1 to: trailingSize do: [:k | upBits at: (upBitIndex - k + 1) put: (val bitAnd: bitMask). val := val bitShift: depth negated]]. ^upBits! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ImageReadWriter class instanceVariableNames: ''! !ImageReadWriter class methodsFor: 'class initialization'! initialize "self initialize." self initializeSignals! initializeSignals "self initializeSignals" MagicNumberErrorSignal := Object errorSignal newSignal notifierString: 'Invalid magic number'; nameClass: self message: #magicNumberErrorSignal. ImageNotStoredSignal := Object errorSignal newSignal notifierString: 'Image not stored'; nameClass: self message: #imageNotStoredSignal.! ! !ImageReadWriter class methodsFor: 'instance creation'! on: aStream "Answer an instance of the receiver for encoding and/or decoding images on aStream." ^self new on: aStream! ! !ImageReadWriter class methodsFor: 'signal constants'! imageNotStoredSignal ^ImageNotStoredSignal! magicNumberErrorSignal ^MagicNumberErrorSignal! ! !ImageReadWriter class methodsFor: 'examples'! guessImageFrom: aStream "Answer an image stored on aStream." | position readerClasses image | position := aStream position. readerClasses := ImageReadWriter allSubclasses copy. image := ImageReadWriter magicNumberErrorSignal handle: [:ex | ex restart] do: [readerClasses isEmpty ifTrue: [nil] ifFalse: [aStream position: position. readerClasses removeFirst imageFrom: aStream]]. image notNil ifTrue: [^image]. "^self error: 'Unknown file format'" ^ImageReadWriter magicNumberErrorSignal raise! guessImageFromFileNamed: aFileName "Answer an image stored on a file named aFileName." | readerClasses image | readerClasses := ImageReadWriter allSubclasses copy. image := ImageReadWriter magicNumberErrorSignal handle: [:ex | ex restart] do: [readerClasses isEmpty ifTrue: [nil] ifFalse: [readerClasses removeFirst imageFromFileNamed: aFileName]]. image notNil ifTrue: [^image]. "^self error: 'Unknown file format'" ^ImageReadWriter magicNumberErrorSignal raise! imageFrom: aStream "Answer an image stored on aStream ." | reader image | reader := self on: aStream. Cursor read showWhile: [[image := reader nextImage] valueNowOrOnUnwindDo: [reader close]]. ^image! imageFromFileNamed: aFileName "Answer an image stored on a file named aFileName." | reader image | reader := self new. Cursor read showWhile: [[image := reader nextImageFromFileNamed: aFileName] valueNowOrOnUnwindDo: [reader close]]. ^image! openGuessImageFromFileNamed: aFileName | anImage cachedImage | anImage := self guessImageFromFileNamed: aFileName. (anImage isKindOf: OpaqueImage) ifTrue: [cachedImage := anImage] ifFalse: [cachedImage := CachedImage on: anImage]. ScheduledWindow new component: cachedImage; label: aFileName; minimumSize: anImage bounds extent; maximumSize: anImage bounds extent; open! openImageFromFileNamed: aFileName | anImage cachedImage | anImage := self imageFromFileNamed: aFileName. (anImage isKindOf: OpaqueImage) ifTrue: [cachedImage := anImage] ifFalse: [cachedImage := CachedImage on: anImage]. ScheduledWindow new component: cachedImage; label: aFileName; minimumSize: anImage bounds extent; maximumSize: anImage bounds extent; open! putImage: anImage "Answer a ByteArray on which anImage is encoded." | writer | writer := self on: (WriteStream on: (ByteArray new: 1024)). Cursor write showWhile: [[writer nextPutImage: anImage] valueNowOrOnUnwindDo: [writer close]]. ^writer contents! putImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." | writer | writer := self new. Cursor write showWhile: [[writer nextPutImage: anImage onFileNamed: aFileName] valueNowOrOnUnwindDo: [writer close]]. ^writer! ! !ImageReadWriter class methodsFor: 'private'! colorValueFrom: rgbInteger "Answer a colorValue from a 3 byte integer that represents RGB." | scalingValue | scalingValue := ColorValue scalingValue. ^ColorValue scaledRed: (self scalingValue: ((rgbInteger bitShift: -16) bitAnd: 255) from: 255 to: scalingValue) scaledGreen: (self scalingValue: ((rgbInteger bitShift: -8) bitAnd: 255) from: 255 to: scalingValue) scaledBlue: (self scalingValue: (rgbInteger bitAnd: 255) from: 255 to: scalingValue)! rgbIntegerFrom: aColorValue "Answer a 3 byte integer that represents RGB from a colorValue." | scalingValue | scalingValue := ColorValue scalingValue. ^((self scalingValue: aColorValue scaledRed from: scalingValue to: 255) bitShift: 16) + ((self scalingValue: aColorValue scaledGreen from: scalingValue to: 255) bitShift: 8) + (self scalingValue: aColorValue scaledBlue from: scalingValue to: 255)! scalingValue: value from: fromScale to: toScale ^value = 0 ifTrue: [0] ifFalse: [value = fromScale ifTrue: [toScale] ifFalse: [(value + 1 * (toScale + 1) / (fromScale + 1)) rounded - 1 max: 0]]! ! ImageReadWriter subclass: #GIFReadWriter instanceVariableNames: 'width height bitsPerPixel colorPalette rowByteSize xpos ypos pass interlace codeSize clearCode eoiCode freeCode maxCode prefixTable suffixTable remainBitCount bufByte bufStream transparentIndex ' classVariableNames: 'Extension ImageSeparator Terminator ' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! GIFReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !GIFReadWriter methodsFor: 'accessing'! nextImage | bits depth figure shape shapeColors | [self readHeader. bits := self readBody. ] valueNowOrOnUnwindDo: [self close]. bits == nil ifTrue: [^self error: 'corrupt GIF file']. depth := bitsPerPixel > 8 ifTrue: [^self error: 'can''t happen'] ifFalse: [bitsPerPixel = 1 ifTrue: [1] ifFalse: [bitsPerPixel = 2 ifTrue: [2] ifFalse: [bitsPerPixel <= 4 ifTrue: [4] ifFalse: [8]]]]. depth < 8 ifTrue: [bits := self packBits: bits depthFrom8To: depth with: width height: height pad: 8]. figure := Image extent: width@height depth: depth palette: colorPalette bits: bits pad: 8. (transparentIndex == nil or: [transparentIndex >= (1 bitShift: bitsPerPixel)]) ifTrue: [^figure]. shapeColors := Array new: (1 bitShift: bitsPerPixel) withAll: ColorValue black. shapeColors at: transparentIndex + 1 put: ColorValue white. shape := Image extent: width@height depth: depth palette: (MappedPalette withColors: shapeColors) bits: bits pad: 8. shape := shape convertToPalette: MappedPalette monochromeDefault renderedBy: ShapeRenderer new. shape palette: CoveragePalette monoMaskPalette. ^OpaqueImage figure: (CachedImage on: figure) shape: (CachedImage on: shape)! nextPutImage: anImage | bits | anImage bitsPerPixel > 8 ifTrue: [^self imageNotStoredError]. width := anImage width. height := anImage height. bitsPerPixel := anImage bitsPerPixel. colorPalette := anImage palette. bits := anImage bitsInstVar. bitsPerPixel < 8 ifTrue: [bits := self unpackBits: bits depthTo8From: bitsPerPixel with: anImage width height: anImage height pad: 32]. interlace := false. [self writeHeader. self writeBitData: bits. ] valueNowOrOnUnwindDo: [self close]. ^anImage! ! !GIFReadWriter methodsFor: 'private-encoding'! flushCode self flushBits! readPixelFrom: bits | pixel | ypos >= height ifTrue: [^nil]. pixel := bits at: (ypos * rowByteSize + xpos + 1). self updatePixelPosition. ^pixel! writeBitData: bits "using modified Lempel-Ziv Welch algorithm." | maxBits maxMaxCode tSize initCodeSize ent tShift fCode pixel | pass := 0. xpos := 0. ypos := 0. rowByteSize := width * 8 + 31 // 32 * 4. remainBitCount := 0. bufByte := 0. bufStream := WriteStream on: (ByteArray new: 256). maxBits := 12. maxMaxCode := 1 bitShift: maxBits. tSize := 5003. prefixTable := Array new: tSize. suffixTable := Array new: tSize. initCodeSize := bitsPerPixel <= 1 ifTrue: [2] ifFalse: [bitsPerPixel]. self nextPut: initCodeSize. self setParameters: initCodeSize. tShift := 0. fCode := tSize. [fCode < 65536] whileTrue: [tShift := tShift + 1. fCode := fCode * 2]. tShift := 8 - tShift. 1 to: tSize do: [:i | suffixTable at: i put: -1]. self writeCodeAndCheckCodeSize: clearCode. ent := self readPixelFrom: bits. [(pixel := self readPixelFrom: bits) == nil] whileFalse: [| index disp nomatch | fCode := (pixel bitShift: maxBits) + ent. index := ((pixel bitShift: tShift) bitXor: ent) + 1. (suffixTable at: index) = fCode ifTrue: [ent := prefixTable at: index] ifFalse: [nomatch := true. (suffixTable at: index) >= 0 ifTrue: [disp := tSize - index + 1. index = 1 ifTrue: [disp := 1]. "probe" [(index := index - disp) < 1 ifTrue: [index := index + tSize]. (suffixTable at: index) = fCode ifTrue: [ent := prefixTable at: index. nomatch := false. "continue whileFalse:"]. nomatch and: [(suffixTable at: index) > 0]] whileTrue: ["probe"]]. "nomatch" nomatch ifTrue: [self writeCodeAndCheckCodeSize: ent. ent := pixel. freeCode < maxMaxCode ifTrue: [prefixTable at: index put: freeCode. suffixTable at: index put: fCode. freeCode := freeCode + 1] ifFalse: [self writeCodeAndCheckCodeSize: clearCode. 1 to: tSize do: [:i | suffixTable at: i put: -1]. self setParameters: initCodeSize]]]]. prefixTable := suffixTable := nil. self writeCodeAndCheckCodeSize: ent. self writeCodeAndCheckCodeSize: eoiCode. self flushCode. self nextPut: 0. "zero-length packet" self nextPut: Terminator! writeCode: aCode self nextBitsPut: aCode! writeCodeAndCheckCodeSize: aCode self writeCode: aCode. self checkCodeSize! writeHeader | byte array | self nextPutAll: 'GIF87a' 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. self nextPut: 0. "background color." self nextPut: 0. "null (future expansion)" array := self rgbIntegerArrayFor: colorPalette. array do: [:rgb | self nextPut: ((rgb bitShift: -16) bitAnd: 255); nextPut: ((rgb bitShift: -8) bitAnd: 255); nextPut: (rgb bitAnd: 255)]. array size + 1 to: (1 bitShift: bitsPerPixel) do: [:i | self nextPut: 0; nextPut: 0; nextPut: 0]. 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! writeWord: aWord self nextPut: (aWord bitAnd: 255). self nextPut: ((aWord bitShift: -8) bitAnd: 255). ^aWord! ! !GIFReadWriter methodsFor: 'private-decoding'! readBitData "using modified Lempel-Ziv Welch algorithm." | bits outCodes outCount bitMask initCodeSize code curCode oldCode inCode finChar | self readWord. "skip Image Left" self readWord. "skip Image Top" width := self readWord. height := self readWord. interlace := (self next bitAnd: 16r40) ~= 0. "I ignore the possible existence of a local color map." pass := 0. xpos := 0. ypos := 0. rowByteSize := width * 8 + 7 // 8. remainBitCount := 0. bufByte := 0. bufStream := ReadStream on: ByteArray new. bits := ByteArray new: width * height. outCodes := ByteArray new: 1025. outCount := 0. bitMask := (1 bitShift: bitsPerPixel) - 1. prefixTable := Array new: 4096. suffixTable := Array new: 4096. initCodeSize := self next. self setParameters: initCodeSize. [(code := self readCode) = eoiCode] whileFalse: [code = clearCode ifTrue: [self setParameters: initCodeSize. curCode := oldCode := code := self readCode. finChar := curCode bitAnd: bitMask. self writePixel: finChar to: bits] ifFalse: [curCode := inCode := code. curCode >= freeCode ifTrue: [curCode := oldCode. outCodes at: (outCount := outCount + 1) put: finChar]. [curCode > bitMask] whileTrue: [outCount > 1024 ifTrue: [^self error: 'corrupt GIF file (OutCount)']. outCodes at: (outCount := outCount + 1) put: (suffixTable at: curCode + 1). curCode := prefixTable at: curCode + 1]. finChar := curCode bitAnd: bitMask. outCodes at: (outCount := outCount + 1) put: finChar. outCount to: 1 by: -1 do: [:i | self writePixel: (outCodes at: i) to: bits]. outCount := 0. prefixTable at: freeCode + 1 put: oldCode. suffixTable at: freeCode + 1 put: finChar. oldCode := inCode. freeCode := freeCode + 1. self checkCodeSize]]. prefixTable := suffixTable := nil. ^bits! readBody | bit | bit := nil. "Read Extension" [stream atEnd] whileFalse: [| extype block blocksize | block := self next. block = Terminator ifTrue: [^bit]. block = ImageSeparator ifTrue: [bit isNil ifTrue: [bit := self readBitData] ifFalse: [self skipBitData]] ifFalse: [block = Extension ifFalse: [^bit "^self error: 'Unknown block type'"]. "Extension block" extype := self next. "extension type" extype = 16rf9 "graphics control" ifTrue: [self next = 4 ifFalse: [^bit "^self error: 'corrupt GIF file'"]. self next; next; next. transparentIndex := self next. self next = 0 ifFalse: [^bit "^self error: 'corrupt GIF file'"]] ifFalse: "Skip blocks" [[(blocksize := self next) > 0] whileTrue: [self next: blocksize]]]]! readCode ^self nextBits! readHeader | is89 byte hasColorMap | (self hasMagicNumber: 'GIF87a' asByteArray) ifTrue: [is89 := false] ifFalse: [(self hasMagicNumber: 'GIF89a' asByteArray) ifTrue: [is89 := true] ifFalse: [^self magicNumberError]]. self readWord. "skip Screen Width" self readWord. "skip Screen Height" byte := self next. hasColorMap := (byte bitAnd: 16r80) ~= 0. bitsPerPixel := (byte bitAnd: 7) + 1. byte := self next. "skip background color." self next ~= 0 ifTrue: [is89 ifFalse: [^self error: 'corrupt GIF file (screen descriptor)']]. hasColorMap ifTrue: [| array | array := Array new: (1 bitShift: bitsPerPixel). 1 to: array size do: [:i | array at: i put: (self colorValueFrom: (self next bitShift: 16) + (self next bitShift: 8) + self next)]. colorPalette := MappedPalette withColors: array] ifFalse: ["Transcript cr; show: 'GIF file does not have a colo rmap.'." colorPalette := MappedPalette monochromeDefault].! readWord ^self next + (self next bitShift: 8)! skipBitData | misc blocksize | self readWord. "skip Image Left" self readWord. "skip Image Top" self readWord. "width" self readWord. "height" misc := self next. (misc bitAnd: 16r80) = 0 ifFalse: "skip colormap" [1 to: (1 bitShift: (misc bitAnd: 7)+1) do: [:i | self next; next; next]]. self next. "minimum code size" [(blocksize := self next) > 0] whileTrue: [self next: blocksize]! writePixel: pixel to: bits | index | (index := ypos * rowByteSize + xpos + 1) <= bits size ifTrue: [bits at: index put: pixel]. self updatePixelPosition! ! !GIFReadWriter methodsFor: 'private-bits access'! flushBits remainBitCount = 0 ifFalse: [self nextBytePut: bufByte. remainBitCount := 0]. self flushBuffer! nextBits | integer readBitCount shiftCount byte | integer := 0. remainBitCount = 0 ifTrue: [readBitCount := 8. shiftCount := 0] ifFalse: [readBitCount := remainBitCount. shiftCount := remainBitCount - 8]. [readBitCount < codeSize] whileTrue: [byte := self nextByte. byte == nil ifTrue: [^eoiCode]. integer := integer + (byte bitShift: shiftCount). shiftCount := shiftCount + 8. readBitCount := readBitCount + 8]. (remainBitCount := readBitCount - codeSize) = 0 ifTrue: [byte := self nextByte] ifFalse: [byte := self peekByte]. byte == nil ifTrue: [^eoiCode]. ^(integer + (byte bitShift: shiftCount)) bitAnd: maxCode! nextBitsPut: anInteger | integer writeBitCount shiftCount | shiftCount := 0. remainBitCount = 0 ifTrue: [writeBitCount := 8. integer := anInteger] ifFalse: [writeBitCount := remainBitCount. integer := bufByte + (anInteger bitShift: 8 - remainBitCount)]. [writeBitCount < codeSize] whileTrue: [self nextBytePut: ((integer bitShift: shiftCount) bitAnd: 255). shiftCount := shiftCount - 8. writeBitCount := writeBitCount + 8]. (remainBitCount := writeBitCount - codeSize) = 0 ifTrue: [self nextBytePut: (integer bitShift: shiftCount)] ifFalse: [bufByte := integer bitShift: shiftCount]. ^anInteger! ! !GIFReadWriter methodsFor: 'private-packing'! fillBuffer | packSize | packSize := self next. bufStream := ReadStream on: (self next: packSize)! flushBuffer bufStream isEmpty ifTrue: [^self]. self nextPut: bufStream size. self nextPutAll: bufStream contents. bufStream := WriteStream on: (ByteArray new: 256)! nextByte bufStream atEnd ifTrue: [self atEnd ifTrue: [^nil]. self fillBuffer]. ^bufStream next! nextBytePut: aByte bufStream nextPut: aByte. bufStream size >= 254 ifTrue: [self flushBuffer]! peekByte bufStream atEnd ifTrue: [self atEnd ifTrue: [^nil]. self fillBuffer]. ^bufStream peek! ! !GIFReadWriter methodsFor: 'private'! checkCodeSize (freeCode > maxCode and: [codeSize < 12]) ifTrue: [codeSize := codeSize + 1. maxCode := (1 bitShift: codeSize) - 1]! setParameters: initCodeSize clearCode := 1 bitShift: initCodeSize. eoiCode := clearCode + 1. freeCode := clearCode + 2. codeSize := initCodeSize + 1. maxCode := (1 bitShift: codeSize) - 1! updatePixelPosition (xpos := xpos + 1) >= width ifFalse: [^self]. xpos := 0. interlace ifFalse: [ypos := ypos + 1. ^self]. pass = 0 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 4]. ^self]. pass = 1 ifTrue: [(ypos := ypos + 8) >= height ifTrue: [pass := pass + 1. ypos := 2]. ^self]. pass = 2 ifTrue: [(ypos := ypos + 4) >= height ifTrue: [pass := pass + 1. ypos := 1]. ^self]. pass = 3 ifTrue: [ypos := ypos + 2. ^self]. ^self error: 'can''t happen'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GIFReadWriter class instanceVariableNames: ''! !GIFReadWriter class methodsFor: 'class initialization'! initialize "self initialize." ImageSeparator := $, asInteger. Extension := $!! asInteger. Terminator := $; asInteger! ! !GIFReadWriter class methodsFor: 'examples'! exemple01 | couleurs palette | couleurs := ColorValue constantNames collect: [:colorName | ColorValue perform: colorName ]. palette := MappedPalette withColors: couleurs. self putImage: (Image fromUser convertToPalette: palette) onFileNamed: 'tes1.gif'! exemple02 "self exemple02" | couleurs palette image couleursDeLImage r | couleurs := ColorValue constantNames collect: [:colorName | ColorValue perform: colorName ]. image := Image fromUser. couleursDeLImage := Bag new. 0 to: image width - 1 do: [:x | 0 to: image height - 1 do: [:y | couleursDeLImage add: (image valueAtPoint: (x@y)) ]]. couleursDeLImage := couleursDeLImage asOrderedCollection. couleurs := couleurs asSet. r := Random new. 256 - couleurs size timesRepeat: [ couleurs add: (couleursDeLImage at: (r next * couleursDeLImage size) asInteger + 1) ]. palette := MappedPalette withColors: couleurs. self putImage: (image convertToPalette: palette) onFileNamed: 'tes1.gif'! ! ImageReadWriter subclass: #PBMReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! PBMReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !PBMReadWriter methodsFor: 'accessing'! nextImage | rawbits width height bits | [(self hasMagicNumber: 'P1' asByteArray) ifTrue: [rawbits := false] ifFalse: [(self hasMagicNumber: 'P4' asByteArray) ifTrue: [rawbits := true] ifFalse: [^self magicNumberError]]. width := self nextInteger. height := self nextInteger. rawbits ifTrue: [bits := self next: width + 7 // 8 * height] ifFalse: [| bitIndex byte pos | bits := ByteArray new: width + 7 // 8 * height. bitIndex := 0. 1 to: height do: [:i | byte := 0. pos := 0. 1 to: width do: [:j | | bit | byte := byte bitShift: 1. bit := self nextInteger. bit = 1 ifTrue: [byte := byte + 1] ifFalse: [bit = 0 ifFalse: [self error: '$0 or $1 is expectd']]. (pos := pos + 1) >= 8 ifTrue: [bits at: (bitIndex := bitIndex + 1) put: byte. pos := 0. byte := 0]]. pos > 0 ifTrue: [bits at: (bitIndex := bitIndex + 1) put: (byte bitShift: 8 - pos)]]] ] valueNowOrOnUnwindDo: [self close]. ^Image extent: width@height depth: 1 palette: MappedPalette monochromeDefault bits: bits pad: 8! nextPutImage: anImage ^self nextPutImage: anImage rawbits: true! nextPutImage: anImage rawbits: rawbits anImage bitsPerPixel = 1 ifFalse: [^self imageNotStoredError]. [| bits rowByteStride rowByteSize | self nextPutAll: (rawbits ifTrue: ['P4'] ifFalse: ['P1']) asByteArray; lf; nextPutAll: anImage width printString asByteArray; space; nextPutAll: anImage height printString asByteArray; lf. bits := anImage bitsInstVar. rowByteStride := anImage bitWidth + 31 // 32 * 4. rowByteSize := anImage bitWidth + 7 // 8. rawbits ifTrue: [1 to: anImage height do: [:i | | index | index := (i - 1) * rowByteStride. 1 to: rowByteSize do: [:j | self nextPut: (bits at: (index := index + 1))]]] ifFalse: [| count | count := 0. 1 to: anImage height do: [:i | | index | index := (i - 1) * rowByteStride. 1 to: rowByteSize - 1 do: [:j | count := count + 1. self nextPutByte: (bits at: (index := index + 1)) from: 1 to: 8. (count \\ 4) = 0 ifTrue: [self lf]]. count := count + 1. self nextPutByte: (bits at: (index := index + 1)) from: rowByteSize * 8 - anImage width + 1 to: 8. (count \\ 4) = 0 ifTrue: [self lf]]]. ] valueNowOrOnUnwindDo: [self close]. ^anImage! ! !PBMReadWriter methodsFor: 'private'! nextChar "I don't care about EOF." | char | (char := self next asCharacter) = $# ifTrue: [[(char := self next asCharacter) = Character lf] whileFalse: []]. ^char! nextInteger | char space tab cr lf i | space := Character space. tab := Character tab. cr := Character cr. lf := Character lf. [char := self nextChar. char = space or: [char = tab or: [char = cr or: [char = lf]]]] whileTrue: []. char isDigit ifFalse: [^self error: 'digit character is expected']. i := 0. [i := i * 10 + char digitValue. (char := self nextChar) isDigit] whileTrue: []. ^i! nextPutByte: byte from: startBit to: stopBit stopBit to: startBit by: -1 do: [:m | | mask | mask := 1 bitShift: m - 1. (byte bitAnd: mask) = mask ifTrue: [self nextPut: $1 asInteger] ifFalse: [self nextPut: $0 asInteger]. self space]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PBMReadWriter class instanceVariableNames: ''! !PBMReadWriter class methodsFor: 'examples'! putImage: anImage rawbits: rawbits "self putImage: Image parcPlaceLogo rawbits: false." | encoder | encoder := self on: (WriteStream on: (ByteArray new: 1024)). Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]. ^encoder contents! putImage: anImage rawbits: rawbits onFileNamed: aFileName "self putImage: Image parcPlaceLogo rawbits: false onFileNamed: 'image.pbm'." | encoder | encoder := self on: aFileName asFilename writeStream. Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]! ! ImageReadWriter subclass: #CSourceReadWriter instanceVariableNames: 'hereChar tokenType tokenValue ' classVariableNames: 'HexValueTable ' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! CSourceReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !CSourceReadWriter methodsFor: 'accessing'! nextImage ^self magicNumberError! nextPutImage: anImage ^self imageNotStoredError! ! !CSourceReadWriter methodsFor: 'parsing'! isFirstTokenChar: aChar ^aChar isAlphabetic or: [aChar = $_]! isTokenChar: aChar ^aChar isAlphaNumeric or: [aChar = $_ or: [aChar = $- or: [aChar = $.]]]! nextChar ^hereChar := self next asCharacter.! nextToken self skipSeparators. self parseToken or: [self parseStringLiteral or: [self parseCharacterLiteral or: [self parseNumberLiteral or: [tokenType := tokenValue := hereChar. self nextChar]]]]. ^tokenType! parseCharacterLiteral | buffer | hereChar = $' ifFalse: [^false]. buffer := WriteStream on: (String new: 64). [self nextChar = $'] whileFalse: [buffer nextPut: hereChar. hereChar = $\ ifTrue: [buffer nextPut: self nextChar]]. tokenType := #character. tokenValue := buffer contents. self nextChar. ^true! parseNumberLiteral | base num | hereChar isDigit ifFalse: [^false]. base := 10. hereChar = $0 ifTrue: [(self nextChar = $x or: [hereChar = $X]) ifTrue: [base := 16. self nextChar] ifFalse: [hereChar isDigit ifTrue: [base := 8] ifFalse: [tokenType := #number. tokenValue := 0. ^true]]]. num := HexValueTable at: hereChar asInteger. [self nextChar isAlphaNumeric] whileTrue: [num := num * base + (HexValueTable at: hereChar asInteger)]. tokenType := #number. tokenValue := num. ^true! parseStringLiteral | buffer | hereChar = $" ifFalse: [^false]. buffer := WriteStream on: (String new: 64). [self nextChar = $"] whileFalse: [buffer nextPut: hereChar. hereChar = $\ ifTrue: [buffer nextPut: self nextChar]]. tokenType := #string. tokenValue := buffer contents. self nextChar. ^true! parseToken | buffer | (self isFirstTokenChar: hereChar) ifFalse: [^false]. buffer := WriteStream on: (String new: 64). buffer nextPut: hereChar. [self isTokenChar: self nextChar] whileTrue: [buffer nextPut: hereChar]. tokenType := #token. tokenValue := buffer contents. ^true! skipSeparators | prevChar | [[hereChar isSeparator] "skip separator" whileTrue: [self nextChar]. hereChar = $/] whileTrue: [self next asCharacter = $* ifFalse: [^self error: 'syntax error']. "skip comment" prevChar := nil. [self nextChar. prevChar = $* and: [hereChar = $/]] whileFalse: [(prevChar := hereChar) == nil ifTrue: [^self error: 'syntax error']]. self nextChar]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CSourceReadWriter class instanceVariableNames: ''! !CSourceReadWriter class methodsFor: 'class initialization'! initialize "self initialize." | newTable | newTable := Array new: 256 withAll: 0. $0 asInteger to: $9 asInteger do: [:i | newTable at: i put: i - $0 asInteger]. $A asInteger to: $F asInteger do: [:i | newTable at: i put: i - $A asInteger + 10]. $a asInteger to: $f asInteger do: [:i | newTable at: i put: i - $a asInteger + 10]. HexValueTable := newTable! ! CSourceReadWriter subclass: #XBMReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! XBMReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !XBMReadWriter methodsFor: 'accessing'! nextImage | width height bits | [self hasMagicNumber ifFalse: [^self magicNumberError]. self nextChar. self nextToken. width := self readDefinition: '_width'. height := self readDefinition: '_height'. tokenType = $# ifTrue: [self readDefinition: '_x_hot'. self readDefinition: '_y_hot']. bits := self readBitsWidth: width height: height. ] valueNowOrOnUnwindDo: [self close]. ^Image extent: width@height depth: 1 palette: CoveragePalette monoMaskPalette "MappedPalette monochromeDefault" bits: bits pad: 8! nextPutImage: anImage | bitmapName | anImage bitsPerPixel = 1 ifFalse: [^self imageNotStoredError]. bitmapName := 'smalltalk'. [self nextPutAll: ('#define ', bitmapName, '_width ', anImage width printString) asByteArray; lf. self nextPutAll: ('#define ', bitmapName, '_height ', anImage height printString) asByteArray; lf. "offset" "self nextPutAll: ('#define ', bitmapName, '_x_hot ', anImage offset x printString) asByteArray; lf. self nextPutAll: ('#define ', bitmapName, '_y_hot ', anImage offset y printString) asByteArray; lf." self nextPutAll: ('static char ', bitmapName, '_bits[] = {') asByteArray. self writeBits: anImage bitsInstVar width: anImage width height: anImage height. self nextPutAll: '};' asByteArray; lf. ] valueNowOrOnUnwindDo: [self close]. ^anImage! ! !XBMReadWriter methodsFor: 'private-encoding'! writeBits: bits width: width height: height | rowBytes imageRowBytes count | rowBytes := width + 7 // 8. imageRowBytes := width + 31 // 32 * 4. count := 0. 1 to: height do: [:i | | pos | pos := i - 1 * imageRowBytes. 1 to: rowBytes do: [:j | self writeByte: (bits at: (pos := pos + 1)) count: (count := count + 1)]]! writeByte: byte | bit4 | self nextPutAll: '0x' asByteArray. bit4 := byte bitShift: -4. self nextPut: (bit4 < 10 ifTrue: [bit4 + $0 asInteger] ifFalse: [bit4 - 10 + $a asInteger]). bit4 := byte bitAnd: 16rF. self nextPut: (bit4 < 10 ifTrue: [bit4 + $0 asInteger] ifFalse: [bit4 - 10 + $a asInteger])! writeByte: byte count: count count = 1 ifFalse: [self nextPut: $, asInteger]. (count - 1 \\ 12) = 0 ifTrue: [self lf; space; space; space] ifFalse: [self space]. self writeByte: (self reverseByte: byte)! ! !XBMReadWriter methodsFor: 'private-decoding'! hasMagicNumber | hasMagicNumber | self nextChar. hasMagicNumber := self nextToken == $# and: [self nextToken == #token and: [tokenValue = 'define']]. stream reset. ^hasMagicNumber! readBitsWidth: width height: height | bits rowBytes pos | [tokenType == ${] whileFalse: [self nextToken]. rowBytes := width + 7 // 8. bits := ByteArray new: rowBytes * height. pos := 0. 1 to: height do: [:i | 1 to: rowBytes do: [:j | self nextToken == #number ifFalse: [^self error: 'syntax error']. bits at: (pos := pos + 1) put: (self reverseByte: tokenValue). self nextToken. "must be $,"]]. ^bits! readDefinition: postfix | number | tokenType == $# ifFalse: [^self error: 'syntax error']. (self nextToken == #token and: [tokenValue = 'define']) ifFalse: [^self error: 'syntax error']. (self nextToken == #token and: ['*', postfix match: tokenValue ignoreCase: false]) ifFalse: [^self error: 'syntax error']. self nextToken == #number ifFalse: [^self error: 'syntax error']. number := tokenValue. self nextToken. ^number! ! !XBMReadWriter methodsFor: 'private'! reverseByte: byte | rByte | (byte = 0 or: [byte = 16rFF]) ifTrue: [^byte]. rByte := 0. (byte bitAnd: 2r00000001) == 2r00000001 ifTrue: [rByte := rByte bitOr: 2r10000000]. (byte bitAnd: 2r00000010) == 2r00000010 ifTrue: [rByte := rByte bitOr: 2r01000000]. (byte bitAnd: 2r00000100) == 2r00000100 ifTrue: [rByte := rByte bitOr: 2r00100000]. (byte bitAnd: 2r00001000) == 2r00001000 ifTrue: [rByte := rByte bitOr: 2r00010000]. (byte bitAnd: 2r00010000) == 2r00010000 ifTrue: [rByte := rByte bitOr: 2r00001000]. (byte bitAnd: 2r00100000) == 2r00100000 ifTrue: [rByte := rByte bitOr: 2r00000100]. (byte bitAnd: 2r01000000) == 2r01000000 ifTrue: [rByte := rByte bitOr: 2r00000010]. (byte bitAnd: 2r10000000) == 2r10000000 ifTrue: [rByte := rByte bitOr: 2r00000001]. ^rByte! ! ImageReadWriter subclass: #PGMReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! PGMReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !PGMReadWriter methodsFor: 'accessing'! nextImage | rawbits width height maxGray bits map grayCount grays imageDepth | [(self hasMagicNumber: 'P2' asByteArray) ifTrue: [rawbits := false] ifFalse: [(self hasMagicNumber: 'P5' asByteArray) ifTrue: [rawbits := true] ifFalse: [^self magicNumberError]]. width := self nextInteger. height := self nextInteger. maxGray := self nextInteger. maxGray > 255 ifTrue: [^self error: 'Too many colors']. bits := ByteArray new: width * height. map := Array new: maxGray + 1 withAll: -1. grayCount := 0. 1 to: bits size do: [:i | | gray grayValue | gray := rawbits ifTrue: [self next] ifFalse: [self nextInteger]. gray := gray + 1. "0-index to 1-index" (grayValue := map at: gray) < 0 ifTrue: [map at: gray put: (grayValue := grayCount). grayCount := grayCount + 1]. bits at: i put: grayValue] ] valueNowOrOnUnwindDo: [self close]. grays := Array new: grayCount. 1 to: grays size do: [:i | grays at: i put: (self colorValueFrom: (map indexOf: i - 1) - 1 grayScale: maxGray)]. imageDepth := grayCount <= 2 ifTrue: [1] ifFalse: [grayCount <= 4 ifTrue: [2] ifFalse: [grayCount <= 16 ifTrue: [4] ifFalse: [8]]]. imageDepth < 8 ifTrue: [bits := self packBits: bits depthFrom8To: imageDepth with: width height: height pad: 8]. ^Image extent: width@height depth: imageDepth palette: (MappedPalette withColors: grays) bits: bits pad: 8! nextPutImage: anImage ^self nextPutImage: anImage rawbits: true! nextPutImage: anImage rawbits: rawbits | depth bits map rowByteStride rowByteSize w | anImage bitsPerPixel > 8 ifTrue: [^self imageNotStoredError]. (self isGrayPalette: anImage palette) ifFalse: [^self imageNotStoredError]. depth := anImage bitsPerPixel. bits := anImage bitsInstVar. (#(1 2 4) includes: depth) ifTrue: [bits := self unpackBits: bits depthTo8From: depth with: anImage width height: anImage height pad: 32. depth := 8]. map := self grayMapFor: anImage palette. [self nextPutAll: (rawbits ifTrue: ['P5'] ifFalse: ['P2']) asByteArray; lf; nextPutAll: anImage width printString asByteArray; space; nextPutAll: anImage height printString asByteArray; lf; nextPutAll: '255' asByteArray; lf. rowByteStride := anImage width * depth + 31 // 32 * 4. rowByteSize := anImage width * depth + 7 // 8. w := 0. 1 to: anImage height do: [:i | | bitsIndex | bitsIndex := (i - 1) * rowByteStride. 1 to: rowByteSize do: [:j | | grayValue | grayValue := map at: (bits at: (bitsIndex := bitsIndex + 1)) + 1. rawbits ifTrue: [self nextPut: grayValue] ifFalse: [self nextPutAll: (grayValue := grayValue printString asByteArray). (w := w + grayValue size + 1) > 67 ifTrue: [self lf. w := 0] ifFalse: [self space]]]] ] valueNowOrOnUnwindDo: [self close]. ^anImage! ! !PGMReadWriter methodsFor: 'private'! colorValueFrom: grayInteger grayScale: grayScale "Answer a colorValue from a byte integer that represents gray." | gray | gray := self scalingValue: (grayInteger bitAnd: 255) from: 255 to: ColorValue scalingValue. ^ColorValue scaledRed: gray scaledGreen: gray scaledBlue: gray! grayIntegerFrom: aColorValue grayScale: grayScale "Answer a byte integer that represents gray from a colorValue." aColorValue isGray ifFalse: [^self error: aColorValue printString, ' is not a gray']. ^self scalingValue: aColorValue scaledRed from: ColorValue scalingValue to: 255! grayMapFor: palette "Answer a gray map for sorted palette." | array notUsed map | array := Array new: 256. notUsed := (0 to: 255) asOrderedCollection. 1 to: (palette maxIndex + 1 min: 256) do: [:i | | gray | gray := self grayIntegerFrom: (palette at: i - 1 ifAbsent: [ColorValue white]) grayScale: 255. array at: i put: gray. notUsed remove: gray ifAbsent: []]. palette maxIndex + 2 to: array size do: [:i | array at: i put: notUsed removeFirst]. 1 to: array size do: [:i | array at: i put: ((array at: i) bitShift: 8) + i - 1]. array := array asSortedCollection asArray. map := Array new: array size. 1 to: array size do: [:i | map at: ((array at: i) bitAnd: 255) + 1 put: i - 1]. ^map! isGrayPalette: aPalette 0 to: aPalette maxIndex do: [:i | (aPalette at: i ifAbsent: [ColorValue gray]) isGray ifFalse: [^false]]. ^true! nextChar "I don't care about EOF." | char | (char := self next asCharacter) = $# ifTrue: [[(char := self next asCharacter) = Character lf] whileFalse: []]. ^char! nextInteger | char space tab cr lf i | space := Character space. tab := Character tab. cr := Character cr. lf := Character lf. [char := self nextChar. char = space or: [char = tab or: [char = cr or: [char = lf]]]] whileTrue: []. char isDigit ifFalse: [^self error: 'digit character is expected']. i := 0. [i := i * 10 + char digitValue. (char := self nextChar) isDigit] whileTrue: []. ^i! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PGMReadWriter class instanceVariableNames: ''! !PGMReadWriter class methodsFor: 'examples'! putImage: anImage rawbits: rawbits "self putImage: Image parcPlaceLogo rawbits: false." | encoder | encoder := self on: (WriteStream on: (ByteArray new: 1024)). Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]. ^encoder contents! putImage: anImage rawbits: rawbits onFileNamed: aFileName "self putImage: Image parcPlaceLogo rawbits: false onFileNamed: 'image.pgm'." | encoder | encoder := self on: aFileName asFilename writeStream. Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]! ! ImageReadWriter subclass: #ExternalCommandReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! ExternalCommandReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !ExternalCommandReadWriter methodsFor: 'accessing'! nextImage ^self magicNumberError! nextImageFromFileNamed: aFileName "Dencoding an image stored on a file named aFileName." "^self externalNextImageFromFileNamed: aFileName" ^self magicNumberError! nextPutImage: anImage ^self imageNotStoredError! nextPutImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." "^self externalNextPutImage: anImage onFileNamed: aFileName" ^self imageNotStoredError! ! !ExternalCommandReadWriter methodsFor: 'external accessing'! externalNextImageFromFileNamed: aFileName "Dencoding an image stored on a file named aFileName." | tname tfname image | (self existsCommandInPath: self readerCommand) ifFalse: [stream := ReadStream on: String new. ^self magicNumberError]. stream := aFileName asFilename readStream binary. (self hasMagicNumber: self magicNumber) ifFalse: [self close. ^self magicNumberError]. self close. tname := self tmpFilePrefix, self readerFileExtension. self executeCommandString: (self generateReaderCommandStringFrom: aFileName to: tname). tfname := tname asFilename. tfname exists ifFalse: [^self magicNumberError]. [image := self readerClass new nextImageFromFileNamed: tname] valueNowOrOnUnwindDo: [tfname delete]. ^image! externalNextPutImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." | fname preExist | (self existsCommandInPath: self writerCommand) ifFalse: [stream := WriteStream on: String new. ^self imageNotStoredError]. fname := aFileName asFilename. preExist := fname exists. stream := fname writeStream binary. stream close. [| tname tfname | tname := self tmpFilePrefix, self writerFileExtension. tfname := tname asFilename. [self writerClass new nextPutImage: anImage onFileNamed: tname. tfname exists ifFalse: [^self imageNotStoredError]. self executeCommandString: (self generateWriterCommandStringFrom: tname to: aFileName). ] valueNowOrOnUnwindDo: [tfname exists ifTrue: [tfname delete]]. fname exists ifFalse: [^self imageNotStoredError]. "check file" stream := aFileName asFilename readStream binary. (self hasMagicNumber: self magicNumber) ifFalse: [self close. ^self imageNotStoredError]. ] valueOnUnwindDo: [self close. preExist ifFalse: [fname delete]]. self close. ^anImage! generateReaderCommandStringFrom: srcName to: destName ^self subclassResponsibility! generateWriterCommandStringFrom: srcName to: destName ^self subclassResponsibility! magicNumber ^self subclassResponsibility! readerClass ^self subclassResponsibility! readerCommand ^self subclassResponsibility! readerFileExtension ^self subclassResponsibility! writerClass ^self subclassResponsibility! writerCommand ^self subclassResponsibility! writerFileExtension ^self subclassResponsibility! ! !ExternalCommandReadWriter methodsFor: 'private'! executeCommandString: aString | connection cmd proc | connection := UnixProcess pipeConnectionFor: 'csh' arguments: #('-ft') setProcessDescriptor: [:pd | proc := pd]. cmd := connection readAppendStream. [cmd nextPutAll: aString; cr; commit. proc wait] valueNowOrOnUnwindDo: [cmd close]. proc release! existsCommandInPath: aString ^true "| path dir | path := (CEnvironment getenv: 'PATH') readStream. [dir := path upTo: $:. dir isEmpty] whileFalse: [(Object errorSignal handle: [:ex | ex returnWith: false] do: [(dir asFilename construct: aString) exists]) ifTrue: [^true]]. ^false"! tmpFilePrefix ^'/tmp/st80img.'! ! CSourceReadWriter subclass: #XPMReadWriter instanceVariableNames: 'charsPerPixel colorPalette pixmapMap maskMap ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! XPMReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !XPMReadWriter methodsFor: 'accessing'! nextImage | pixmapBits maskBits width height depth | [| point array | (self hasMagicNumber: '/* XPM */' asByteArray) ifFalse: [^self magicNumberError]. self nextChar. self nextToken. point := self readHeader. width := point x. height := point y. array := self readPixmapAndMaskWidth: width height: height. pixmapBits := array at: 1. maskBits := array at: 2. ] valueNowOrOnUnwindDo: [self close]. (depth := colorPalette depth) > 8 ifTrue: [^self error: 'can''t happen']. (3 <= depth and: [depth <= 4]) ifTrue: [depth := 4]. (5 <= depth and: [depth <= 8]) ifTrue: [depth := 8]. depth < 8 ifTrue: [pixmapBits := self packBits: pixmapBits depthFrom8To: depth with: width height: height pad: 8]. maskBits := self packBits: maskBits depthFrom8To: 1 with: width height: height pad: 8. ^OpaqueImage figure: (CachedImage on: (Image extent: width@height depth: depth palette: colorPalette bits: pixmapBits pad: 8)) shape: (CachedImage on: (Image extent: width@height depth: 1 palette: CoveragePalette monoMaskPalette bits: maskBits pad: 8))! nextPutImage: anImage "Not yet implemented." ^self imageNotStoredError! ! !XPMReadWriter methodsFor: 'private-decoding'! readColormapWith: ncolors | colorMap | ncolors > 256 ifTrue: [^self error: 'too many colors']. colorMap := Array new: ncolors. pixmapMap := Dictionary new. maskMap := Dictionary new. 1 to: ncolors do: [:i | | lstream str cv | [tokenType == #string] whileFalse: [self nextToken]. lstream := tokenValue readStream. self nextToken. "must be ," str := lstream next: charsPerPixel. cv := self readColorValueFrom: lstream. pixmapMap at: str put: i - 1. cv isNil "None" ifTrue: [maskMap at: str put: 0. colorMap at: i put: ColorValue white] ifFalse: [maskMap at: str put: 1. colorMap at: i put: cv]]. colorPalette := MappedPalette withColors: colorMap! readColorValueFrom: aStream | str xcolor | [str := self readStringFrom: aStream. str = 'c'] whileFalse: [str isEmpty ifTrue: [^self defaultColorValue]. self readStringFrom: aStream]. str := self readStringFrom: aStream. str isEmpty ifTrue: [^self defaultColorValue]. ('None' match: str) ifTrue: [^nil]. xcolor := XColorValue fromString: str. xcolor isNil ifTrue: [^self defaultColorValue]. ^xcolor asColorValue! readHeader | lstream width height ncolors | [tokenType == #string] whileFalse: [self nextToken]. lstream := tokenValue readStream. self nextToken. "must be ," lstream skipSeparators. width := Number readFrom: lstream. lstream skipSeparators. height := Number readFrom: lstream. lstream skipSeparators. ncolors := Number readFrom: lstream. lstream skipSeparators. charsPerPixel := Number readFrom: lstream. self readColormapWith: ncolors. ^width@height! readPixmapAndMaskWidth: width height: height | pixmapBits maskBits pos | pixmapBits := ByteArray new: width * height. maskBits := ByteArray new: width * height. pos := 0. 1 to: height do: [:i | | lstream | [tokenType == #string] whileFalse: [self nextToken]. lstream := tokenValue readStream. self nextToken. "must be ," 1 to: width do: [:j | | str | str := lstream next: charsPerPixel. pos := pos + 1. pixmapBits at: pos put: (pixmapMap at: str). maskBits at: pos put: (maskMap at: str)]]. ^Array with: pixmapBits with: maskBits! readStringFrom: aStream | write ch | write := WriteStream on: (String new: 64). aStream skipSeparators. [aStream atEnd or: [(ch := aStream next) isSeparator]] whileFalse: [write nextPut: ch]. ^write contents! ! !XPMReadWriter methodsFor: 'private'! defaultColorValue ^ColorValue white! ! VisualComponent subclass: #HostCachedImage instanceVariableNames: 'retainedMedium extent hasColor ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! HostCachedImage comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !HostCachedImage methodsFor: 'initialize-release'! close self isOpen ifTrue: [retainedMedium close]. retainedMedium := nil.! release "self close." super release.! ! !HostCachedImage methodsFor: 'accessing'! extent "Answer the receiver's extent." ^self retainedMedium extent! paintBasis "Answer the type of the receiver's underlying paint (ColorValue or CoverageValue)." ^self retainedMedium paintBasis! ! !HostCachedImage methodsFor: 'display box accessing'! preferredBounds "Answer the receiver's preferredBounds." ^self retainedMedium preferredBounds! ! !HostCachedImage methodsFor: 'displaying'! displayOn: aGraphicsContext "Display the receiver on aGraphicsContext." self retainedMedium displayOn: aGraphicsContext! ! !HostCachedImage methodsFor: 'converting'! asImage ^self retainedMedium asImage! asPattern "Answer a pattern with my contents." ^Pattern from: self retainedMedium! asRetainedMedium "Answer the cached retained medium (pixmap or mask). The medium you get should not be modified because it is shared." ^self retainedMedium! ! !HostCachedImage methodsFor: 'private'! isOpen ^retainedMedium ~~ nil and: [retainedMedium isOpen]! retainedMedium self isOpen ifTrue: [^retainedMedium] ifFalse: [hasColor ifTrue: [^Pixmap extent: extent] ifFalse: [^Mask extent: extent]]! setImage: anImage "Set the receiver's image to be anImage." retainedMedium := anImage asRetainedMedium. extent := retainedMedium extent. hasColor := (retainedMedium isKindOf: Pixmap).! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HostCachedImage class instanceVariableNames: ''! !HostCachedImage class methodsFor: 'instance creation'! on: anImage "Answer a new instance of the receiver on anImage." ^self new setImage: anImage! ! ExternalCommandReadWriter subclass: #JPEGReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! JPEGReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !JPEGReadWriter methodsFor: 'accessing'! nextImageFromFileNamed: aFileName "Dencoding an image stored on a file named aFileName." ^self externalNextImageFromFileNamed: aFileName! nextPutImage: anImage onFileNamed: aFileName "Encode anImage on a file named aFileName." ^self externalNextPutImage: anImage onFileNamed: aFileName! ! !JPEGReadWriter methodsFor: 'external accessing'! generateReaderCommandStringFrom: srcName to: destName self useSmallPaletteDecoder ifTrue: [^self readerCommand, ' -gif -fast < ', srcName, ' > ', destName] ifFalse: [^self readerCommand, ' -fast < ', srcName, ' > ', destName]! generateWriterCommandStringFrom: srcName to: destName ^self writerCommand, ' < ', srcName, ' > ', destName! magicNumber ^#[16rff 16rd8]! readerClass self useSmallPaletteDecoder ifTrue: [^GIFReadWriter] ifFalse: [^PPMReadWriter]! readerCommand ^'djpeg'! readerFileExtension self useSmallPaletteDecoder ifTrue: [^'gif'] ifFalse: [^'ppm']! writerClass ^PPMReadWriter! writerCommand ^'cjpeg'! writerFileExtension ^'ppm'! ! !JPEGReadWriter methodsFor: 'private'! useSmallPaletteDecoder ^Screen default colorPalette depth <= 8! ! ImageReadWriter subclass: #PPMReadWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Image ReadWriter'! PPMReadWriter comment: 'Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved. '! !PPMReadWriter methodsFor: 'accessing'! nextImage | position image | position := self position. image := self nextImageDepth: 8. image notNil ifTrue: [^image]. "Transcript cr; show: 'Too many colors for 8 bit depth. retry using 16 bit depth'. self position: position. image := self nextImageDepth: 16. image notNil ifTrue: [^image]. Transcript cr; show: 'Too many colors for 16 bit depth. retry using 24 bit depth'." "Transcript cr; show: 'Too many colors for 8 bit depth. retry using 24 bit depth'." self position: position. image := self nextImageDepth24. image notNil ifTrue: [^image]. ^self error: 'Too many colors for 24 bit depth.'! nextImageDepth24 | rawbits width height bits | [(self hasMagicNumber: 'P3' asByteArray) ifTrue: [rawbits := false] ifFalse: [(self hasMagicNumber: 'P6' asByteArray) ifTrue: [rawbits := true] ifFalse: [^self magicNumberError]]. width := self nextInteger. height := self nextInteger. (self nextInteger) > 255 ifTrue: [^self error: 'Too many colors']. rawbits ifTrue: [bits := self next: width * (24 / 8) * height] ifFalse: [| bitsIndex | bitsIndex := 0. bits := ByteArray new: width * (24 / 8) * height. 1 to: bits size do: [:i | bits at: (bitsIndex := bitsIndex + 1) put: self nextInteger]]. ] valueNowOrOnUnwindDo: [self close]. ^Image extent: width@height depth: 24 palette: (FixedPalette redShift: 16 redMask: 255 greenShift: 8 greenMask: 255 blueShift: 0 blueMask: 255) bits: bits pad: 8! nextImageDepth: depth | bytesInPixel rawbits width height maxColor bits map mapIndex maxMapIndex bitsIndex colors imageDepth | (#(8 16 24) includes: depth) ifFalse: [^self error: 'depth must be 8, 16 or 24']. bytesInPixel := depth / 8. [(self hasMagicNumber: 'P3' asByteArray) ifTrue: [rawbits := false] ifFalse: [(self hasMagicNumber: 'P6' asByteArray) ifTrue: [rawbits := true] ifFalse: [^self magicNumberError]]. width := self nextInteger. height := self nextInteger. maxColor := self nextInteger. maxColor > 255 ifTrue: [^self error: 'Too many colors']. maxColor highBit > depth ifTrue: [^nil]. bits := ByteArray new: width * bytesInPixel * height. map := Dictionary new. mapIndex := 0. maxMapIndex := 1 bitShift: depth. bitsIndex := 0. 1 to: width * height do: [:i | | rgb val | rgb := rawbits ifTrue: [(self next bitShift: 16) + (self next bitShift: 8) + self next] ifFalse: [(self nextInteger bitShift: 16) + (self nextInteger bitShift: 8) + self nextInteger]. val := map at: rgb ifAbsent: [(mapIndex := mapIndex + 1) > maxMapIndex ifTrue: [^nil]. map at: rgb put: mapIndex. mapIndex]. val := val - 1. "1 indexed to 0 indexed " bitsIndex := bitsIndex + bytesInPixel. 1 to: bytesInPixel do: [:j | bits at: (bitsIndex - j + 1) put: (val bitAnd: 255). val := val bitShift: -8]] ] valueNowOrOnUnwindDo: [self close]. colors := (map associations asSortedCollection: [:x :y | x value < y value]) asOrderedCollection. colors := colors collect: [:asc | self colorValueFrom: asc key]. imageDepth := depth > 8 ifTrue: [depth] ifFalse: [colors size <= 2 ifTrue: [1] ifFalse: [colors size <= 4 ifTrue: [2] ifFalse: [colors size <= 16 ifTrue: [4] ifFalse: [depth]]]]. imageDepth < 8 ifTrue: [bits := self packBits: bits depthFrom8To: imageDepth with: width height: height pad: 8]. ^Image extent: width@height depth: imageDepth palette: (MappedPalette withColors: colors) bits: bits pad: 8! nextPutImage: anImage ^self nextPutImage: anImage rawbits: true! nextPutImage: anImage rawbits: rawbits | image | image := self nextPutImageDepth8: anImage rawbits: true. image notNil ifTrue: [^image]. image := self nextPutImageDepth24: anImage rawbits: true. image notNil ifTrue: [^image]. "Fast, but space needed." ^self nextPutImageDepth24: (anImage convertToPalette: (FixedPalette redShift: 16 redMask: 255 greenShift: 8 greenMask: 255 blueShift: 0 blueMask: 255)) rawbits: true. "Slow, but no space needed." "^self nextPutImageDepthAny: anImage rawbits: true."! nextPutImageDepth24: anImage rawbits: rawbits | bits rowByteStride rowByteSize w | anImage bitsPerPixel = 24 ifFalse: [^nil]. bits := anImage bitsInstVar. [self nextPutAll: (rawbits ifTrue: ['P6'] ifFalse: ['P3']) asByteArray; lf; nextPutAll: anImage width printString asByteArray; space; nextPutAll: anImage height printString asByteArray; lf; nextPutAll: '255' asByteArray; lf. rowByteStride := anImage bitWidth + 31 // 32 * 4. rowByteSize := anImage bitWidth + 7 // 8. w := 0. 1 to: anImage height do: [:i | | bitsIndex | bitsIndex := (i - 1) * rowByteStride. rawbits ifTrue: [1 to: rowByteSize do: [:j | self nextPut: (bits at: (bitsIndex := bitsIndex + 1))]] ifFalse: [1 to: rowByteSize do: [:j | | pixelValue | pixelValue := (bits at: (bitsIndex := bitsIndex + 1)) printString asByteArray. self nextPutAll: pixelValue. (w := w + pixelValue size + 1) > 67 ifTrue: [self lf. w := 0] ifFalse: [self space]]]] ] valueNowOrOnUnwindDo: [self close]. ^anImage! nextPutImageDepth8: anImage rawbits: rawbits | depth bits bytesInPixel array rowByteSize rowByteStride count | (depth := anImage bitsPerPixel) > 8 ifTrue: [^nil]. bits := anImage bitsInstVar. (#(1 2 4) includes: depth) ifTrue: [bits := self unpackBits: bits depthTo8From: depth with: anImage width height: anImage height pad: 32. depth := 8]. bytesInPixel := depth / 8. array := self rgbIntegerArrayFor: anImage palette. [self nextPutAll: (rawbits ifTrue: ['P6'] ifFalse: ['P3']) asByteArray; lf; nextPutAll: anImage width printString asByteArray; space; nextPutAll: anImage height printString asByteArray; lf; nextPutAll: '255' asByteArray; lf. rowByteStride := anImage width * depth + 31 // 32 * 4. rowByteSize := anImage width * depth + 7 // 8. count := 0. 1 to: anImage height do: [:i | | bitsIndex | bitsIndex := (i - 1) * rowByteStride. 1 to: rowByteSize do: [:j | | pixelValue rgbInteger | pixelValue := 0. 1 to: bytesInPixel do: [:k | pixelValue := (pixelValue bitShift: 8) + (bits at: (bitsIndex := bitsIndex + 1))]. rgbInteger := array at: pixelValue + 1. "0 indexed to 1 indexed" rawbits ifTrue: [self nextPut: ((rgbInteger bitShift: -16) bitAnd: 255); nextPut: ((rgbInteger bitShift: -8) bitAnd: 255); nextPut: (rgbInteger bitAnd: 255)] ifFalse: [self nextPutAll: ((rgbInteger bitShift: -16) bitAnd: 255) printString asByteArray; space; nextPutAll: ((rgbInteger bitShift: -8) bitAnd: 255) printString asByteArray; space; nextPutAll: (rgbInteger bitAnd: 255) printString asByteArray. (count := count + 1 \\ 5) = 0 ifTrue: [self lf. count := 0] ifFalse: [self space]]]] ] valueNowOrOnUnwindDo: [self close]. ^anImage! nextPutImageDepthAny: anImage rawbits: rawbits | depth bits bytesInPixel palette rowByteSize rowByteStride count | depth := anImage bitsPerPixel. bits := anImage bitsInstVar. (#(1 2 4) includes: depth) ifTrue: [bits := self unpackBits: bits depthTo8From: depth with: anImage width height: anImage height pad: 32. depth := 8]. bytesInPixel := depth / 8. [self nextPutAll: (rawbits ifTrue: ['P6'] ifFalse: ['P3']) asByteArray; lf; nextPutAll: anImage width printString asByteArray; space; nextPutAll: anImage height printString asByteArray; lf; nextPutAll: '255' asByteArray; lf. palette := anImage palette. rowByteStride := anImage width * depth + 31 // 32 * 4. rowByteSize := anImage width * depth + 7 // 8. count := 0. 1 to: anImage height do: [:i | | bitsIndex | bitsIndex := (i - 1) * rowByteStride. 1 to: rowByteSize do: [:j | | pixelValue colorValue rgbInteger | pixelValue := 0. 1 to: bytesInPixel do: [:k | pixelValue := (pixelValue bitShift: 8) + (bits at: (bitsIndex := bitsIndex + 1))]. colorValue := palette at: pixelValue ifAbsent: [ColorValue white]. rgbInteger := self rgbIntegerFrom: colorValue. rawbits ifTrue: [self nextPut: ((rgbInteger bitShift: -16) bitAnd: 255); nextPut: ((rgbInteger bitShift: -8) bitAnd: 255); nextPut: (rgbInteger bitAnd: 255)] ifFalse: [self nextPutAll: ((rgbInteger bitShift: -16) bitAnd: 255) printString asByteArray; space; nextPutAll: ((rgbInteger bitShift: -8) bitAnd: 255) printString asByteArray; space; nextPutAll: (rgbInteger bitAnd: 255) printString asByteArray. (count := count + 1 \\ 5) = 0 ifTrue: [self lf. count := 0] ifFalse: [self space]]]] ] valueNowOrOnUnwindDo: [self close]. ^anImage! ! !PPMReadWriter methodsFor: 'private'! nextChar "I don't care about EOF." | char | (char := self next asCharacter) = $# ifTrue: [[(char := self next asCharacter) = Character lf] whileFalse: []]. ^char! nextInteger | char space tab cr lf i | space := Character space. tab := Character tab. cr := Character cr. lf := Character lf. [char := self nextChar. char = space or: [char = tab or: [char = cr or: [char = lf]]]] whileTrue: []. char isDigit ifFalse: [^self error: 'digit character is expected']. i := 0. [i := i * 10 + char digitValue. (char := self nextChar) isDigit] whileTrue: []. ^i! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! PPMReadWriter class instanceVariableNames: ''! !PPMReadWriter class methodsFor: 'examples'! putImage: anImage rawbits: rawbits "self putImage: Image fromUser rawbits: false." | encoder | encoder := self on: (WriteStream on: (ByteArray new: 1024)). Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]. ^encoder contents! putImage: anImage rawbits: rawbits onFileNamed: aFileName "self putImage: Image fromUser rawbits: false onFileNamed: 'image.ppm'." | encoder | encoder := self on: aFileName asFilename writeStream. Cursor write showWhile: [[encoder nextPutImage: anImage rawbits: rawbits] valueNowOrOnUnwindDo: [encoder close]]! ! ShapeRenderer initialize! XColorValue initialize! ImageReadWriter initialize! GIFReadWriter initialize! CSourceReadWriter initialize!