Depth8Image.st
author claus
Mon, 28 Nov 1994 22:01:57 +0100
changeset 86 032006651226
parent 81 4ba554473294
child 89 ea2bf46eb669
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5
claus
parents: 1
diff changeset
     1
"
claus
parents: 1
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
     3
	      All Rights Reserved
5
claus
parents: 1
diff changeset
     4
claus
parents: 1
diff changeset
     5
 This software is furnished under a license and may be used
claus
parents: 1
diff changeset
     6
 only in accordance with the terms of that license and with the
claus
parents: 1
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
claus
parents: 1
diff changeset
     8
 be provided or otherwise made available to, or used by, any
claus
parents: 1
diff changeset
     9
 other person.  No title to or ownership of the software is
claus
parents: 1
diff changeset
    10
 hereby transferred.
claus
parents: 1
diff changeset
    11
"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    12
304f026e10cd Initial revision
claus
parents:
diff changeset
    13
Image subclass:#Depth8Image
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    14
	 instanceVariableNames:''
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    15
	 classVariableNames:''
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    16
	 poolDictionaries:''
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    17
	 category:'Graphics-Display Objects'
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    18
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    19
5
claus
parents: 1
diff changeset
    20
Depth8Image comment:'
claus
parents: 1
diff changeset
    21
COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    22
	      All Rights Reserved
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
    23
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
    24
$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.15 1994-11-28 21:00:47 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    25
'!
5
claus
parents: 1
diff changeset
    26
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    27
!Depth8Image class methodsFor:'documentation'!
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    28
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    29
copyright
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    30
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    31
 COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    32
	      All Rights Reserved
5
claus
parents: 1
diff changeset
    33
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    34
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    35
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    37
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    38
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    39
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    40
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    41
!
5
claus
parents: 1
diff changeset
    42
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    43
version
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    44
"
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
    45
$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.15 1994-11-28 21:00:47 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    46
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    47
!
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    48
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    49
documentation
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    50
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    51
    this class represents 256-color (8 bit / pixel) images (palette, greyscale ...).
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    52
    It mainly consists of methods already implemented in Image,
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    53
    reimplemented here for more performance.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    54
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    55
! !
5
claus
parents: 1
diff changeset
    56
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    57
!Depth8Image methodsFor:'accessing'!
304f026e10cd Initial revision
claus
parents:
diff changeset
    58
304f026e10cd Initial revision
claus
parents:
diff changeset
    59
bitsPerPixel
304f026e10cd Initial revision
claus
parents:
diff changeset
    60
    "return the number of bits per pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    61
304f026e10cd Initial revision
claus
parents:
diff changeset
    62
    ^ 8
304f026e10cd Initial revision
claus
parents:
diff changeset
    63
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    64
304f026e10cd Initial revision
claus
parents:
diff changeset
    65
bitsPerRow
304f026e10cd Initial revision
claus
parents:
diff changeset
    66
    "return the number of bits in one scanline of the image"
304f026e10cd Initial revision
claus
parents:
diff changeset
    67
304f026e10cd Initial revision
claus
parents:
diff changeset
    68
    ^  width * 8
304f026e10cd Initial revision
claus
parents:
diff changeset
    69
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    70
304f026e10cd Initial revision
claus
parents:
diff changeset
    71
bitsPerSample
304f026e10cd Initial revision
claus
parents:
diff changeset
    72
    "return the number of bits per sample.
304f026e10cd Initial revision
claus
parents:
diff changeset
    73
     The return value is an array of bits-per-plane."
304f026e10cd Initial revision
claus
parents:
diff changeset
    74
304f026e10cd Initial revision
claus
parents:
diff changeset
    75
    ^ #(8)
304f026e10cd Initial revision
claus
parents:
diff changeset
    76
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    77
304f026e10cd Initial revision
claus
parents:
diff changeset
    78
bytesPerRow
304f026e10cd Initial revision
claus
parents:
diff changeset
    79
    "return the number of bytes in one scanline of the image"
304f026e10cd Initial revision
claus
parents:
diff changeset
    80
304f026e10cd Initial revision
claus
parents:
diff changeset
    81
    ^ width
304f026e10cd Initial revision
claus
parents:
diff changeset
    82
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    83
304f026e10cd Initial revision
claus
parents:
diff changeset
    84
samplesPerPixel
304f026e10cd Initial revision
claus
parents:
diff changeset
    85
    "return the number of samples per pixel in the image."
304f026e10cd Initial revision
claus
parents:
diff changeset
    86
304f026e10cd Initial revision
claus
parents:
diff changeset
    87
    ^ 1
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    88
! !
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    89
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    90
!Depth8Image methodsFor:'accessing'!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    91
304f026e10cd Initial revision
claus
parents:
diff changeset
    92
atX:x y:y
304f026e10cd Initial revision
claus
parents:
diff changeset
    93
    "retrieve a pixel at x/y; return a color.
304f026e10cd Initial revision
claus
parents:
diff changeset
    94
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
    95
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    96
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    97
    |value "{ Class: SmallInteger }"
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    98
     index "{ Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    99
304f026e10cd Initial revision
claus
parents:
diff changeset
   100
    index := (width * y) + 1 + x.
304f026e10cd Initial revision
claus
parents:
diff changeset
   101
    value := bytes at:index.
304f026e10cd Initial revision
claus
parents:
diff changeset
   102
304f026e10cd Initial revision
claus
parents:
diff changeset
   103
    photometric == #whiteIs0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   104
	^ Color grey:100 - (100 / 255 * value)
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   105
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   106
    photometric == #blackIs0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   107
	^ Color grey:(100 / 255 * value)
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   108
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   109
    photometric ~~ #palette ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   110
	self error:'format not supported'.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   111
	^ nil
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   112
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   113
    index := value + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   114
    ^ Color red:(((colorMap at:1) at:index) * 100 / 255)
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   115
	  green:(((colorMap at:2) at:index) * 100 / 255)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   116
	   blue:(((colorMap at:3) at:index) * 100 / 255)
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   117
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   118
304f026e10cd Initial revision
claus
parents:
diff changeset
   119
valueAtX:x y:y
304f026e10cd Initial revision
claus
parents:
diff changeset
   120
    "retrieve a pixel at x/y; return a pixelValue.
304f026e10cd Initial revision
claus
parents:
diff changeset
   121
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
   122
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
   123
304f026e10cd Initial revision
claus
parents:
diff changeset
   124
    |index "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
   125
304f026e10cd Initial revision
claus
parents:
diff changeset
   126
    index := (width * y) + 1 + x.
304f026e10cd Initial revision
claus
parents:
diff changeset
   127
    ^ bytes at:index.
304f026e10cd Initial revision
claus
parents:
diff changeset
   128
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   129
304f026e10cd Initial revision
claus
parents:
diff changeset
   130
atX:x y:y putValue:aPixelValue
304f026e10cd Initial revision
claus
parents:
diff changeset
   131
    "set the pixel at x/y to aPixelValue.
304f026e10cd Initial revision
claus
parents:
diff changeset
   132
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
   133
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
   134
304f026e10cd Initial revision
claus
parents:
diff changeset
   135
    |index "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
   136
304f026e10cd Initial revision
claus
parents:
diff changeset
   137
    index := (width * y) + 1 + x.
304f026e10cd Initial revision
claus
parents:
diff changeset
   138
    bytes at:index put:aPixelValue.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   139
! !
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   140
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   141
!Depth8Image methodsFor:'enumeration'!
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   142
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   143
valueAtY:y from:xLow to:xHigh do:aBlock
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   144
    "perform aBlock for each pixelValue from x1 to x2 in row y.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   145
     The block is passed the pixelValue at each pixel.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   146
     This method allows slighly faster processing of an
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   147
     image than using valueAtX:y:, since some processing can be
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   148
     avoided when going from pixel to pixel. However, for
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   149
     real image processing, specialized methods should be written."
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   150
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   151
    |srcIndex   "{ Class: SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   152
     index      "{ Class: SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   153
     pixelValue "{ Class: SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   154
     x1         "{ Class: SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   155
     x2         "{ Class: SmallInteger }"|
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   156
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   157
    x1 := xLow.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   158
    x2 := xHigh.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   159
    srcIndex := (width * y) + 1 + x1.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   160
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   161
    x1 to:x2 do:[:x |
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   162
	pixelValue := bytes at:srcIndex.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   163
	srcIndex := srcIndex + 1.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   164
	aBlock value:x value:pixelValue 
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   165
    ]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   166
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   167
304f026e10cd Initial revision
claus
parents:
diff changeset
   168
atY:y from:xLow to:xHigh do:aBlock
304f026e10cd Initial revision
claus
parents:
diff changeset
   169
    "perform aBlock for each pixel from x1 to x2 in row y.
304f026e10cd Initial revision
claus
parents:
diff changeset
   170
     The block is passed the color at each pixel.
304f026e10cd Initial revision
claus
parents:
diff changeset
   171
     This method allows slighly faster processing of an
304f026e10cd Initial revision
claus
parents:
diff changeset
   172
     image than using atX:y:, since some processing can be
304f026e10cd Initial revision
claus
parents:
diff changeset
   173
     avoided when going from pixel to pixel. However, for
304f026e10cd Initial revision
claus
parents:
diff changeset
   174
     real image processing, specialized methods should be written."
304f026e10cd Initial revision
claus
parents:
diff changeset
   175
304f026e10cd Initial revision
claus
parents:
diff changeset
   176
    |srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   177
     index    "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   178
     value    "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   179
     x1       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   180
     x2       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   181
     color colors last|
304f026e10cd Initial revision
claus
parents:
diff changeset
   182
304f026e10cd Initial revision
claus
parents:
diff changeset
   183
    colors := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   184
304f026e10cd Initial revision
claus
parents:
diff changeset
   185
    x1 := xLow.
304f026e10cd Initial revision
claus
parents:
diff changeset
   186
    x2 := xHigh.
304f026e10cd Initial revision
claus
parents:
diff changeset
   187
    srcIndex := (width * y) + 1 + x1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   188
304f026e10cd Initial revision
claus
parents:
diff changeset
   189
    x1 to:x2 do:[:x |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   190
	value := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   191
	srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   192
	value ~~ last ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   193
	    last := value.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   194
	    index := value + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   195
	    color := colors at:index.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   196
	    color isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   197
		photometric == #whiteIs0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   198
		    color := (Color grey:100 - (100 / 255 * value))
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   199
		] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   200
		    photometric == #blackIs0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   201
			color := (Color grey:(100 / 255 * value))
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   202
		    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   203
			photometric == #palette ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   204
			    color := (Color red:(((colorMap at:1) at:index) * 100 / 255)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   205
					  green:(((colorMap at:2) at:index) * 100 / 255)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   206
					   blue:(((colorMap at:3) at:index) * 100 / 255))
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   207
			] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   208
			    self error:'format not supported'.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   209
			    ^ nil
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   210
			]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   211
		    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   212
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   213
		colors at:index put:color
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   214
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   215
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   216
	aBlock value:x value:color
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   217
    ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   218
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
   219
304f026e10cd Initial revision
claus
parents:
diff changeset
   220
!Depth8Image methodsFor:'private'!
304f026e10cd Initial revision
claus
parents:
diff changeset
   221
304f026e10cd Initial revision
claus
parents:
diff changeset
   222
dither1PlaneUsingMap:map on:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   223
    "a helper for dithering palette and greyscale images"
304f026e10cd Initial revision
claus
parents:
diff changeset
   224
304f026e10cd Initial revision
claus
parents:
diff changeset
   225
    |f
304f026e10cd Initial revision
claus
parents:
diff changeset
   226
     patterns formBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   227
     pixel0bytes pixel1bytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   228
     clr ditherPattern
304f026e10cd Initial revision
claus
parents:
diff changeset
   229
     nDither       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   230
     nColors       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   231
     w             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   232
     h             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   233
     v             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   234
     srcIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   235
     dstIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   236
     mask          "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   237
     outBits       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   238
     outCount      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   239
     patternOffset "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   240
     patternBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   241
     patternBits   "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   242
     index         "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   243
     p0            "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   244
     p1            "{Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   245
304f026e10cd Initial revision
claus
parents:
diff changeset
   246
    nColors := map size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   247
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   248
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   249
304f026e10cd Initial revision
claus
parents:
diff changeset
   250
    formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
304f026e10cd Initial revision
claus
parents:
diff changeset
   251
    patterns := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   252
    pixel0bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   253
    pixel1bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   254
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   255
    "
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   256
     extract dither patterns and values to use for 1/0 bits
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   257
     in those from the dithercolors
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   258
    "
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   259
    1 to:nColors do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   260
	clr := (map at:i) on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   261
	ditherPattern := clr ditherForm.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   262
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   263
	ditherPattern isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   264
	    patterns at:i put:#[2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   265
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   266
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   267
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   268
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   269
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   270
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   271
				2r11111111].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   272
	    pixel0bytes at:i put:clr colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   273
	    pixel1bytes at:i put:clr colorId
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   274
	] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   275
	    patterns at:i put:(ditherPattern bits).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   276
	    pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   277
	    pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   278
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   279
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   280
304f026e10cd Initial revision
claus
parents:
diff changeset
   281
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   282
    unsigned char *_srcP, *_dstP;
304f026e10cd Initial revision
claus
parents:
diff changeset
   283
    OBJ _patternBytes;
304f026e10cd Initial revision
claus
parents:
diff changeset
   284
    unsigned char _mask = 0x80;
304f026e10cd Initial revision
claus
parents:
diff changeset
   285
    unsigned char _outBits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   286
    unsigned char _last, _v, _patternBits, _p0, _p1;
304f026e10cd Initial revision
claus
parents:
diff changeset
   287
    int _h, _w;
304f026e10cd Initial revision
claus
parents:
diff changeset
   288
    int _patternOffset = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   289
304f026e10cd Initial revision
claus
parents:
diff changeset
   290
    _srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   291
    _dstP = _ByteArrayInstPtr(formBytes)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   292
    for (_h = _intVal(h); _h; _h--) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   293
	_last = -1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   294
	for (_w = _intVal(w); _w; _w--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   295
	    _v = *_srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   296
	    if (_v != _last) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   297
		_patternBytes = _ArrayInstPtr(patterns)->a_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   298
		if (__isByteArray(_patternBytes)) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   299
		    _patternBits = _ByteArrayInstPtr(_patternBytes)->ba_element[_patternOffset];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   300
		} else if (__isArray(_patternBytes)) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   301
		    _patternBits = _intVal(_ArrayInstPtr(_patternBytes)->a_element[_patternOffset]);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   302
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   303
		_p0 = _ByteArrayInstPtr(pixel0bytes)->ba_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   304
		_p1 = _ByteArrayInstPtr(pixel1bytes)->ba_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   305
		_last = _v;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   306
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   307
	    _outBits <<= 1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   308
	    if (_patternBits & _mask)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   309
		_outBits |= _p1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   310
	    else
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   311
		_outBits |= _p0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   312
	    _mask >>= 1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   313
	    if (_mask == 0) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   314
		_mask = 0x80;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   315
		*_dstP++ = _outBits;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   316
		_outBits = 0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   317
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   318
	}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   319
	if (_mask != 0x80) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   320
	    while (_mask != 0) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   321
		_outBits <<= 1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   322
		_mask >>= 1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   323
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   324
	    *_dstP++ = _outBits;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   325
	    _mask = 0x80;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   326
	    _outBits = 0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   327
	}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   328
	_patternOffset++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   329
	if (_patternOffset == 8)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   330
	    _patternOffset = 0;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   331
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   332
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   333
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   334
    f := Form width:w height:h fromArray:formBytes.
304f026e10cd Initial revision
claus
parents:
diff changeset
   335
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   336
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   337
304f026e10cd Initial revision
claus
parents:
diff changeset
   338
dither2PlaneUsingMap:map on:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   339
    "a helper for dithering palette and greyscale images"
304f026e10cd Initial revision
claus
parents:
diff changeset
   340
304f026e10cd Initial revision
claus
parents:
diff changeset
   341
    |f
304f026e10cd Initial revision
claus
parents:
diff changeset
   342
     patterns formBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   343
     pixel0bytes pixel1bytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   344
     clr ditherPattern
304f026e10cd Initial revision
claus
parents:
diff changeset
   345
     nDither       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   346
     nColors       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   347
     w             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   348
     h             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   349
     v             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   350
     srcIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   351
     dstIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   352
     mask          "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   353
     outBits       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   354
     outCount      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   355
     patternOffset "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   356
     patternBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
   357
     patternBits   "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   358
     index         "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   359
     p0            "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   360
     p1            "{Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   361
304f026e10cd Initial revision
claus
parents:
diff changeset
   362
    nColors := map size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   363
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   364
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   365
304f026e10cd Initial revision
claus
parents:
diff changeset
   366
    formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
304f026e10cd Initial revision
claus
parents:
diff changeset
   367
    patterns := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   368
    pixel0bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   369
    pixel1bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   370
304f026e10cd Initial revision
claus
parents:
diff changeset
   371
    "extract dither patterns and values to use for 1/o bits
304f026e10cd Initial revision
claus
parents:
diff changeset
   372
     in those from the dithercolors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   373
304f026e10cd Initial revision
claus
parents:
diff changeset
   374
    1 to:nColors do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   375
	clr := (map at:i) on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   376
	ditherPattern := clr ditherForm.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   377
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   378
	ditherPattern isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   379
	    patterns at:i put:#[2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   380
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   381
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   382
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   383
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   384
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   385
				2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   386
				2r11111111].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   387
	    pixel0bytes at:i put:clr colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   388
	    pixel1bytes at:i put:clr colorId
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   389
	] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   390
	    patterns at:i put:(ditherPattern bits).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   391
	    pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   392
	    pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   393
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   394
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   395
304f026e10cd Initial revision
claus
parents:
diff changeset
   396
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   397
    unsigned char *_srcP, *_dstP;
304f026e10cd Initial revision
claus
parents:
diff changeset
   398
    OBJ _patternBytes;
304f026e10cd Initial revision
claus
parents:
diff changeset
   399
    unsigned char _mask = 0x80;
304f026e10cd Initial revision
claus
parents:
diff changeset
   400
    unsigned char _outBits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   401
    unsigned char _last, _v, _patternBits, _p0, _p1;
304f026e10cd Initial revision
claus
parents:
diff changeset
   402
    int _h, _w;
304f026e10cd Initial revision
claus
parents:
diff changeset
   403
    int _patternOffset = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   404
    int _outCount;
304f026e10cd Initial revision
claus
parents:
diff changeset
   405
304f026e10cd Initial revision
claus
parents:
diff changeset
   406
    _srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   407
    _dstP = _ByteArrayInstPtr(formBytes)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   408
    for (_h = _intVal(h); _h; _h--) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   409
	_last = -1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   410
	_outCount = 0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   411
	for (_w = _intVal(w); _w; _w--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   412
	    _v = *_srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   413
	    if (_v != _last) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   414
		_patternBytes = _ArrayInstPtr(patterns)->a_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   415
		if (__isByteArray(_patternBytes)) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   416
		    _patternBits = _ByteArrayInstPtr(_patternBytes)->ba_element[_patternOffset];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   417
		} else if (__isArray(_patternBytes)) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   418
		    _patternBits = _intVal(_ArrayInstPtr(_patternBytes)->a_element[_patternOffset]);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   419
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   420
		_p0 = _ByteArrayInstPtr(pixel0bytes)->ba_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   421
		_p1 = _ByteArrayInstPtr(pixel1bytes)->ba_element[_v];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   422
		_last = _v;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   423
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   424
	    _outBits <<= 2;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   425
	    if (_patternBits & _mask)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   426
		_outBits |= _p1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   427
	    else
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   428
		_outBits |= _p0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   429
	    _mask >>= 1;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   430
	    _outCount++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   431
	    if (_outCount == 4) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   432
		*_dstP++ = _outBits;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   433
		_outCount = 0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   434
		if (_mask == 0) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   435
		    _mask = 0x80;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   436
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   437
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   438
	}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   439
	if (_outCount) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   440
	    do {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   441
		_outBits <<= 2;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   442
	    } while (++_outCount != 4);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   443
	    *_dstP++ = _outBits;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   444
	}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   445
	_mask = 0x80;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   446
	_outBits = 0;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   447
	_patternOffset++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   448
	if (_patternOffset == 8)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   449
	    _patternOffset = 0;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   450
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   451
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   452
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   453
    f := Form width:w height:h depth:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   454
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   455
    f device drawBits:formBytes depth:2 width:w height:h x:0 y:0
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   456
		 into:f id x:0 y:0 width:w height:h with:f gcId.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   457
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   458
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
   459
304f026e10cd Initial revision
claus
parents:
diff changeset
   460
!Depth8Image methodsFor:'converting palette images'!
304f026e10cd Initial revision
claus
parents:
diff changeset
   461
304f026e10cd Initial revision
claus
parents:
diff changeset
   462
paletteImageAsMonoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   463
    "return a 1-bit monoForm from the palette picture -
304f026e10cd Initial revision
claus
parents:
diff changeset
   464
     the result is a thresholded form, with white for
304f026e10cd Initial revision
claus
parents:
diff changeset
   465
     brightness values above 50%, black below"
304f026e10cd Initial revision
claus
parents:
diff changeset
   466
304f026e10cd Initial revision
claus
parents:
diff changeset
   467
    |monoBits f
304f026e10cd Initial revision
claus
parents:
diff changeset
   468
     map rMap gMap bMap
304f026e10cd Initial revision
claus
parents:
diff changeset
   469
     fast
304f026e10cd Initial revision
claus
parents:
diff changeset
   470
     r g b 
304f026e10cd Initial revision
claus
parents:
diff changeset
   471
     v        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   472
     bitCount "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   473
     bits     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   474
     w        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   475
     h        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   476
     mapSize  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   477
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   478
     dstIndex "{ Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   479
304f026e10cd Initial revision
claus
parents:
diff changeset
   480
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   481
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   482
    monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
   483
304f026e10cd Initial revision
claus
parents:
diff changeset
   484
    rMap := colorMap at:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   485
    gMap := colorMap at:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   486
    bMap := colorMap at:3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   487
    map := ByteArray uninitializedNew:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   488
304f026e10cd Initial revision
claus
parents:
diff changeset
   489
    mapSize := rMap size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   490
    1 to:mapSize do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   491
	r := rMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   492
	r notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   493
	    g := gMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   494
	    b := bMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   495
	    v := ((3 * r) + (6 * g) + (1 * b)) // 10.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   496
	    v := v bitShift:-7. "only keep hi-bit"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   497
	    (v == 1) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   498
		map at:i put:0   "was: 1"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   499
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   500
		map at:i put:1   "was: 0"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   501
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   502
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   503
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   504
304f026e10cd Initial revision
claus
parents:
diff changeset
   505
    fast := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   506
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   507
    register unsigned char *srcPtr, *dstPtr, *mapPtr;
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   508
    register __v, __bits, __bitCount;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   509
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   510
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   511
    extern OBJ ByteArray;
304f026e10cd Initial revision
claus
parents:
diff changeset
   512
35
f1a194c18429 *** empty log message ***
claus
parents: 28
diff changeset
   513
    if (__isByteArray(_INST(bytes)) && __isByteArray(map) && __isByteArray(monoBits)) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   514
	fast = true;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   515
	srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   516
	dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   517
	mapPtr = _ByteArrayInstPtr(map)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   518
	for (i=_intVal(h); i>0; i--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   519
	    __bitCount = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   520
	    __bits = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   521
	    for (j=_intVal(w); j>0; j--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   522
		__v = mapPtr[*srcPtr++];
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   523
		__bits = (__bits<<1) | __v; 
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   524
		__bitCount++;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   525
		if (__bitCount == 8) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   526
		    *dstPtr++ = __bits;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   527
		    __bits = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   528
		    __bitCount = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   529
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   530
	    }
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   531
	    if (__bitCount != 0) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   532
		*dstPtr++ = __bits;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   533
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   534
	}
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   535
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   536
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   537
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   538
    fast ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   539
	srcIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   540
	dstIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   541
	1 to:h do:[:row |
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   542
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   543
	    bitCount := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   544
	    bits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   545
	    1 to:w do:[:col |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   546
		v := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   547
		srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   548
		v := map at:(v + 1).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   549
		bits := (bits bitShift:1) bitOr:v.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   550
		bitCount := bitCount + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   551
		(bitCount == 8) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   552
		    monoBits at:dstIndex put:bits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   553
		    dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   554
		    bits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   555
		    bitCount := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   556
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   557
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   558
	    (bitCount ~~ 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   559
		monoBits at:dstIndex put:bits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   560
		dstIndex := dstIndex + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   561
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   562
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   563
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   564
304f026e10cd Initial revision
claus
parents:
diff changeset
   565
    f := Form width:w height:h depth:1 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   566
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   567
    f initGC.
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   568
"/    (aDevice blackpixel == 0) ifFalse:[
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   569
"/        "have to invert bits"
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   570
"/        f function:#copyInverted
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   571
"/    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   572
    aDevice drawBits:monoBits depth:1 width:w height:h
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   573
		   x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   574
		into:(f id) x:0 y:0 width:w height:h with:(f gcId).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   575
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   576
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   577
304f026e10cd Initial revision
claus
parents:
diff changeset
   578
paletteImageAs2PlaneFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   579
    "return a 2-bit greyForm from the palette picture -
304f026e10cd Initial revision
claus
parents:
diff changeset
   580
     the result is a thresholded form, with white/lightGrey/darkGrey
304f026e10cd Initial revision
claus
parents:
diff changeset
   581
     and black for brightness values 100..75, 75..50, 50..25 and 25..0 %"
304f026e10cd Initial revision
claus
parents:
diff changeset
   582
304f026e10cd Initial revision
claus
parents:
diff changeset
   583
    |twoPlaneBits f
304f026e10cd Initial revision
claus
parents:
diff changeset
   584
     map rMap gMap bMap fast
304f026e10cd Initial revision
claus
parents:
diff changeset
   585
     v        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   586
     bitCount "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   587
     bits     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   588
     w        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   589
     h        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   590
     mapSize  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   591
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   592
     dstIndex "{ Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   593
304f026e10cd Initial revision
claus
parents:
diff changeset
   594
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   595
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   596
    twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
   597
304f026e10cd Initial revision
claus
parents:
diff changeset
   598
    rMap := colorMap at:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   599
    gMap := colorMap at:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   600
    bMap := colorMap at:3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   601
    map := ByteArray uninitializedNew:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   602
    1 to:(rMap size) do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   603
	|r g b v|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   604
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   605
	r := rMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   606
	r notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   607
	    g := gMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   608
	    b := bMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   609
	    v := ((3 * r) + (6 * g) + (1 * b)) // 10.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   610
	    v := v bitShift:-6. "only keep hi-2-bits"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   611
	    map at:i put:v
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   612
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   613
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   614
    fast := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   615
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   616
    register unsigned char *srcPtr, *dstPtr, *mapPtr;
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   617
    register __v, __bits, __bitCount;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   618
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   619
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   620
    extern OBJ ByteArray;
304f026e10cd Initial revision
claus
parents:
diff changeset
   621
35
f1a194c18429 *** empty log message ***
claus
parents: 28
diff changeset
   622
    if ((__isByteArray(_INST(bytes))) && (__isByteArray(map)) && (__isByteArray(twoPlaneBits))) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   623
	fast = true;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   624
	srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   625
	dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   626
	mapPtr = _ByteArrayInstPtr(map)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   627
	for (i=_intVal(h); i>0; i--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   628
	    __bitCount = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   629
	    __bits = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   630
	    for (j=_intVal(w); j>0; j--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   631
		__v = mapPtr[*srcPtr++];
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   632
		__bits = (__bits<<2) | __v; 
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   633
		__bitCount++;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   634
		if (__bitCount == 4) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   635
		    *dstPtr++ = __bits;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   636
		    __bits = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   637
		    __bitCount = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   638
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   639
	    }
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   640
	    if (__bitCount != 0) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   641
		*dstPtr++ = __bits;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   642
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   643
	}
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   644
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   645
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   646
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   647
    fast ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   648
	srcIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   649
	dstIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   650
	1 to:h do:[:row |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   651
	    bitCount := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   652
	    bits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   653
	    1 to:w do:[:col |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   654
		v := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   655
		srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   656
		v := map at:(v + 1).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   657
		bits := (bits bitShift:2) bitOr:v.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   658
		bitCount := bitCount + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   659
		(bitCount == 4) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   660
		    twoPlaneBits at:dstIndex put:bits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   661
		    dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   662
		    bits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   663
		    bitCount := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   664
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   665
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   666
	    (bitCount ~~ 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   667
		twoPlaneBits at:dstIndex put:bits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   668
		dstIndex := dstIndex + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   669
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   670
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   671
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   672
304f026e10cd Initial revision
claus
parents:
diff changeset
   673
    f := Form width:w height:h depth:2 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   674
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   675
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   676
    (aDevice blackpixel == 0) ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   677
	"have to invert bits"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   678
	f function:#copyInverted
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   679
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   680
    aDevice drawBits:twoPlaneBits depth:2 width:w height:h
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   681
		   x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   682
		into:(f id) x:0 y:0 width:w height:h with:(f gcId).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   683
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   684
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   685
304f026e10cd Initial revision
claus
parents:
diff changeset
   686
paletteImageAsPseudoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   687
    "return a pseudoForm from the palette picture. The main work is
304f026e10cd Initial revision
claus
parents:
diff changeset
   688
     in color reduction, when not all colors can be aquired."
304f026e10cd Initial revision
claus
parents:
diff changeset
   689
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   690
    |pseudoBits f gcRound has8BitImage deviceDepth
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   691
     imgMap newImage pxl
16
e142d49e3925 *** empty log message ***
claus
parents: 14
diff changeset
   692
     usedColors usageCounts nUsed map mapIndex rMap gMap bMap
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   693
     fit scale lastOK error
304f026e10cd Initial revision
claus
parents:
diff changeset
   694
     div
304f026e10cd Initial revision
claus
parents:
diff changeset
   695
     shift "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   696
     m     "{Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   697
66
398cf6bfb241 *** empty log message ***
claus
parents: 54
diff changeset
   698
    'D8Image: allocating colors ...' errorPrintNewline.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   699
304f026e10cd Initial revision
claus
parents:
diff changeset
   700
    "find used colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   701
304f026e10cd Initial revision
claus
parents:
diff changeset
   702
    usedColors := bytes usedValues.         "gets us an array filled with used values"
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   703
					   "(could use bytes asBag)"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   704
    nUsed := usedColors max + 1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   705
304f026e10cd Initial revision
claus
parents:
diff changeset
   706
    "sort by usage"
304f026e10cd Initial revision
claus
parents:
diff changeset
   707
    usageCounts := bytes usageCounts.
304f026e10cd Initial revision
claus
parents:
diff changeset
   708
    usageCounts := usedColors asArray collect:[:clr | usageCounts at:(clr + 1)].
304f026e10cd Initial revision
claus
parents:
diff changeset
   709
    usageCounts sort:[:a :b | a > b] with:usedColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   710
304f026e10cd Initial revision
claus
parents:
diff changeset
   711
    "allocate the colors (in order of usage count)"
304f026e10cd Initial revision
claus
parents:
diff changeset
   712
304f026e10cd Initial revision
claus
parents:
diff changeset
   713
    rMap := colorMap at:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   714
    gMap := colorMap at:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   715
    bMap := colorMap at:3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   716
304f026e10cd Initial revision
claus
parents:
diff changeset
   717
    imgMap := Array new:nUsed.
304f026e10cd Initial revision
claus
parents:
diff changeset
   718
304f026e10cd Initial revision
claus
parents:
diff changeset
   719
    "first,  we try to get the exact colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   720
304f026e10cd Initial revision
claus
parents:
diff changeset
   721
    shift := (8 - aDevice bitsPerRGB) negated.
304f026e10cd Initial revision
claus
parents:
diff changeset
   722
    m := (1 bitShift:(aDevice bitsPerRGB)) - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   723
    div := m asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
   724
304f026e10cd Initial revision
claus
parents:
diff changeset
   725
    fit := true.
304f026e10cd Initial revision
claus
parents:
diff changeset
   726
    scale := 100.0 / div.       "to scale 0..255 into 0.0 .. 100.0"
304f026e10cd Initial revision
claus
parents:
diff changeset
   727
    lastOK := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   728
    usedColors do:[:aColorIndex |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   729
	|devColor color
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   730
	 r     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   731
	 g     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   732
	 b     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   733
	 rMask "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   734
	 gMask "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   735
	 bMask "{Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   736
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   737
	fit ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   738
	    gMask := bMask := rMask := m.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   739
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   740
	    mapIndex := aColorIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   741
	    r := rMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   742
	    g := gMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   743
	    b := bMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   744
	    color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   745
			 green:((g bitShift:shift) bitAnd:gMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   746
			  blue:((b bitShift:shift) bitAnd:bMask) * scale.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   747
	    devColor := color exactOn:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   748
	    devColor isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   749
		"no such color - on the first round, do a GC to flush unused
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   750
		 colors - this may help"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   751
		gcRound == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   752
		    ObjectMemory scavenge.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   753
		    devColor := color exactOn:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   754
		    gcRound := 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   755
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   756
		devColor isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   757
		    gcRound == 1 ifTrue:[
75
claus
parents: 71
diff changeset
   758
			'D8Image: force GC for possible color reclamation.' errorPrintNL.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   759
			ObjectMemory markAndSweep.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   760
			devColor := color exactOn:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   761
			gcRound := 2
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   762
		    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   763
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   764
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   765
	    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   766
		imgMap at:mapIndex put:devColor.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   767
		lastOK := lastOK + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   768
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   769
		fit := false
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   770
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   771
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   772
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   773
16
e142d49e3925 *** empty log message ***
claus
parents: 14
diff changeset
   774
    "again, this time allow wrong colors (loop while increasing allowed error)"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   775
304f026e10cd Initial revision
claus
parents:
diff changeset
   776
    fit ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   777
	gcRound := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   778
	error := 10.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   779
	[fit] whileFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   780
	    fit := true.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   781
	    usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   782
		|devColor color
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   783
		 r     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   784
		 g     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   785
		 b     "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   786
		 rMask "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   787
		 gMask "{Class: SmallInteger }"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   788
		 bMask "{Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   789
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   790
		fit ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   791
		    gMask := bMask := rMask := m.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   792
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   793
		    mapIndex := aColorIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   794
		    r := rMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   795
		    g := gMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   796
		    b := bMap at:mapIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   797
		    color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   798
				 green:((g bitShift:shift) bitAnd:gMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   799
				  blue:((b bitShift:shift) bitAnd:bMask) * scale.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   800
		    devColor := color nearestOn:aDevice error:error.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   801
		    devColor isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   802
			"no such color - on the first round, do a GC to flush unused
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   803
			 colors - this may help"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   804
			gcRound == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   805
			    ObjectMemory scavenge.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   806
			    devColor := color nearestOn:aDevice error:error.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   807
			    gcRound := 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   808
			].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   809
			devColor isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   810
			    gcRound == 1 ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
   811
				'D8Image: force GC for possible color reclamation.' errorPrintNL.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   812
				ObjectMemory markAndSweep.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   813
				devColor := color nearestOn:aDevice error:error.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   814
				gcRound := 2
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   815
			    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   816
			]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   817
		    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   818
		    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   819
			imgMap at:mapIndex put:devColor.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   820
			lastOK := lastOK + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   821
		    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   822
			fit := false
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   823
		    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   824
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   825
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   826
	    error := error * 2
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   827
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   828
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   829
	error > 100 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   830
	    'D8Image: not enough colors for a reasonable image' errorPrintNewline
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   831
	] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   832
	    'D8Image: not enough colors for exact picture' errorPrintNewline.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   833
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   834
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   835
304f026e10cd Initial revision
claus
parents:
diff changeset
   836
    "create translation map"
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   837
    map := ByteArray new:256.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   838
    1 to:imgMap size do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   839
	(imgMap at:i) notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   840
	    map at:i put:(imgMap at:i) colorId
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   841
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   842
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   843
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   844
    deviceDepth := aDevice depth.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   845
    deviceDepth == 8 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   846
	has8BitImage := true.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   847
    ] ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   848
	has8BitImage := false.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   849
	aDevice supportedImageFormats do:[:fmt |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   850
	    (fmt at:2) == 8 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   851
		has8BitImage := true.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   852
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   853
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   854
    ].
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   855
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   856
    has8BitImage ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   857
	pseudoBits := ByteArray uninitializedNew:(width * height).
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   858
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   859
	bytes expandPixels:8         "xlate only"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   860
		    width:width 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   861
		   height:height
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   862
		     into:pseudoBits
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   863
		  mapping:map.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   864
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   865
	map := nil.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   866
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   867
	f := Form width:width height:height depth:deviceDepth on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   868
	f isNil ifTrue:[^ nil].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   869
	f colorMap:imgMap. 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   870
	f initGC.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   871
	aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth  
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   872
		   width:width height:height
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   873
		       x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   874
		    into:(f id) x:0 y:0 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   875
		   width:width height:height with:(f gcId).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   876
	^ f
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   877
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   878
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   879
    "
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   880
     slow fall back: convert into appropriate depth image,
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   881
     by looping over each pixel individually
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   882
    "
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   883
    newImage := (Image implementorForDepth:deviceDepth) new.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   884
    newImage width:width.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   885
    newImage height:height.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   886
    newImage bits:(ByteArray uninitializedNew:(height * newImage bytesPerRow)).
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   887
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   888
    0 to:height-1 do:[:row |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   889
	0 to:width-1 do:[:col |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   890
	    pxl := self valueAtX:col y:row.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   891
	    newImage atX:col y:row putValue:(map at:pxl)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   892
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   893
    ].
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   894
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   895
    f := Form width:width height:height depth:deviceDepth on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   896
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   897
    f colorMap:imgMap. 
304f026e10cd Initial revision
claus
parents:
diff changeset
   898
    f initGC.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   899
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   900
    aDevice drawBits:(newImage bits) depth:deviceDepth width:width height:height
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   901
		   x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   902
		into:(f id) x:0 y:0 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   903
	       width:width height:height with:(f gcId).
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   904
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   905
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   906
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   907
304f026e10cd Initial revision
claus
parents:
diff changeset
   908
paletteImageAsGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   909
    "return an 8-bit greyForm from the 8-bit palette picture;
304f026e10cd Initial revision
claus
parents:
diff changeset
   910
     only a translation has to be done"
304f026e10cd Initial revision
claus
parents:
diff changeset
   911
304f026e10cd Initial revision
claus
parents:
diff changeset
   912
    |greyBits f v
304f026e10cd Initial revision
claus
parents:
diff changeset
   913
     nColors "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   914
     r       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   915
     g       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   916
     b       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   917
     map rMap gMap bMap|
304f026e10cd Initial revision
claus
parents:
diff changeset
   918
304f026e10cd Initial revision
claus
parents:
diff changeset
   919
    greyBits := ByteArray uninitializedNew:(width * height).
304f026e10cd Initial revision
claus
parents:
diff changeset
   920
304f026e10cd Initial revision
claus
parents:
diff changeset
   921
    rMap := colorMap at:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   922
    gMap := colorMap at:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   923
    bMap := colorMap at:3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   924
    nColors := rMap size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   925
    map := ByteArray uninitializedNew:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   926
304f026e10cd Initial revision
claus
parents:
diff changeset
   927
    1 to:nColors do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   928
	r := rMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   929
	r notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   930
	    g := gMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   931
	    b := bMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   932
	    v := ((3 * r) + (6 * g) + (1 * b)) // 10.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   933
	    map at:i put:v
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   934
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   935
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   936
    bytes expandPixels:8         "xlate only"
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   937
		width:width 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   938
	       height:height
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   939
		 into:greyBits
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   940
	      mapping:map.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   941
304f026e10cd Initial revision
claus
parents:
diff changeset
   942
    f := Form width:width height:height depth:8 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   943
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   944
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   945
    aDevice drawBits:greyBits depth:8 width:width height:height
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   946
		       x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   947
		    into:(f id) x:0 y:0 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   948
		   width:width height:height with:(f gcId).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   949
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   950
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   951
304f026e10cd Initial revision
claus
parents:
diff changeset
   952
paletteImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   953
    "return a dithered greyForm from the 8-bit palette picture.
304f026e10cd Initial revision
claus
parents:
diff changeset
   954
     works for any destination depth - but is very slow for some."
304f026e10cd Initial revision
claus
parents:
diff changeset
   955
304f026e10cd Initial revision
claus
parents:
diff changeset
   956
    |f 
304f026e10cd Initial revision
claus
parents:
diff changeset
   957
     r g b
304f026e10cd Initial revision
claus
parents:
diff changeset
   958
     map rMap gMap bMap 
304f026e10cd Initial revision
claus
parents:
diff changeset
   959
     run last ditherColors first delta
304f026e10cd Initial revision
claus
parents:
diff changeset
   960
     clr depth
304f026e10cd Initial revision
claus
parents:
diff changeset
   961
     nDither       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   962
     nColors       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   963
     w             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   964
     h             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   965
     v             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   966
     srcIndex      "{Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
   967
304f026e10cd Initial revision
claus
parents:
diff changeset
   968
304f026e10cd Initial revision
claus
parents:
diff changeset
   969
    Transcript showCr:'dithering ..'. Transcript endEntry.
304f026e10cd Initial revision
claus
parents:
diff changeset
   970
304f026e10cd Initial revision
claus
parents:
diff changeset
   971
    nDither := NumberOfDitherColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   972
    ditherColors := Array new:nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
   973
304f026e10cd Initial revision
claus
parents:
diff changeset
   974
    first := (100 / nDither / 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   975
    delta := 100 / nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
   976
    0 to:nDither-1 do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   977
	ditherColors at:i+1 put:(Color grey:(i * delta + first)).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   978
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   979
304f026e10cd Initial revision
claus
parents:
diff changeset
   980
    rMap := colorMap at:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   981
    gMap := colorMap at:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   982
    bMap := colorMap at:3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   983
    nColors := rMap size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   984
    map := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   985
304f026e10cd Initial revision
claus
parents:
diff changeset
   986
    1 to:nColors do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   987
	r := rMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   988
	r notNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   989
	    g := gMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   990
	    b := bMap at:i.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   991
	    v := ((3 * r) + (6 * g) + (1 * b)) asInteger.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   992
	    " v is now in the range 0 .. 2550 "
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   993
	    v := (v * (nDither - 1) // 2550) rounded.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   994
	    " v is now 0 .. nDither-1 "
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   995
	    map at:i put:(ditherColors at:(v + 1))
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   996
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   997
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   998
304f026e10cd Initial revision
claus
parents:
diff changeset
   999
    "tuning - code below is so slooow"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1000
    "get the patterns, fill form bytes here"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1001
304f026e10cd Initial revision
claus
parents:
diff changeset
  1002
    depth := aDevice depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1003
    depth == 1 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1004
	^ self dither1PlaneUsingMap:map on:aDevice
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1005
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1006
    depth == 2 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1007
	^ self dither2PlaneUsingMap:map on:aDevice
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1008
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1009
304f026e10cd Initial revision
claus
parents:
diff changeset
  1010
    "draw each pixel using dither color (let others do the dithering)
304f026e10cd Initial revision
claus
parents:
diff changeset
  1011
     although the code is simple, its very slow"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1012
304f026e10cd Initial revision
claus
parents:
diff changeset
  1013
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1014
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1015
304f026e10cd Initial revision
claus
parents:
diff changeset
  1016
    f := Form width:w height:h depth:depth on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1017
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1018
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1019
304f026e10cd Initial revision
claus
parents:
diff changeset
  1020
    srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1021
    1 to:h do:[:dstY |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1022
	run := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1023
	last := nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1024
	1 to:w do:[:dstX |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1025
	    v := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1026
	    srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1027
	    clr := map at:(v + 1).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1028
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1029
	    clr == last ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1030
		run := run + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1031
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1032
		(run ~~ 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1033
		    f fillRectangleX:dstX-run-1 y:dstY-1 width:run height:1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1034
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1035
		run := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1036
		f paint:clr.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1037
		last := clr
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1038
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1039
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1040
	f fillRectangleX:w-run y:dstY-1 width:run height:1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1041
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1042
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
  1043
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
  1044
304f026e10cd Initial revision
claus
parents:
diff changeset
  1045
!Depth8Image methodsFor:'converting greyscale images'!
304f026e10cd Initial revision
claus
parents:
diff changeset
  1046
304f026e10cd Initial revision
claus
parents:
diff changeset
  1047
greyImageAsMonoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
  1048
    "return a (thresholded) monochrome Form from the picture."
304f026e10cd Initial revision
claus
parents:
diff changeset
  1049
304f026e10cd Initial revision
claus
parents:
diff changeset
  1050
    |bytesPerRow
304f026e10cd Initial revision
claus
parents:
diff changeset
  1051
     bytesPerMonoRow monoData
304f026e10cd Initial revision
claus
parents:
diff changeset
  1052
     pixel       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1053
     byte        "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1054
     mask        "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1055
     srcIndex    "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1056
     dstIndex    "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1057
     nextSrc     "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1058
     nextDst     "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1059
     bitNumber   "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1060
     w           "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1061
     h           "{Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
  1062
304f026e10cd Initial revision
claus
parents:
diff changeset
  1063
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1064
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1065
304f026e10cd Initial revision
claus
parents:
diff changeset
  1066
    bytesPerRow := self bytesPerRow.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1067
    bytesPerMonoRow := w // 8.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1068
    ((w \\ 8) ~~ 0) ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1069
	bytesPerMonoRow := bytesPerMonoRow + 1
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1070
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1071
    monoData := ByteArray uninitializedNew:(bytesPerMonoRow * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1072
304f026e10cd Initial revision
claus
parents:
diff changeset
  1073
    "8 bit -> 1 bit extract; take most significant bit"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1074
304f026e10cd Initial revision
claus
parents:
diff changeset
  1075
    srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1076
    dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1077
    1 to:h do:[:count |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1078
	nextSrc := srcIndex + bytesPerRow.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1079
	nextDst := dstIndex + bytesPerMonoRow.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1080
	bitNumber := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1081
	mask := 2r10000000.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1082
	[bitNumber <= w] whileTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1083
	    byte := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1084
	    pixel := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1085
	    srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1086
	    ((pixel bitAnd:2r10000000) ~~ 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1087
		byte := byte bitOr:mask
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1088
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1089
	    mask := mask bitShift: -1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1090
	    (mask == 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1091
		monoData at:dstIndex put:byte.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1092
		dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1093
		byte := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1094
		mask := 2r10000000
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1095
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1096
	    bitNumber := bitNumber + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1097
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1098
	(mask == 2r10000000) ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1099
	    monoData at:dstIndex put:byte.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1100
	    dstIndex := dstIndex + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1101
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1102
	srcIndex := nextSrc.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1103
	dstIndex := nextDst
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1104
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1105
304f026e10cd Initial revision
claus
parents:
diff changeset
  1106
    ^ Form width:w height:h fromArray:monoData on:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
  1107
!
304f026e10cd Initial revision
claus
parents:
diff changeset
  1108
304f026e10cd Initial revision
claus
parents:
diff changeset
  1109
greyImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
  1110
    "return a dithered greyForm from the grey picture.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1111
     Works for any destination depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1112
     Used to reduce the number of grey levels."
304f026e10cd Initial revision
claus
parents:
diff changeset
  1113
304f026e10cd Initial revision
claus
parents:
diff changeset
  1114
    |f depth
304f026e10cd Initial revision
claus
parents:
diff changeset
  1115
     map pixel0bytes pixel1bytes clr ditherPattern
304f026e10cd Initial revision
claus
parents:
diff changeset
  1116
     last ditherColors nDither first delta patterns formBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
  1117
     w             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1118
     h             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1119
     v             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1120
     run           "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1121
     srcIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1122
     dstIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1123
     mask          "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1124
     outBits       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1125
     patternOffset "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1126
     patternBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
  1127
     patternBits   "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1128
     index         "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1129
     p0            "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1130
     p1            "{Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
  1131
304f026e10cd Initial revision
claus
parents:
diff changeset
  1132
    Transcript showCr:'dithering ..'. Transcript endEntry.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1133
304f026e10cd Initial revision
claus
parents:
diff changeset
  1134
    nDither := NumberOfDitherColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1135
    ditherColors := Array new:nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1136
304f026e10cd Initial revision
claus
parents:
diff changeset
  1137
    first := (100 / nDither / 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1138
    delta := 100 / nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1139
    0 to:nDither-1 do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1140
	ditherColors at:i+1 put:(Color grey:(i * delta + first)).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1141
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1142
304f026e10cd Initial revision
claus
parents:
diff changeset
  1143
    map := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1144
    1 to:256 do:[:i |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1145
	v := i - 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1146
	v := (v * (nDither - 1) // 255) rounded.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1147
	" v is now 0 .. nDither-1 "
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1148
	map at:i put:(ditherColors at:(v + 1))
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1149
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1150
304f026e10cd Initial revision
claus
parents:
diff changeset
  1151
    depth := aDevice depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1152
304f026e10cd Initial revision
claus
parents:
diff changeset
  1153
    "tuning (general code is too slow)
304f026e10cd Initial revision
claus
parents:
diff changeset
  1154
     get the patterns, fill form bytes here"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1155
304f026e10cd Initial revision
claus
parents:
diff changeset
  1156
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1157
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1158
304f026e10cd Initial revision
claus
parents:
diff changeset
  1159
    depth == 1 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1160
	^ self dither1PlaneUsingMap:map on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1161
304f026e10cd Initial revision
claus
parents:
diff changeset
  1162
        
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1163
	formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1164
	patterns := Array new:256.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1165
	pixel0bytes := ByteArray uninitializedNew:256.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1166
	pixel1bytes := ByteArray uninitializedNew:256.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1167
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1168
	"extract dither patterns and values to use for 1/0 bits
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1169
	 in those from the dithercolors"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1170
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1171
	1 to:256 do:[:i |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1172
	    clr := (map at:i) on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1173
	    ditherPattern := clr ditherForm.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1174
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1175
	    ditherPattern isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1176
		patterns at:i put:#[2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1177
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1178
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1179
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1180
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1181
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1182
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1183
				    2r11111111].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1184
		pixel0bytes at:i put:clr colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1185
		pixel1bytes at:i put:clr colorId
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1186
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1187
		patterns at:i put:(ditherPattern bits).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1188
		pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1189
		pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1190
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1191
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1192
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1193
	srcIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1194
	dstIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1195
	mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1196
	outBits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1197
	patternOffset := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1198
	1 to:h do:[:dstY |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1199
	    last := nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1200
	    1 to:w do:[:dstX |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1201
		v := bytes at:srcIndex.                             "pixel value"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1202
		srcIndex := srcIndex + 1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1203
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1204
		v == last ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1205
		    index := v + 1.                                "index into map"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1206
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1207
		    patternBytes := patterns at:index.             "dither pattern for color"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1208
		    patternBits := patternBytes at:patternOffset.  "dither row"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1209
		    p0 := pixel0bytes at:index.                         "value for 0-dither bit"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1210
		    p1 := pixel1bytes at:index.                         "value for 1-dither bit"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1211
		    last := v.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1212
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1213
		outBits := outBits bitShift:1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1214
		(patternBits bitAnd:mask) == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1215
		    outBits := outBits bitOr:p0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1216
		] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1217
		    outBits := outBits bitOr:p1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1218
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1219
		mask := mask bitShift:-1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1220
		mask == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1221
		    mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1222
		    formBytes at:dstIndex put:outBits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1223
		    dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1224
		    outBits := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1225
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1226
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1227
	    mask == 16r80 ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1228
		dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1229
		mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1230
		outBits := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1231
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1232
	    patternOffset := patternOffset + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1233
	    patternOffset == 9 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1234
		patternOffset := 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1235
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1236
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1237
	f := Form width:w height:h fromArray:formBytes.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1238
	^ f
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1239
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1240
304f026e10cd Initial revision
claus
parents:
diff changeset
  1241
    depth == 2 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1242
	^ self dither2PlaneUsingMap:map on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1243
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1244
	formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1245
	patterns := Array new:256.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1246
	pixel0bytes := ByteArray uninitializedNew:256.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1247
	pixel1bytes := ByteArray uninitializedNew:256.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1248
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1249
	"extract dither patterns and values to use for 1/o bits
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1250
	 in those from the dithercolors"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1251
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1252
	1 to:256 do:[:i |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1253
	    clr := (map at:i) on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1254
	    ditherPattern := clr ditherForm.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1255
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1256
	    ditherPattern isNil ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1257
		patterns at:i put:#[2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1258
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1259
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1260
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1261
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1262
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1263
				    2r11111111
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1264
				    2r11111111].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1265
		pixel0bytes at:i put:clr colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1266
		pixel1bytes at:i put:clr colorId
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1267
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1268
		patterns at:i put:(ditherPattern bits).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1269
		pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1270
		pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1271
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1272
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1273
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1274
	srcIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1275
	dstIndex := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1276
	mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1277
	outBits := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1278
	patternOffset := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1279
	1 to:h do:[:dstY |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1280
	    last := nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1281
	    1 to:w do:[:dstX |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1282
		v := bytes at:srcIndex.                             "pixel value"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1283
		srcIndex := srcIndex + 1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1284
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1285
		v == last ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1286
		    index := v + 1.                                "index into map"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1287
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1288
		    patternBytes := patterns at:index.             "dither pattern for color"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1289
		    patternBits := patternBytes at:patternOffset.  "dither row"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1290
		    p0 := pixel0bytes at:index.                         "value for 0-dither bit"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1291
		    p1 := pixel1bytes at:index.                         "value for 1-dither bit"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1292
		    last := v.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1293
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1294
		outBits := outBits bitShift:2.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1295
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1296
		(patternBits bitAnd:mask) == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1297
		    outBits := outBits bitOr:p0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1298
		] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1299
		    outBits := outBits bitOr:p1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1300
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1301
		mask := mask bitShift:-1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1302
		mask == 16r08 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1303
		    formBytes at:dstIndex put:outBits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1304
		    dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1305
		    outBits := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1306
		] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1307
		    mask == 0 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1308
			mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1309
			formBytes at:dstIndex put:outBits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1310
			dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1311
			outBits := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1312
		    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1313
		]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1314
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1315
	    ((mask == 16r80) or:[mask == 16r08]) ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1316
		formBytes at:dstIndex put:outBits.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1317
		dstIndex := dstIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1318
		mask := 16r80.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1319
		outBits := 0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1320
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1321
	    patternOffset := patternOffset + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1322
	    patternOffset == 9 ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1323
		patternOffset := 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1324
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1325
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1326
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1327
	f := Form width:w height:h depth:2.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1328
	f initGC.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1329
	f device drawBits:formBytes depth:2
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1330
		    width:w height:h x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1331
		     into:f id x:0 y:0 width:w height:h with:f gcId.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1332
	^ f
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1333
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1334
304f026e10cd Initial revision
claus
parents:
diff changeset
  1335
    "draw each pixel using dither color (let others do the dithering)
304f026e10cd Initial revision
claus
parents:
diff changeset
  1336
     although the code is simple, its very slow"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1337
304f026e10cd Initial revision
claus
parents:
diff changeset
  1338
    f := Form width:width height:height depth:depth on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1339
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1340
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1341
304f026e10cd Initial revision
claus
parents:
diff changeset
  1342
    srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1343
    1 to:h do:[:dstY |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1344
	run := 0.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1345
	last := nil.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1346
	1 to:w do:[:dstX |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1347
	    |clr v|
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1348
	    v := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1349
	    srcIndex := srcIndex + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1350
	    clr := map at:(v + 1).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1351
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1352
	    clr == last ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1353
		run := run + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1354
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1355
		(run ~~ 0) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1356
		    f fillRectangleX:dstX-run-1 y:dstY-1 width:run height:1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1357
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1358
		run := 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1359
		f paint:clr.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1360
		last := clr
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1361
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1362
	].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1363
	f fillRectangleX:width-run y:dstY-1 width:run height:1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1364
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1365
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
  1366
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
  1367
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1368
!Depth8Image methodsFor:'image manipulations'!
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1369
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1370
flipHorizontal
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1371
    "inplace horizontal flip"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1372
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1373
    |index  "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1374
     h      "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1375
     w      "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1376
     buffer |
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1377
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1378
    w := width - 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1379
    h := height - 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1380
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1381
    buffer := ByteArray new:width.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1382
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1383
    index := 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1384
    0 to:h do:[:row |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1385
	buffer replaceFrom:1 to:width with:bytes startingAt:index.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1386
	buffer reverse.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1387
	bytes replaceFrom:index to:index+w with:buffer startingAt:1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1388
	index := index + w + 1.
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1389
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1390
    "flush device info"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1391
    self restored
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1392
!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1393
304f026e10cd Initial revision
claus
parents:
diff changeset
  1394
magnifyRowFrom:srcBytes offset:srcStart  
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1395
	  into:dstBytes offset:dstStart factor:mX
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1396
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1397
    "magnify a single pixel row - can only magnify by integer factors.
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1398
     Especially tuned for factors 2,3 and 4."
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1399
304f026e10cd Initial revision
claus
parents:
diff changeset
  1400
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
  1401
    REGISTER unsigned char *srcP, *dstP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1402
    REGISTER unsigned char _byte;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1403
    int _mag;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1404
    REGISTER int i;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1405
    int _pixels;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1406
304f026e10cd Initial revision
claus
parents:
diff changeset
  1407
    if (_isSmallInteger(srcStart) && _isSmallInteger(dstStart)
304f026e10cd Initial revision
claus
parents:
diff changeset
  1408
     && _isSmallInteger(_INST(width)) && _isSmallInteger(mX)
35
f1a194c18429 *** empty log message ***
claus
parents: 28
diff changeset
  1409
     && __isByteArray(srcBytes) && __isByteArray(dstBytes)) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1410
	_mag = _intVal(mX);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1411
	srcP = _ByteArrayInstPtr(srcBytes)->ba_element - 1 + _intVal(srcStart);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1412
	dstP = _ByteArrayInstPtr(dstBytes)->ba_element - 1 + _intVal(dstStart);
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1413
	_pixels = _intVal(_INST(width));
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1414
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1415
	switch (_mag) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1416
	    case 1:
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1417
		break;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1418
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1419
	    case 2:
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1420
		/* special code for common case */
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1421
		while (_pixels--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1422
		    _byte = *srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1423
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1424
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1425
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1426
		break;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1427
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1428
	    case 3:
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1429
		/* special code for common case */
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1430
		while (_pixels--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1431
		    _byte = *srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1432
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1433
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1434
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1435
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1436
		break;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1437
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1438
	    case 4:
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1439
		/* special code for common case */
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1440
		while (_pixels--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1441
		    _byte = *srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1442
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1443
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1444
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1445
		    *dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1446
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1447
		break;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1448
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1449
	    default:
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1450
		while (_pixels--) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1451
		    _byte = *srcP++;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1452
		    for (i=_mag; i>0; i--)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1453
			*dstP++ = _byte;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1454
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1455
		break;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1456
	}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1457
	RETURN (self);
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1458
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1459
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
  1460
.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1461
    self primitiveFailed
304f026e10cd Initial revision
claus
parents:
diff changeset
  1462
!
304f026e10cd Initial revision
claus
parents:
diff changeset
  1463
304f026e10cd Initial revision
claus
parents:
diff changeset
  1464
hardMagnifyBy:extent
304f026e10cd Initial revision
claus
parents:
diff changeset
  1465
    "return a new image magnified by extent, aPoint.
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1466
     This is the general magnification method, handling non-integral values"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1467
304f026e10cd Initial revision
claus
parents:
diff changeset
  1468
    |mX mY
304f026e10cd Initial revision
claus
parents:
diff changeset
  1469
     newWidth  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1470
     newHeight "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1471
     w          "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1472
     h         "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1473
     newImage newBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
  1474
     value     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1475
     srcRowIdx "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1476
     srcIndex  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1477
     dstIndex  "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
  1478
304f026e10cd Initial revision
claus
parents:
diff changeset
  1479
    mX := extent x.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1480
    mY := extent y.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1481
    ((mX < 0) or:[mY < 0]) ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1482
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1483
304f026e10cd Initial revision
claus
parents:
diff changeset
  1484
    newWidth := (width * mX) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1485
    newHeight := (height * mY) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1486
304f026e10cd Initial revision
claus
parents:
diff changeset
  1487
    newBytes := ByteArray uninitializedNew:(newWidth * newHeight).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1488
304f026e10cd Initial revision
claus
parents:
diff changeset
  1489
    newImage := self species new.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1490
    newImage bits:newBytes.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1491
    newImage width:newWidth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1492
    newImage height:newHeight.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1493
    newImage photometric:photometric.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1494
    newImage samplesPerPixel:samplesPerPixel.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1495
    newImage bitsPerSample:#(8).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1496
    newImage colorMap:colorMap copy.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1497
304f026e10cd Initial revision
claus
parents:
diff changeset
  1498
    "walk over destination image fetching pixels from source image"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1499
304f026e10cd Initial revision
claus
parents:
diff changeset
  1500
    mY := mY asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1501
    mX := mX asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1502
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
  1503
    unsigned char *_dstP = _ByteArrayInstPtr(newBytes)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1504
    unsigned char *_srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1505
    unsigned char *_srcRowP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1506
    int _width = _intVal(_INST(width));
304f026e10cd Initial revision
claus
parents:
diff changeset
  1507
    int _w = _intVal(newWidth) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1508
    int _h = _intVal(newHeight) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1509
    int _row, _col;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1510
    double _mX = _floatVal(mX);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1511
    double _mY = _floatVal(mY);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1512
304f026e10cd Initial revision
claus
parents:
diff changeset
  1513
    for (_row = 0; _row <= _h; _row++) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1514
	_srcRowP = _srcP + (_width * (int)((double)_row / _mY));
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1515
	for (_col = 0; _col <= _w; _col++) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1516
	    *_dstP++ = _srcRowP[(int)((double)_col / _mX)];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1517
	}
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1518
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1519
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
  1520
.
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1521
"   the above C-code is equivalent to:
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
  1522
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1523
    dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1524
    w := newWidth - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1525
    h := newHeight - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1526
    0 to:h do:[:row |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1527
	srcRowIdx := (width * (row // mY)) + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1528
	0 to:w do:[:col |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1529
	    srcIndex := srcRowIdx + (col // mX).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1530
	    value := bytes at:srcIndex.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1531
	    newBytes at:dstIndex put:value.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1532
	    dstIndex := dstIndex + 1
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1533
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1534
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1535
"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1536
304f026e10cd Initial revision
claus
parents:
diff changeset
  1537
    ^ newImage
304f026e10cd Initial revision
claus
parents:
diff changeset
  1538
! !