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