Depth24Image.st
author claus
Fri, 03 Jun 1994 02:54:39 +0200
changeset 46 7b331e9012fd
parent 38 2652fc96e660
child 54 29a6b2f8e042
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
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
     3
              All Rights Reserved
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
304f026e10cd Initial revision
claus
parents:
diff changeset
    14
         instanceVariableNames:''
304f026e10cd Initial revision
claus
parents:
diff changeset
    15
         classVariableNames:''
304f026e10cd Initial revision
claus
parents:
diff changeset
    16
         poolDictionaries:''
304f026e10cd Initial revision
claus
parents:
diff changeset
    17
         category:'Graphics-Display Objects'
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
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
    22
              All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    23
'!
3
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
    24
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    25
!Depth24Image class methodsFor:'documentation'!
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    26
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    27
copyright
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    28
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    29
 COPYRIGHT (c) 1993 by Claus Gittinger
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    30
              All Rights Reserved
3
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
    31
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    32
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    33
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    34
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    35
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    36
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    37
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    38
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    39
!
3
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
    40
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    41
version
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    42
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    43
$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.5 1994-06-03 00:52:14 claus Exp $
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    44
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    45
!
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    47
documentation
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    48
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    49
    this class represents true-color (24 bit / pixel) images.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    50
    It mainly consists of methods already implemented in Image,
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    51
    reimplemented here for more performance.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    52
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    53
! !
3
c0aaded4ef28 *** empty log message ***
claus
parents: 1
diff changeset
    54
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    55
!Depth24Image methodsFor:'accessing'!
304f026e10cd Initial revision
claus
parents:
diff changeset
    56
304f026e10cd Initial revision
claus
parents:
diff changeset
    57
bitsPerPixel
304f026e10cd Initial revision
claus
parents:
diff changeset
    58
    "return the number of bits per pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    59
304f026e10cd Initial revision
claus
parents:
diff changeset
    60
    ^ 24
304f026e10cd Initial revision
claus
parents:
diff changeset
    61
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    62
304f026e10cd Initial revision
claus
parents:
diff changeset
    63
bitsPerRow
304f026e10cd Initial revision
claus
parents:
diff changeset
    64
    "return the number of bits in one scanline of the image"
304f026e10cd Initial revision
claus
parents:
diff changeset
    65
304f026e10cd Initial revision
claus
parents:
diff changeset
    66
    ^  width * 24
304f026e10cd Initial revision
claus
parents:
diff changeset
    67
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    68
304f026e10cd Initial revision
claus
parents:
diff changeset
    69
bitsPerSample
304f026e10cd Initial revision
claus
parents:
diff changeset
    70
    "return the number of bits per sample.
304f026e10cd Initial revision
claus
parents:
diff changeset
    71
     The return value is an array of bits-per-plane."
304f026e10cd Initial revision
claus
parents:
diff changeset
    72
304f026e10cd Initial revision
claus
parents:
diff changeset
    73
    ^ #(8 8 8)
304f026e10cd Initial revision
claus
parents:
diff changeset
    74
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    75
304f026e10cd Initial revision
claus
parents:
diff changeset
    76
bytesPerRow
304f026e10cd Initial revision
claus
parents:
diff changeset
    77
    "return the number of bytes in one scanline of the image"
304f026e10cd Initial revision
claus
parents:
diff changeset
    78
304f026e10cd Initial revision
claus
parents:
diff changeset
    79
    ^ width * 3
304f026e10cd Initial revision
claus
parents:
diff changeset
    80
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    81
304f026e10cd Initial revision
claus
parents:
diff changeset
    82
samplesPerPixel
304f026e10cd Initial revision
claus
parents:
diff changeset
    83
    "return the number of samples per pixel in the image."
304f026e10cd Initial revision
claus
parents:
diff changeset
    84
304f026e10cd Initial revision
claus
parents:
diff changeset
    85
    ^ 3
304f026e10cd Initial revision
claus
parents:
diff changeset
    86
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    87
304f026e10cd Initial revision
claus
parents:
diff changeset
    88
atX:x y:y
304f026e10cd Initial revision
claus
parents:
diff changeset
    89
    "retrieve a pixel at x/y; return a color.
304f026e10cd Initial revision
claus
parents:
diff changeset
    90
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
    91
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    92
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    93
    |index "{ Class: SmallInteger }"
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    94
     rVal gVal bVal|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    95
304f026e10cd Initial revision
claus
parents:
diff changeset
    96
    index := 1 + (((width * y) + x) * 3).
304f026e10cd Initial revision
claus
parents:
diff changeset
    97
    rVal := bytes at:(index).
304f026e10cd Initial revision
claus
parents:
diff changeset
    98
    gVal := bytes at:(index + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
    99
    bVal := bytes at:(index + 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   100
304f026e10cd Initial revision
claus
parents:
diff changeset
   101
    photometric ~~ #rgb ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   102
        self error:'format not supported'.
304f026e10cd Initial revision
claus
parents:
diff changeset
   103
        ^ nil
304f026e10cd Initial revision
claus
parents:
diff changeset
   104
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   105
    ^ Color red:rVal * 100 / 255
304f026e10cd Initial revision
claus
parents:
diff changeset
   106
          green:gVal * 100 / 255
304f026e10cd Initial revision
claus
parents:
diff changeset
   107
           blue:bVal * 100 / 255
304f026e10cd Initial revision
claus
parents:
diff changeset
   108
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   109
304f026e10cd Initial revision
claus
parents:
diff changeset
   110
valueAtX:x y:y
304f026e10cd Initial revision
claus
parents:
diff changeset
   111
    "retrieve a pixel at x/y; return a color.
304f026e10cd Initial revision
claus
parents:
diff changeset
   112
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
   113
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
   114
304f026e10cd Initial revision
claus
parents:
diff changeset
   115
    |index "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   116
     rVal  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   117
     gVal  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   118
     bVal  "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
   119
304f026e10cd Initial revision
claus
parents:
diff changeset
   120
    index := 1 + (((width * y) + x) * 3).
304f026e10cd Initial revision
claus
parents:
diff changeset
   121
    rVal := bytes at:(index).
304f026e10cd Initial revision
claus
parents:
diff changeset
   122
    gVal := bytes at:(index + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
   123
    bVal := bytes at:(index + 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   124
    ^ (((rVal bitShift:8) bitOr:gVal) bitShift:8) bitOr:bVal
304f026e10cd Initial revision
claus
parents:
diff changeset
   125
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   126
304f026e10cd Initial revision
claus
parents:
diff changeset
   127
atX:x y:y putValue:aPixelValue
304f026e10cd Initial revision
claus
parents:
diff changeset
   128
    "set a pixel at x/y to aPixelValue, which is 24 bits RGB.
304f026e10cd Initial revision
claus
parents:
diff changeset
   129
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
   130
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
   131
304f026e10cd Initial revision
claus
parents:
diff changeset
   132
    |index "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   133
     val   "{ Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   134
304f026e10cd Initial revision
claus
parents:
diff changeset
   135
    index := 1 + (((width * y) + x) * 3).
304f026e10cd Initial revision
claus
parents:
diff changeset
   136
    val := aPixelValue.
304f026e10cd Initial revision
claus
parents:
diff changeset
   137
    bytes at:(index + 2) put:(val bitAnd:16rFF).
304f026e10cd Initial revision
claus
parents:
diff changeset
   138
    val := val bitShift:-8.
304f026e10cd Initial revision
claus
parents:
diff changeset
   139
    bytes at:(index + 1) put:(val bitAnd:16rFF).
304f026e10cd Initial revision
claus
parents:
diff changeset
   140
    val := val bitShift:-8.
304f026e10cd Initial revision
claus
parents:
diff changeset
   141
    bytes at:(index) put:val.
304f026e10cd Initial revision
claus
parents:
diff changeset
   142
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   143
304f026e10cd Initial revision
claus
parents:
diff changeset
   144
atY:y from:xLow to:xHigh do:aBlock
304f026e10cd Initial revision
claus
parents:
diff changeset
   145
    "perform aBlock for each pixel from x1 to x2 in row y.
304f026e10cd Initial revision
claus
parents:
diff changeset
   146
     The block is passed the color at each pixel.
304f026e10cd Initial revision
claus
parents:
diff changeset
   147
     This method allows slighly faster processing of an
304f026e10cd Initial revision
claus
parents:
diff changeset
   148
     image than using atX:y:, since some processing can be
304f026e10cd Initial revision
claus
parents:
diff changeset
   149
     avoided when going from pixel to pixel. However, for
304f026e10cd Initial revision
claus
parents:
diff changeset
   150
     real image processing, specialized methods should be written."
304f026e10cd Initial revision
claus
parents:
diff changeset
   151
304f026e10cd Initial revision
claus
parents:
diff changeset
   152
    |srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   153
     x1       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   154
     x2       "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   155
     rVal     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   156
     gVal     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   157
     bVal     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   158
     lastR lastG lastB lastColor|
304f026e10cd Initial revision
claus
parents:
diff changeset
   159
304f026e10cd Initial revision
claus
parents:
diff changeset
   160
    photometric ~~ #rgb ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   161
        self error:'format not supported'.
304f026e10cd Initial revision
claus
parents:
diff changeset
   162
        ^ nil
304f026e10cd Initial revision
claus
parents:
diff changeset
   163
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   164
304f026e10cd Initial revision
claus
parents:
diff changeset
   165
    x1 := xLow.
304f026e10cd Initial revision
claus
parents:
diff changeset
   166
    x2 := xHigh.
304f026e10cd Initial revision
claus
parents:
diff changeset
   167
304f026e10cd Initial revision
claus
parents:
diff changeset
   168
    srcIndex := 1 + (((width * y) + x1) * 3).
304f026e10cd Initial revision
claus
parents:
diff changeset
   169
304f026e10cd Initial revision
claus
parents:
diff changeset
   170
    x1 to:x2 do:[:x |
304f026e10cd Initial revision
claus
parents:
diff changeset
   171
        rVal := bytes at:(srcIndex).
304f026e10cd Initial revision
claus
parents:
diff changeset
   172
        gVal := bytes at:(srcIndex + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
   173
        bVal := bytes at:(srcIndex + 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   174
        srcIndex := srcIndex + 3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   175
        (rVal == lastR and:[gVal == lastG and:[bVal == lastB]]) ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   176
            lastColor := Color red:rVal * 100 / 255
304f026e10cd Initial revision
claus
parents:
diff changeset
   177
                             green:gVal * 100 / 255
304f026e10cd Initial revision
claus
parents:
diff changeset
   178
                              blue:bVal * 100 / 255.
304f026e10cd Initial revision
claus
parents:
diff changeset
   179
            lastR := rVal.
304f026e10cd Initial revision
claus
parents:
diff changeset
   180
            lastG := gVal.
304f026e10cd Initial revision
claus
parents:
diff changeset
   181
            lastB := bVal.
304f026e10cd Initial revision
claus
parents:
diff changeset
   182
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   183
        aBlock value:x value:lastColor
304f026e10cd Initial revision
claus
parents:
diff changeset
   184
    ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   185
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
   186
304f026e10cd Initial revision
claus
parents:
diff changeset
   187
!Depth24Image methodsFor:'converting rgb images'!
304f026e10cd Initial revision
claus
parents:
diff changeset
   188
304f026e10cd Initial revision
claus
parents:
diff changeset
   189
rgbImageAsGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   190
    "convert an rgb image to a grey image for greyscale displays"
304f026e10cd Initial revision
claus
parents:
diff changeset
   191
304f026e10cd Initial revision
claus
parents:
diff changeset
   192
    |deviceDepth|
304f026e10cd Initial revision
claus
parents:
diff changeset
   193
304f026e10cd Initial revision
claus
parents:
diff changeset
   194
    deviceDepth := aDevice depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
   195
304f026e10cd Initial revision
claus
parents:
diff changeset
   196
    "I have specially tuned methods for monochrome"
304f026e10cd Initial revision
claus
parents:
diff changeset
   197
    (deviceDepth == 1) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   198
        DitherAlgorithm == #error ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   199
            ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   200
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   201
        DitherAlgorithm == #pattern ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   202
            ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   203
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   204
        ^ self rgbImageAsMonoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   205
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   206
304f026e10cd Initial revision
claus
parents:
diff changeset
   207
    "and for 2plane greyscale (i.e. NeXTs)"
304f026e10cd Initial revision
claus
parents:
diff changeset
   208
    (deviceDepth == 2) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   209
        DitherAlgorithm == #error  ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   210
            ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   211
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   212
        DitherAlgorithm == #pattern  ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   213
            ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   214
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   215
        ^ self rgbImageAs2PlaneFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   216
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   217
304f026e10cd Initial revision
claus
parents:
diff changeset
   218
    (deviceDepth == 8) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   219
        ^ self rgbImageAs8BitGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   220
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   221
304f026e10cd Initial revision
claus
parents:
diff changeset
   222
    "mhmh need another converter ...
304f026e10cd Initial revision
claus
parents:
diff changeset
   223
     till then we do:"
304f026e10cd Initial revision
claus
parents:
diff changeset
   224
    DitherAlgorithm == #error  ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   225
        ^ self rgbImageAsErrorDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   226
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   227
    DitherAlgorithm == #pattern  ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   228
        ^ self rgbImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   229
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   230
    ^ self rgbImageAsMonoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   231
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   232
304f026e10cd Initial revision
claus
parents:
diff changeset
   233
rgbImageAsMonoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   234
    "return a 1-bit monochrome form for aDevice from the rgb picture,
304f026e10cd Initial revision
claus
parents:
diff changeset
   235
     using a threshold algorithm. 
304f026e10cd Initial revision
claus
parents:
diff changeset
   236
     (i.e. grey value < 0.5 -> black, grey value >= 0.5 -> white)."
304f026e10cd Initial revision
claus
parents:
diff changeset
   237
304f026e10cd Initial revision
claus
parents:
diff changeset
   238
    |monoBits f
304f026e10cd Initial revision
claus
parents:
diff changeset
   239
     w        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   240
     h        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   241
     r        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   242
     g        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   243
     b        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   244
     v        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   245
     map rMap gMap bMap
304f026e10cd Initial revision
claus
parents:
diff changeset
   246
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   247
     dstIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   248
     bits     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   249
     bitCount "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   250
     fast |
304f026e10cd Initial revision
claus
parents:
diff changeset
   251
304f026e10cd Initial revision
claus
parents:
diff changeset
   252
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   253
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   254
    monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
   255
    fast := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   256
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   257
    register unsigned char *srcPtr, *dstPtr;
304f026e10cd Initial revision
claus
parents:
diff changeset
   258
    register _v, _bits, _bitCount;
304f026e10cd Initial revision
claus
parents:
diff changeset
   259
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   260
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   261
    extern OBJ ByteArray;
304f026e10cd Initial revision
claus
parents:
diff changeset
   262
35
f1a194c18429 *** empty log message ***
claus
parents: 3
diff changeset
   263
    if (__isByteArray(_INST(bytes)) && __isByteArray(monoBits)) {
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   264
        fast = true;
304f026e10cd Initial revision
claus
parents:
diff changeset
   265
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   266
        dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   267
        for (i=_intVal(h); i>0; i--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   268
            _bitCount = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   269
            _bits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   270
            for (j=_intVal(w); j>0; j--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   271
                _bits <<= 1; 
304f026e10cd Initial revision
claus
parents:
diff changeset
   272
304f026e10cd Initial revision
claus
parents:
diff changeset
   273
                _v = (*srcPtr++ * 3);   /* 0.3*r + 0.6*g + b */
304f026e10cd Initial revision
claus
parents:
diff changeset
   274
                _v += (*srcPtr++ * 6);
304f026e10cd Initial revision
claus
parents:
diff changeset
   275
                _v += *srcPtr++;
304f026e10cd Initial revision
claus
parents:
diff changeset
   276
                _v /= 10;
304f026e10cd Initial revision
claus
parents:
diff changeset
   277
                if (_v & 0x80)
304f026e10cd Initial revision
claus
parents:
diff changeset
   278
                    _bits |= 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
   279
304f026e10cd Initial revision
claus
parents:
diff changeset
   280
                _bitCount++;
304f026e10cd Initial revision
claus
parents:
diff changeset
   281
                if (_bitCount == 8) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   282
                    *dstPtr++ = _bits;
304f026e10cd Initial revision
claus
parents:
diff changeset
   283
                    _bits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   284
                    _bitCount = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   285
                }
304f026e10cd Initial revision
claus
parents:
diff changeset
   286
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
   287
            if (_bitCount != 0) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   288
                while (_bitCount++ != 8) _bits <<= 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
   289
                *dstPtr++ = _bits;
304f026e10cd Initial revision
claus
parents:
diff changeset
   290
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
   291
        }
304f026e10cd Initial revision
claus
parents:
diff changeset
   292
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   293
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   294
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   295
    fast ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   296
        srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   297
        dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   298
        1 to:h do:[:row |
304f026e10cd Initial revision
claus
parents:
diff changeset
   299
            bitCount := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   300
            bits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   301
            1 to:w do:[:col |
304f026e10cd Initial revision
claus
parents:
diff changeset
   302
                bits := bits bitShift:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   303
304f026e10cd Initial revision
claus
parents:
diff changeset
   304
                r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   305
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   306
                g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   307
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   308
                b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   309
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   310
                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
304f026e10cd Initial revision
claus
parents:
diff changeset
   311
                ((v bitAnd:16r80) == 0) ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   312
                    bits := bits bitOr:1
304f026e10cd Initial revision
claus
parents:
diff changeset
   313
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   314
                bitCount := bitCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   315
                (bitCount == 8) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   316
                    monoBits at:dstIndex put:bits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   317
                    dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   318
                    bits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   319
                    bitCount := 0
304f026e10cd Initial revision
claus
parents:
diff changeset
   320
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   321
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   322
            (bitCount ~~ 0) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   323
                [bitCount == 8] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   324
                    bitCount := bitCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   325
                    bits := bits bitShift:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   326
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   327
                monoBits at:dstIndex put:bits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   328
                dstIndex := dstIndex + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   329
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   330
        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   331
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   332
304f026e10cd Initial revision
claus
parents:
diff changeset
   333
    f := Form width:w height:h depth:1 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   334
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   335
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   336
    (aDevice blackpixel == 0) ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   337
        "have to invert bits"
304f026e10cd Initial revision
claus
parents:
diff changeset
   338
        f function:#copyInverted
304f026e10cd Initial revision
claus
parents:
diff changeset
   339
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   340
    aDevice drawBits:monoBits depth:1 width:w height:h
304f026e10cd Initial revision
claus
parents:
diff changeset
   341
                   x:0 y:0
304f026e10cd Initial revision
claus
parents:
diff changeset
   342
                into:(f id) x:0 y:0 width:w height:h with:(f gcId).
304f026e10cd Initial revision
claus
parents:
diff changeset
   343
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   344
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   345
304f026e10cd Initial revision
claus
parents:
diff changeset
   346
rgbImageAs2PlaneFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   347
    "return a 2-bit device form for aDevice from the rgb picture,
304f026e10cd Initial revision
claus
parents:
diff changeset
   348
     using a threshold algorithm. 
304f026e10cd Initial revision
claus
parents:
diff changeset
   349
     (i.e. grey value < 0.25 -> black // 0.25..0.5 -> darkgrey //
304f026e10cd Initial revision
claus
parents:
diff changeset
   350
      0.5 .. 0.75 -> lightgrey // > 0.75 -> white)."
304f026e10cd Initial revision
claus
parents:
diff changeset
   351
304f026e10cd Initial revision
claus
parents:
diff changeset
   352
    |twoPlaneBits f
304f026e10cd Initial revision
claus
parents:
diff changeset
   353
     map rMap gMap bMap 
304f026e10cd Initial revision
claus
parents:
diff changeset
   354
     fast
304f026e10cd Initial revision
claus
parents:
diff changeset
   355
     r        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   356
     g        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   357
     b        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   358
     v        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   359
     w        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   360
     h        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   361
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   362
     dstIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   363
     bits     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   364
     bitCount "{ Class: SmallInteger }" |
304f026e10cd Initial revision
claus
parents:
diff changeset
   365
304f026e10cd Initial revision
claus
parents:
diff changeset
   366
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   367
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   368
    twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
   369
304f026e10cd Initial revision
claus
parents:
diff changeset
   370
    fast := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   371
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   372
    register unsigned char *srcPtr, *dstPtr;
304f026e10cd Initial revision
claus
parents:
diff changeset
   373
    register _v, _bits, _bitCount;
304f026e10cd Initial revision
claus
parents:
diff changeset
   374
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   375
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   376
    extern OBJ ByteArray;
304f026e10cd Initial revision
claus
parents:
diff changeset
   377
304f026e10cd Initial revision
claus
parents:
diff changeset
   378
    if ((_Class(_INST(bytes)) == ByteArray)
304f026e10cd Initial revision
claus
parents:
diff changeset
   379
     && (_Class(twoPlaneBits) == ByteArray)) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   380
        fast = true;
304f026e10cd Initial revision
claus
parents:
diff changeset
   381
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   382
        dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   383
        for (i=_intVal(h); i>0; i--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   384
            _bitCount = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   385
            _bits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   386
            for (j=_intVal(w); j>0; j--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   387
                _v = (*srcPtr++ * 3);   /* 0.3*r + 0.6*g + b */
304f026e10cd Initial revision
claus
parents:
diff changeset
   388
                _v += (*srcPtr++ * 6);
304f026e10cd Initial revision
claus
parents:
diff changeset
   389
                _v += *srcPtr++;
304f026e10cd Initial revision
claus
parents:
diff changeset
   390
                _v /= 10;
304f026e10cd Initial revision
claus
parents:
diff changeset
   391
                _bits <<= 2; 
304f026e10cd Initial revision
claus
parents:
diff changeset
   392
                _bits |= (_v >> 6); /* take top 2 bits */
304f026e10cd Initial revision
claus
parents:
diff changeset
   393
                _bitCount++;
304f026e10cd Initial revision
claus
parents:
diff changeset
   394
                if (_bitCount == 4) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   395
                    *dstPtr++ = _bits;
304f026e10cd Initial revision
claus
parents:
diff changeset
   396
                    _bits = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   397
                    _bitCount = 0;
304f026e10cd Initial revision
claus
parents:
diff changeset
   398
                }
304f026e10cd Initial revision
claus
parents:
diff changeset
   399
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
   400
            if (_bitCount != 0) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   401
                while (_bitCount++ != 4) _bits <<= 2;
304f026e10cd Initial revision
claus
parents:
diff changeset
   402
                *dstPtr++ = _bits;
304f026e10cd Initial revision
claus
parents:
diff changeset
   403
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
   404
        }
304f026e10cd Initial revision
claus
parents:
diff changeset
   405
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   406
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   407
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   408
    fast ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   409
        srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   410
        dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   411
        1 to:h do:[:row |
304f026e10cd Initial revision
claus
parents:
diff changeset
   412
            bitCount := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   413
            bits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   414
            1 to:w do:[:col |
304f026e10cd Initial revision
claus
parents:
diff changeset
   415
                r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   416
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   417
                g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   418
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   419
                b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   420
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   421
                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
304f026e10cd Initial revision
claus
parents:
diff changeset
   422
                v := v bitShift:-6. "take 2 hi bits"
304f026e10cd Initial revision
claus
parents:
diff changeset
   423
                bits := (bits bitShift:2) bitOr:v.
304f026e10cd Initial revision
claus
parents:
diff changeset
   424
                bitCount := bitCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   425
                (bitCount == 4) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   426
                    twoPlaneBits at:dstIndex put:bits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   427
                    dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   428
                    bits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   429
                    bitCount := 0
304f026e10cd Initial revision
claus
parents:
diff changeset
   430
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   431
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   432
            (bitCount ~~ 0) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   433
                [bitCount == 4] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   434
                    bitCount := bitCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   435
                    bits := bits bitShift:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   436
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   437
                twoPlaneBits at:dstIndex put:bits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   438
                dstIndex := dstIndex + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   439
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   440
        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   441
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   442
304f026e10cd Initial revision
claus
parents:
diff changeset
   443
    f := Form width:width height:height depth:2 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   444
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   445
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   446
    (aDevice blackpixel == 0) ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   447
        "have to invert bits"
304f026e10cd Initial revision
claus
parents:
diff changeset
   448
        f function:#copyInverted
304f026e10cd Initial revision
claus
parents:
diff changeset
   449
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   450
    aDevice drawBits:twoPlaneBits depth:2 width:width height:height
304f026e10cd Initial revision
claus
parents:
diff changeset
   451
                   x:0 y:0
304f026e10cd Initial revision
claus
parents:
diff changeset
   452
                into:(f id) x:0 y:0 width:width height:height with:(f gcId).
304f026e10cd Initial revision
claus
parents:
diff changeset
   453
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   454
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   455
304f026e10cd Initial revision
claus
parents:
diff changeset
   456
rgbImageAs8BitGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   457
    "return an 8-bit greyForm from the rgb picture"
304f026e10cd Initial revision
claus
parents:
diff changeset
   458
304f026e10cd Initial revision
claus
parents:
diff changeset
   459
    |greyBits f v
304f026e10cd Initial revision
claus
parents:
diff changeset
   460
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   461
     dstIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   462
     fast|
304f026e10cd Initial revision
claus
parents:
diff changeset
   463
304f026e10cd Initial revision
claus
parents:
diff changeset
   464
    greyBits := ByteArray uninitializedNew:(width * height).
304f026e10cd Initial revision
claus
parents:
diff changeset
   465
    fast := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   466
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   467
    register unsigned char *srcPtr, *dstPtr;
304f026e10cd Initial revision
claus
parents:
diff changeset
   468
    register _v;
304f026e10cd Initial revision
claus
parents:
diff changeset
   469
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   470
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   471
    extern OBJ ByteArray;
304f026e10cd Initial revision
claus
parents:
diff changeset
   472
304f026e10cd Initial revision
claus
parents:
diff changeset
   473
    if ((_Class(_INST(bytes)) == ByteArray)
304f026e10cd Initial revision
claus
parents:
diff changeset
   474
     && (_Class(greyBits) == ByteArray)) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   475
        fast = true;
304f026e10cd Initial revision
claus
parents:
diff changeset
   476
        srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   477
        dstPtr = _ByteArrayInstPtr(greyBits)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
   478
        for (i=_intVal(_INST(height)); i>0; i--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   479
            for (j=_intVal(_INST(width)); j>0; j--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
   480
                _v = (*srcPtr * 3);     /* 0.3*r + 0.6*g + b */
304f026e10cd Initial revision
claus
parents:
diff changeset
   481
                _v += (*srcPtr++ * 6);
304f026e10cd Initial revision
claus
parents:
diff changeset
   482
                _v += *srcPtr++;
304f026e10cd Initial revision
claus
parents:
diff changeset
   483
                _v /= 10;
304f026e10cd Initial revision
claus
parents:
diff changeset
   484
                *dstPtr++ = _v >> 4 ;
304f026e10cd Initial revision
claus
parents:
diff changeset
   485
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
   486
        }
304f026e10cd Initial revision
claus
parents:
diff changeset
   487
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
   488
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   489
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   490
    fast ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   491
        srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   492
        dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   493
304f026e10cd Initial revision
claus
parents:
diff changeset
   494
        1 to:height do:[:h |
304f026e10cd Initial revision
claus
parents:
diff changeset
   495
            1 to:width do:[:w |
304f026e10cd Initial revision
claus
parents:
diff changeset
   496
                |v
304f026e10cd Initial revision
claus
parents:
diff changeset
   497
                 r        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   498
                 g        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   499
                 b        "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
   500
304f026e10cd Initial revision
claus
parents:
diff changeset
   501
                r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   502
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   503
                g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   504
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   505
                b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   506
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   507
304f026e10cd Initial revision
claus
parents:
diff changeset
   508
                v := ((3 * r) + (6 * g) + (1 * b)) // 10.
304f026e10cd Initial revision
claus
parents:
diff changeset
   509
                v := v bitShift:-4.
304f026e10cd Initial revision
claus
parents:
diff changeset
   510
                greyBits at:dstIndex put:v.
304f026e10cd Initial revision
claus
parents:
diff changeset
   511
                dstIndex := dstIndex + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   512
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   513
        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   514
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   515
304f026e10cd Initial revision
claus
parents:
diff changeset
   516
    f := Form width:width height:height depth:8 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   517
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   518
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   519
    aDevice drawBits:greyBits depth:8 width:width height:height
304f026e10cd Initial revision
claus
parents:
diff changeset
   520
                       x:0 y:0
304f026e10cd Initial revision
claus
parents:
diff changeset
   521
                    into:(f id) x:0 y:0 
304f026e10cd Initial revision
claus
parents:
diff changeset
   522
                   width:width height:height with:(f gcId).
304f026e10cd Initial revision
claus
parents:
diff changeset
   523
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   524
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   525
304f026e10cd Initial revision
claus
parents:
diff changeset
   526
rgbImageAsPatternDitheredGreyFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   527
    "return a dithered greyForm for aDevice from the palette picture.
304f026e10cd Initial revision
claus
parents:
diff changeset
   528
     works for any destination depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
   529
     A slow algorithm, using draw into the form (which indirectly does
304f026e10cd Initial revision
claus
parents:
diff changeset
   530
     the dither) - should be rewritten."
304f026e10cd Initial revision
claus
parents:
diff changeset
   531
304f026e10cd Initial revision
claus
parents:
diff changeset
   532
    |f depth
304f026e10cd Initial revision
claus
parents:
diff changeset
   533
     nDither       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   534
     nColors       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   535
     v             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   536
     h             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   537
     w             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   538
     srcIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   539
     dstIndex      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   540
     mask          "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   541
     outBits       "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   542
     outCount      "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   543
     patternOffset "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   544
     patternBits   "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   545
     run           "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   546
     r             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   547
     g             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   548
     b             "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   549
     index         "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   550
     p0            "{Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   551
     p1            "{Class: SmallInteger }" 
304f026e10cd Initial revision
claus
parents:
diff changeset
   552
     map last clr
304f026e10cd Initial revision
claus
parents:
diff changeset
   553
     patterns formBytes patternBytes 
304f026e10cd Initial revision
claus
parents:
diff changeset
   554
     pixel0bytes pixel1bytes ditherPattern
304f026e10cd Initial revision
claus
parents:
diff changeset
   555
     ditherColors first delta|
304f026e10cd Initial revision
claus
parents:
diff changeset
   556
304f026e10cd Initial revision
claus
parents:
diff changeset
   557
    Transcript showCr:'dithering ..'. Transcript endEntry.
304f026e10cd Initial revision
claus
parents:
diff changeset
   558
304f026e10cd Initial revision
claus
parents:
diff changeset
   559
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   560
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   561
304f026e10cd Initial revision
claus
parents:
diff changeset
   562
    nDither := NumberOfDitherColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   563
    ditherColors := Array new:nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
   564
304f026e10cd Initial revision
claus
parents:
diff changeset
   565
    first := (100 / nDither / 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   566
    delta := 100 / nDither.
304f026e10cd Initial revision
claus
parents:
diff changeset
   567
    0 to:nDither-1 do:[:i |
304f026e10cd Initial revision
claus
parents:
diff changeset
   568
        ditherColors at:i+1 put:(Color grey:(i * delta + first)).
304f026e10cd Initial revision
claus
parents:
diff changeset
   569
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   570
304f026e10cd Initial revision
claus
parents:
diff changeset
   571
    nColors := 256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   572
    map := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   573
    1 to:256 do:[:i |
304f026e10cd Initial revision
claus
parents:
diff changeset
   574
        v := i - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   575
        " v is now in the range 0 .. 255 "
304f026e10cd Initial revision
claus
parents:
diff changeset
   576
        v := (v * (nDither - 1) // 255) rounded.
304f026e10cd Initial revision
claus
parents:
diff changeset
   577
        " v is now 0 .. nDither-1 "
304f026e10cd Initial revision
claus
parents:
diff changeset
   578
        map at:i put:(ditherColors at:(v + 1))
304f026e10cd Initial revision
claus
parents:
diff changeset
   579
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   580
304f026e10cd Initial revision
claus
parents:
diff changeset
   581
    "tuning - code below is so slooow"
304f026e10cd Initial revision
claus
parents:
diff changeset
   582
304f026e10cd Initial revision
claus
parents:
diff changeset
   583
    "get the patterns, fill form bytes here"
304f026e10cd Initial revision
claus
parents:
diff changeset
   584
304f026e10cd Initial revision
claus
parents:
diff changeset
   585
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   586
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   587
304f026e10cd Initial revision
claus
parents:
diff changeset
   588
    depth := aDevice depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
   589
    depth == 1 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   590
        formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
304f026e10cd Initial revision
claus
parents:
diff changeset
   591
        patterns := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   592
        pixel0bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   593
        pixel1bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   594
304f026e10cd Initial revision
claus
parents:
diff changeset
   595
        "extract dither patterns and values to use for 1/0 bits
304f026e10cd Initial revision
claus
parents:
diff changeset
   596
         in those from the dithercolors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   597
304f026e10cd Initial revision
claus
parents:
diff changeset
   598
        1 to:nColors do:[:i |
304f026e10cd Initial revision
claus
parents:
diff changeset
   599
            clr := (map at:i) on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   600
            ditherPattern := clr ditherForm.
304f026e10cd Initial revision
claus
parents:
diff changeset
   601
304f026e10cd Initial revision
claus
parents:
diff changeset
   602
            ditherPattern isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   603
                patterns at:i put:#[2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   604
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   605
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   606
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   607
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   608
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   609
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   610
                                    2r11111111].
304f026e10cd Initial revision
claus
parents:
diff changeset
   611
                pixel0bytes at:i put:clr colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   612
                pixel1bytes at:i put:clr colorId
304f026e10cd Initial revision
claus
parents:
diff changeset
   613
            ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   614
                patterns at:i put:(ditherPattern bits).
304f026e10cd Initial revision
claus
parents:
diff changeset
   615
                pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   616
                pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   617
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   618
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   619
304f026e10cd Initial revision
claus
parents:
diff changeset
   620
        srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   621
        dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   622
        mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   623
        outBits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   624
        patternOffset := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   625
        1 to:h do:[:dstY |
304f026e10cd Initial revision
claus
parents:
diff changeset
   626
            last := nil.
304f026e10cd Initial revision
claus
parents:
diff changeset
   627
            1 to:w do:[:dstX |
304f026e10cd Initial revision
claus
parents:
diff changeset
   628
                r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   629
                g := bytes at:(srcIndex + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
   630
                b := bytes at:(srcIndex + 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
   631
                srcIndex := srcIndex + 3.
304f026e10cd Initial revision
claus
parents:
diff changeset
   632
304f026e10cd Initial revision
claus
parents:
diff changeset
   633
                v := ((3 * r) + (6 * g) + (1 * b)).                "pixel grey value (*10)"
304f026e10cd Initial revision
claus
parents:
diff changeset
   634
                v == last ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   635
                    index := v // 10 + 1.                          "index into map"
304f026e10cd Initial revision
claus
parents:
diff changeset
   636
304f026e10cd Initial revision
claus
parents:
diff changeset
   637
                    patternBytes := patterns at:index.             "dither pattern for color"
304f026e10cd Initial revision
claus
parents:
diff changeset
   638
                    patternBits := patternBytes at:patternOffset.  "dither row"
304f026e10cd Initial revision
claus
parents:
diff changeset
   639
                    p0 := pixel0bytes at:index.                         "value for 0-dither bit"
304f026e10cd Initial revision
claus
parents:
diff changeset
   640
                    p1 := pixel1bytes at:index.                         "value for 1-dither bit"
304f026e10cd Initial revision
claus
parents:
diff changeset
   641
                    last := v.
304f026e10cd Initial revision
claus
parents:
diff changeset
   642
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   643
                outBits := outBits bitShift:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   644
304f026e10cd Initial revision
claus
parents:
diff changeset
   645
                (patternBits bitAnd:mask) == 0 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   646
                    outBits := outBits bitOr:p0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   647
                ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   648
                    outBits := outBits bitOr:p1
304f026e10cd Initial revision
claus
parents:
diff changeset
   649
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   650
                mask := mask bitShift:-1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   651
                mask == 0 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   652
                    mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   653
                    formBytes at:dstIndex put:outBits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   654
                    dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   655
                    outBits := 0
304f026e10cd Initial revision
claus
parents:
diff changeset
   656
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   657
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   658
            mask == 16r80 ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   659
                [mask == 0] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   660
                    mask := mask bitShift:-1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   661
                    outBits := outBits bitShift:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   662
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   663
                formBytes at:dstIndex put:outBits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   664
                dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   665
                mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   666
                outBits := 0
304f026e10cd Initial revision
claus
parents:
diff changeset
   667
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   668
            patternOffset := patternOffset + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   669
            patternOffset == 9 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   670
                patternOffset := 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   671
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   672
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   673
        f := Form width:w height:h fromArray:formBytes.
304f026e10cd Initial revision
claus
parents:
diff changeset
   674
        ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   675
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   676
304f026e10cd Initial revision
claus
parents:
diff changeset
   677
    depth == 2 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   678
        formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
304f026e10cd Initial revision
claus
parents:
diff changeset
   679
        patterns := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   680
        pixel0bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   681
        pixel1bytes := ByteArray uninitializedNew:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   682
304f026e10cd Initial revision
claus
parents:
diff changeset
   683
        "extract dither patterns and values to use for 1/0 bits
304f026e10cd Initial revision
claus
parents:
diff changeset
   684
         in those from the dithercolors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   685
304f026e10cd Initial revision
claus
parents:
diff changeset
   686
        1 to:nColors do:[:i |
304f026e10cd Initial revision
claus
parents:
diff changeset
   687
            clr := (map at:i) on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   688
            ditherPattern := clr ditherForm.
304f026e10cd Initial revision
claus
parents:
diff changeset
   689
304f026e10cd Initial revision
claus
parents:
diff changeset
   690
            ditherPattern isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   691
                patterns at:i put:#[2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   692
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   693
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   694
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   695
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   696
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   697
                                    2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   698
                                    2r11111111].
304f026e10cd Initial revision
claus
parents:
diff changeset
   699
                pixel0bytes at:i put:clr colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   700
                pixel1bytes at:i put:clr colorId
304f026e10cd Initial revision
claus
parents:
diff changeset
   701
            ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   702
                patterns at:i put:(ditherPattern bits).
304f026e10cd Initial revision
claus
parents:
diff changeset
   703
                pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   704
                pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   705
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   706
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   707
304f026e10cd Initial revision
claus
parents:
diff changeset
   708
        srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   709
        dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   710
        mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   711
        outBits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   712
        patternOffset := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   713
        1 to:h do:[:dstY |
304f026e10cd Initial revision
claus
parents:
diff changeset
   714
            last := nil.
304f026e10cd Initial revision
claus
parents:
diff changeset
   715
            outCount := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   716
            mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   717
            outBits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   718
            1 to:w do:[:dstX |
304f026e10cd Initial revision
claus
parents:
diff changeset
   719
                r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   720
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   721
                g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   722
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   723
                b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   724
                srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   725
304f026e10cd Initial revision
claus
parents:
diff changeset
   726
                v := ((3 * r) + (6 * g) + (1 * b)).                "pixel grey value (*10)"
304f026e10cd Initial revision
claus
parents:
diff changeset
   727
                v == last ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   728
                    index := v // 10 + 1.                          "index into map"
304f026e10cd Initial revision
claus
parents:
diff changeset
   729
304f026e10cd Initial revision
claus
parents:
diff changeset
   730
                    patternBytes := patterns at:index.             "dither pattern for color"
304f026e10cd Initial revision
claus
parents:
diff changeset
   731
                    patternBits := patternBytes at:patternOffset.  "dither row"
304f026e10cd Initial revision
claus
parents:
diff changeset
   732
                    p0 := pixel0bytes at:index.                    "value for 0-dither bit"
304f026e10cd Initial revision
claus
parents:
diff changeset
   733
                    p1 := pixel1bytes at:index.                    "value for 1-dither bit"
304f026e10cd Initial revision
claus
parents:
diff changeset
   734
                    last := v.
304f026e10cd Initial revision
claus
parents:
diff changeset
   735
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   736
                outBits := outBits bitShift:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   737
304f026e10cd Initial revision
claus
parents:
diff changeset
   738
                (patternBits bitAnd:mask) == 0 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   739
                    outBits := outBits bitOr:p0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   740
                ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   741
                    outBits := outBits bitOr:p1
304f026e10cd Initial revision
claus
parents:
diff changeset
   742
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   743
                mask := mask bitShift:-1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   744
                outCount := outCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   745
                outCount == 4 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   746
                    formBytes at:dstIndex put:outBits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   747
                    dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   748
                    outBits := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   749
                    outCount := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   750
                    mask == 0 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   751
                        mask := 16r80.
304f026e10cd Initial revision
claus
parents:
diff changeset
   752
                    ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   753
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   754
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   755
            (outCount == 0) ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   756
                [outCount == 4] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   757
                    outCount := outCount + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   758
                    outBits := outBits bitShift:2.
304f026e10cd Initial revision
claus
parents:
diff changeset
   759
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   760
                formBytes at:dstIndex put:outBits.
304f026e10cd Initial revision
claus
parents:
diff changeset
   761
                dstIndex := dstIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   762
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   763
            patternOffset := patternOffset + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   764
            patternOffset == 9 ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   765
                patternOffset := 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   766
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   767
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   768
        f := Form width:w height:h depth:depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
   769
        f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   770
        f device drawBits:formBytes depth:2
304f026e10cd Initial revision
claus
parents:
diff changeset
   771
                    width:w height:h x:0 y:0
304f026e10cd Initial revision
claus
parents:
diff changeset
   772
                     into:f id x:0 y:0 width:w height:h with:f gcId.
304f026e10cd Initial revision
claus
parents:
diff changeset
   773
        ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   774
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   775
304f026e10cd Initial revision
claus
parents:
diff changeset
   776
    "draw each pixel using dither color (let others do the dithering)
304f026e10cd Initial revision
claus
parents:
diff changeset
   777
     although the code is simple, its very slow"
304f026e10cd Initial revision
claus
parents:
diff changeset
   778
304f026e10cd Initial revision
claus
parents:
diff changeset
   779
    f := Form width:w height:h depth:(aDevice depth) on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   780
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   781
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   782
    "draw each pixel using dither color"
304f026e10cd Initial revision
claus
parents:
diff changeset
   783
304f026e10cd Initial revision
claus
parents:
diff changeset
   784
    srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   785
    0 to:h-1 do:[:dstY |
304f026e10cd Initial revision
claus
parents:
diff changeset
   786
        run := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   787
        last := nil.
304f026e10cd Initial revision
claus
parents:
diff changeset
   788
        0 to:w-1 do:[:dstX |
304f026e10cd Initial revision
claus
parents:
diff changeset
   789
            r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   790
            srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   791
            g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   792
            srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   793
            b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   794
            srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   795
304f026e10cd Initial revision
claus
parents:
diff changeset
   796
            v := ((3 * r) + (6 * g) + (1 * b)) // 10.
304f026e10cd Initial revision
claus
parents:
diff changeset
   797
304f026e10cd Initial revision
claus
parents:
diff changeset
   798
            clr := map at:(v + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
   799
304f026e10cd Initial revision
claus
parents:
diff changeset
   800
            clr == last ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   801
                run := run + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   802
            ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   803
                (run ~~ 0) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   804
                    f fillRectangleX:dstX-run y:dstY width:run height:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   805
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   806
                run := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   807
                f paint:clr.
304f026e10cd Initial revision
claus
parents:
diff changeset
   808
                last := clr
304f026e10cd Initial revision
claus
parents:
diff changeset
   809
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   810
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   811
        f fillRectangleX:width-run y:dstY width:run height:1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   812
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   813
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   814
304f026e10cd Initial revision
claus
parents:
diff changeset
   815
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   816
304f026e10cd Initial revision
claus
parents:
diff changeset
   817
rgbImageAsPseudoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   818
    "return a pseudocolor form from the rgb-picture"
304f026e10cd Initial revision
claus
parents:
diff changeset
   819
304f026e10cd Initial revision
claus
parents:
diff changeset
   820
    |pseudoBits f
304f026e10cd Initial revision
claus
parents:
diff changeset
   821
     r        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   822
     g        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   823
     b        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   824
     srcIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   825
     dstIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   826
     rMask    "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   827
     gMask    "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   828
     bMask    "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   829
     redArray greenArray blueArray
304f026e10cd Initial revision
claus
parents:
diff changeset
   830
     dataSize "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   831
     nColors  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   832
     fit fitMap colors color 
304f026e10cd Initial revision
claus
parents:
diff changeset
   833
     fast
304f026e10cd Initial revision
claus
parents:
diff changeset
   834
     colorIndex "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   835
     depth nColorCells|
304f026e10cd Initial revision
claus
parents:
diff changeset
   836
304f026e10cd Initial revision
claus
parents:
diff changeset
   837
    "find used colors; build color-tree"
304f026e10cd Initial revision
claus
parents:
diff changeset
   838
304f026e10cd Initial revision
claus
parents:
diff changeset
   839
    fit := false.                       
304f026e10cd Initial revision
claus
parents:
diff changeset
   840
    fitMap := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   841
    depth := aDevice depth.
304f026e10cd Initial revision
claus
parents:
diff changeset
   842
    nColorCells := aDevice ncells.
304f026e10cd Initial revision
claus
parents:
diff changeset
   843
304f026e10cd Initial revision
claus
parents:
diff changeset
   844
    rMask := 2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   845
    gMask := 2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   846
    bMask := 2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   847
304f026e10cd Initial revision
claus
parents:
diff changeset
   848
    [fit] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   849
        [fitMap] whileFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   850
            srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   851
            redArray := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   852
304f026e10cd Initial revision
claus
parents:
diff changeset
   853
            "find used colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   854
304f026e10cd Initial revision
claus
parents:
diff changeset
   855
            nColors := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   856
            srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   857
            dataSize := bytes size.
304f026e10cd Initial revision
claus
parents:
diff changeset
   858
            [srcIndex < dataSize] whileTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   859
%{
35
f1a194c18429 *** empty log message ***
claus
parents: 3
diff changeset
   860
                if (__isByteArray(_INST(bytes))) {
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   861
                    int sI = _intVal(srcIndex);
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   862
                    unsigned char *cp = _ByteArrayInstPtr(_INST(bytes))->ba_element;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   863
304f026e10cd Initial revision
claus
parents:
diff changeset
   864
                    r = _MKSMALLINT((cp[sI - 1] & _intVal(rMask)) + 1);
304f026e10cd Initial revision
claus
parents:
diff changeset
   865
                    g = _MKSMALLINT((cp[sI]     & _intVal(gMask)) + 1);
304f026e10cd Initial revision
claus
parents:
diff changeset
   866
                    b = _MKSMALLINT((cp[sI + 1] & _intVal(bMask)) + 1);
304f026e10cd Initial revision
claus
parents:
diff changeset
   867
                    srcIndex = _MKSMALLINT(sI + 3);
304f026e10cd Initial revision
claus
parents:
diff changeset
   868
                    fast = true;
304f026e10cd Initial revision
claus
parents:
diff changeset
   869
                } else {
304f026e10cd Initial revision
claus
parents:
diff changeset
   870
                    fast = false;
304f026e10cd Initial revision
claus
parents:
diff changeset
   871
                }
304f026e10cd Initial revision
claus
parents:
diff changeset
   872
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
   873
.
304f026e10cd Initial revision
claus
parents:
diff changeset
   874
                fast ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   875
                    r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   876
                    r := (r bitAnd:rMask) + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   877
                    srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   878
                    g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   879
                    g := (g bitAnd:gMask) + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   880
                    srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   881
                    b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
   882
                    b := (b bitAnd:bMask) + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   883
                    srcIndex := srcIndex + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   884
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   885
304f026e10cd Initial revision
claus
parents:
diff changeset
   886
                greenArray := redArray at:r.
304f026e10cd Initial revision
claus
parents:
diff changeset
   887
                greenArray isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   888
                    greenArray := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   889
                    redArray at:r put:greenArray
304f026e10cd Initial revision
claus
parents:
diff changeset
   890
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   891
                blueArray := greenArray at:g.
304f026e10cd Initial revision
claus
parents:
diff changeset
   892
                blueArray isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   893
                    blueArray := Array new:256.
304f026e10cd Initial revision
claus
parents:
diff changeset
   894
                    greenArray at:g put:blueArray
304f026e10cd Initial revision
claus
parents:
diff changeset
   895
                ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   896
                (blueArray at:b) isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   897
                    blueArray at:b put:true.
304f026e10cd Initial revision
claus
parents:
diff changeset
   898
                    nColors := nColors + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   899
                    (nColors > nColorCells) ifTrue:[
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   900
                        'D24IMAGE: more than ' errorPrint. nColorCells errorPrint. ' colors' errorPrintNL.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   901
                        srcIndex := dataSize + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   902
                    ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   903
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   904
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   905
304f026e10cd Initial revision
claus
parents:
diff changeset
   906
            "again with less color bits if it does not fit colormap"
304f026e10cd Initial revision
claus
parents:
diff changeset
   907
304f026e10cd Initial revision
claus
parents:
diff changeset
   908
            (nColors <= nColorCells) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   909
                fitMap := true
304f026e10cd Initial revision
claus
parents:
diff changeset
   910
            ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   911
                "must try again - cutting off some bits"
304f026e10cd Initial revision
claus
parents:
diff changeset
   912
                (bMask == 2r11111111) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   913
                    bMask := 2r11111110
304f026e10cd Initial revision
claus
parents:
diff changeset
   914
                ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   915
                    rMask := (rMask bitShift:1) bitAnd:2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   916
                    gMask := (gMask bitShift:1) bitAnd:2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   917
                    bMask := (bMask bitShift:1) bitAnd:2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   918
                ].
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   919
                'D24IMAGE: retry with less color resolution' errorPrintNL.
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   920
"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   921
    'masks:' print. rMask print. ' ' print. gMask print. ' ' print.
304f026e10cd Initial revision
claus
parents:
diff changeset
   922
    bMask printNewline
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
   923
"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   924
            ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   925
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   926
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   927
        'D24IMAGE: ' errorPrint. nColors errorPrint. ' colors used' errorPrintNL.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   928
        colors := Array new:nColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
   929
        colorIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   930
304f026e10cd Initial revision
claus
parents:
diff changeset
   931
        "allocate all used colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   932
304f026e10cd Initial revision
claus
parents:
diff changeset
   933
        fit := true.
304f026e10cd Initial revision
claus
parents:
diff changeset
   934
304f026e10cd Initial revision
claus
parents:
diff changeset
   935
        r := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   936
        redArray do:[:greenArray |
304f026e10cd Initial revision
claus
parents:
diff changeset
   937
            (fit and:[greenArray notNil]) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   938
                g := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   939
                greenArray do:[:blueArray |
304f026e10cd Initial revision
claus
parents:
diff changeset
   940
                    (fit and:[blueArray notNil]) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   941
                        b := 0.
304f026e10cd Initial revision
claus
parents:
diff changeset
   942
                        blueArray do:[:x |
304f026e10cd Initial revision
claus
parents:
diff changeset
   943
                            (fit and:[x notNil]) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   944
                                color := Color red:(r * 100.0 / 255.0)
304f026e10cd Initial revision
claus
parents:
diff changeset
   945
                                             green:(g * 100.0 / 255.0)
304f026e10cd Initial revision
claus
parents:
diff changeset
   946
                                              blue:(b * 100.0 / 255.0).
304f026e10cd Initial revision
claus
parents:
diff changeset
   947
                                color := color on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   948
                                color colorId isNil ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   949
                                    fit := false
304f026e10cd Initial revision
claus
parents:
diff changeset
   950
                                ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   951
                                    colors at:colorIndex put:color.
304f026e10cd Initial revision
claus
parents:
diff changeset
   952
                                    colorIndex := colorIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   953
                                    blueArray at:(b + 1) 
304f026e10cd Initial revision
claus
parents:
diff changeset
   954
                                             put:color colorId
304f026e10cd Initial revision
claus
parents:
diff changeset
   955
                                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   956
                            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   957
                            b := b + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   958
                        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   959
                    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   960
                    g := g + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   961
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   962
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   963
            r := r + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
   964
        ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   965
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   966
        "again with less color bits if we did not get all colors"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   967
304f026e10cd Initial revision
claus
parents:
diff changeset
   968
        fit ifFalse:[
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
   969
           'D24IMAGE: still no fit' errorPrintNL.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   970
304f026e10cd Initial revision
claus
parents:
diff changeset
   971
            "free the allocated colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   972
            colors atAllPut:nil.
304f026e10cd Initial revision
claus
parents:
diff changeset
   973
            "a kludge - force immediate freeing of colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
   974
            ObjectMemory scavenge.
304f026e10cd Initial revision
claus
parents:
diff changeset
   975
304f026e10cd Initial revision
claus
parents:
diff changeset
   976
            "cut off one more color-bit - cut off blue first"
304f026e10cd Initial revision
claus
parents:
diff changeset
   977
            (bMask == 2r11111111) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   978
                bMask := 2r11111110
304f026e10cd Initial revision
claus
parents:
diff changeset
   979
            ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   980
                (bMask == 2r11111110) ifTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   981
                    bMask := 2r11111100
304f026e10cd Initial revision
claus
parents:
diff changeset
   982
                ] ifFalse:[
304f026e10cd Initial revision
claus
parents:
diff changeset
   983
                    rMask := (rMask bitShift:1) bitAnd:2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   984
                    gMask := (gMask bitShift:1) bitAnd:2r11111111.
304f026e10cd Initial revision
claus
parents:
diff changeset
   985
                    bMask := (bMask bitShift:1) bitAnd:2r11111111
304f026e10cd Initial revision
claus
parents:
diff changeset
   986
                ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   987
            ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   988
            fitMap := false.
304f026e10cd Initial revision
claus
parents:
diff changeset
   989
            redArray := nil
304f026e10cd Initial revision
claus
parents:
diff changeset
   990
        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
   991
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   992
304f026e10cd Initial revision
claus
parents:
diff changeset
   993
    "create pseudocolor bits and translate"
304f026e10cd Initial revision
claus
parents:
diff changeset
   994
304f026e10cd Initial revision
claus
parents:
diff changeset
   995
    pseudoBits := ByteArray uninitializedNew:(width * height).
304f026e10cd Initial revision
claus
parents:
diff changeset
   996
304f026e10cd Initial revision
claus
parents:
diff changeset
   997
    srcIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   998
    dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
   999
304f026e10cd Initial revision
claus
parents:
diff changeset
  1000
    [srcIndex < dataSize] whileTrue:[
304f026e10cd Initial revision
claus
parents:
diff changeset
  1001
        r := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1002
        r := r bitAnd:rMask.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1003
        srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1004
        g := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1005
        g := g bitAnd:gMask.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1006
        srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1007
        b := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1008
        b := b bitAnd:bMask.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1009
        srcIndex := srcIndex + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1010
        greenArray := redArray at:(r + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1011
        blueArray := greenArray at:(g + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1012
        pseudoBits at:dstIndex put:(blueArray at:(b + 1)).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1013
        dstIndex := dstIndex + 1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1014
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1015
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1016
    f := Form width:width height:height depth:aDevice depth on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1017
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1018
    f colorMap:colors.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1019
    f initGC.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1020
    aDevice drawBits:pseudoBits bitsPerPixel:8 depth:aDevice depth
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1021
               width:width height:height
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1022
                   x:0 y:0
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1023
                into:(f id) x:0 y:0 width:width height:height with:(f gcId).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1024
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
  1025
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
  1026
304f026e10cd Initial revision
claus
parents:
diff changeset
  1027
!Depth24Image methodsFor:'magnification'!
304f026e10cd Initial revision
claus
parents:
diff changeset
  1028
304f026e10cd Initial revision
claus
parents:
diff changeset
  1029
magnifyRowFrom:srcBytes offset:srcStart
304f026e10cd Initial revision
claus
parents:
diff changeset
  1030
          into:dstBytes offset:dstStart factor:mX
304f026e10cd Initial revision
claus
parents:
diff changeset
  1031
304f026e10cd Initial revision
claus
parents:
diff changeset
  1032
    "magnify a single pixel row - can only magnify by integer factors"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1033
304f026e10cd Initial revision
claus
parents:
diff changeset
  1034
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
  1035
    unsigned char *srcP, *dstP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1036
    int _mag;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1037
    REGISTER int i;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1038
    REGISTER unsigned char byte1, byte2, byte3;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1039
    int _pixels;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1040
304f026e10cd Initial revision
claus
parents:
diff changeset
  1041
    if (_isSmallInteger(srcStart) && _isSmallInteger(dstStart)
304f026e10cd Initial revision
claus
parents:
diff changeset
  1042
     && _isSmallInteger(_INST(width)) && _isSmallInteger(mX)
35
f1a194c18429 *** empty log message ***
claus
parents: 3
diff changeset
  1043
     && __isByteArray(srcBytes) && __isByteArray(dstBytes)) {
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1044
        _mag = _intVal(mX);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1045
        srcP = _ByteArrayInstPtr(srcBytes)->ba_element - 1 + _intVal(srcStart);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1046
        dstP = _ByteArrayInstPtr(dstBytes)->ba_element - 1 + _intVal(dstStart);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1047
        _pixels = _intVal(_INST(width));
304f026e10cd Initial revision
claus
parents:
diff changeset
  1048
304f026e10cd Initial revision
claus
parents:
diff changeset
  1049
        while (_pixels--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
  1050
            byte1 = *srcP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1051
            byte2 = *(srcP+1);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1052
            byte3 = *(srcP+2);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1053
            srcP += 3;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1054
            for (i=_mag; i>0; i--) {
304f026e10cd Initial revision
claus
parents:
diff changeset
  1055
                *dstP = byte1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1056
                *(dstP+1) = byte2;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1057
                *(dstP+2) = byte3;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1058
                dstP += 3;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1059
            }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1060
        }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1061
        RETURN (self);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1062
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1063
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
  1064
.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1065
    self primitiveFailed
304f026e10cd Initial revision
claus
parents:
diff changeset
  1066
!
304f026e10cd Initial revision
claus
parents:
diff changeset
  1067
304f026e10cd Initial revision
claus
parents:
diff changeset
  1068
hardMagnifyBy:extent
304f026e10cd Initial revision
claus
parents:
diff changeset
  1069
    "return a new image magnified by extent, aPoint.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1070
     This is  the general magnification method, handling non-integral values"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1071
304f026e10cd Initial revision
claus
parents:
diff changeset
  1072
    |mX mY
304f026e10cd Initial revision
claus
parents:
diff changeset
  1073
     newWidth  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1074
     newHeight "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1075
     w         "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1076
     h         "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1077
     newImage newBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
  1078
     value     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1079
     srcRowIdx "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1080
     srcIndex  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1081
     dstIndex  "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
  1082
304f026e10cd Initial revision
claus
parents:
diff changeset
  1083
    mX := extent x.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1084
    mY := extent y.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1085
    ((mX < 0) or:[mY < 0]) ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1086
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1087
304f026e10cd Initial revision
claus
parents:
diff changeset
  1088
    newWidth := (width * mX) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1089
    newHeight := (height * mY) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1090
    newBytes := ByteArray uninitializedNew:(newWidth * 3 * newHeight).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1091
304f026e10cd Initial revision
claus
parents:
diff changeset
  1092
    newImage := self species new.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1093
    newImage bits:newBytes.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1094
    newImage width:newWidth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1095
    newImage height:newHeight.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1096
    newImage photometric:photometric.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1097
    newImage samplesPerPixel:samplesPerPixel.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1098
    newImage bitsPerSample:#(8 8 8).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1099
304f026e10cd Initial revision
claus
parents:
diff changeset
  1100
    "walk over destination image fetching pixels from source image"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1101
304f026e10cd Initial revision
claus
parents:
diff changeset
  1102
    mY := mY asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1103
    mX := mX asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1104
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
  1105
    REGISTER unsigned char *_dstP = _ByteArrayInstPtr(newBytes)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1106
    unsigned char *_srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1107
    unsigned char *_srcRowP, *sP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1108
    int _width3 = _intVal(_INST(width)) * 3;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1109
    int _w = _intVal(newWidth) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1110
    int _h = _intVal(newHeight) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1111
    int _row, _col;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1112
    double _mX = _floatVal(mX);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1113
    double _mY = _floatVal(mY);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1114
304f026e10cd Initial revision
claus
parents:
diff changeset
  1115
    for (_row = 0; _row <= _h; _row++) {
304f026e10cd Initial revision
claus
parents:
diff changeset
  1116
        _srcRowP = _srcP + (_width3 * (int)((double)_row / _mY));
304f026e10cd Initial revision
claus
parents:
diff changeset
  1117
        for (_col = 0; _col <= _w; _col++) {
304f026e10cd Initial revision
claus
parents:
diff changeset
  1118
            sP = _srcRowP + (((int)((double)_col / _mX)) * 3);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1119
            _dstP[0] = sP[0];
304f026e10cd Initial revision
claus
parents:
diff changeset
  1120
            _dstP[1] = sP[1];
304f026e10cd Initial revision
claus
parents:
diff changeset
  1121
            _dstP[2] = sP[2];
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
  1122
            _dstP += 3;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1123
        }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1124
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1125
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
  1126
.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1127
"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1128
    dstIndex := 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1129
    w := newWidth - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1130
    h := newHeight - 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1131
    0 to:h do:[:row |
304f026e10cd Initial revision
claus
parents:
diff changeset
  1132
        srcRowIdx := (width * 3 * (row // mY)) + 1.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1133
        0 to:w do:[:col |
304f026e10cd Initial revision
claus
parents:
diff changeset
  1134
            srcIndex := srcRowIdx + ((col // mX) * 3).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1135
            value := bytes at:srcIndex.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1136
            newBytes at:dstIndex put:value.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1137
            value := bytes at:(srcIndex + 1).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1138
            newBytes at:(dstIndex + 1) put:value.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1139
            value := bytes at:(srcIndex + 2).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1140
            newBytes at:(dstIndex + 2) put:value.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1141
            dstIndex := dstIndex + 3
304f026e10cd Initial revision
claus
parents:
diff changeset
  1142
        ]
304f026e10cd Initial revision
claus
parents:
diff changeset
  1143
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1144
"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1145
    ^ newImage
304f026e10cd Initial revision
claus
parents:
diff changeset
  1146
! !