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