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