Depth8Image.st
author Claus Gittinger <cg@exept.de>
Thu, 25 Apr 1996 18:26:07 +0200
changeset 611 e0442439a3c6
parent 579 e381761190c4
child 634 35e8615373b3
permissions -rw-r--r--
documentation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5
claus
parents: 1
diff changeset
     1
"
claus
parents: 1
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
     3
	      All Rights Reserved
5
claus
parents: 1
diff changeset
     4
claus
parents: 1
diff changeset
     5
 This software is furnished under a license and may be used
claus
parents: 1
diff changeset
     6
 only in accordance with the terms of that license and with the
claus
parents: 1
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
claus
parents: 1
diff changeset
     8
 be provided or otherwise made available to, or used by, any
claus
parents: 1
diff changeset
     9
 other person.  No title to or ownership of the software is
claus
parents: 1
diff changeset
    10
 hereby transferred.
claus
parents: 1
diff changeset
    11
"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    12
304f026e10cd Initial revision
claus
parents:
diff changeset
    13
Image subclass:#Depth8Image
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
!Depth8Image 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
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    25
	      All Rights Reserved
5
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
!
5
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 256-color (8 bit / pixel) images (palette, greyscale ...).
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
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    42
    [author:]
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    43
        Claus Gittinger
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    44
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    45
    [see also:]
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    46
        Depth1Image Depth2Image Depth4Image Depth16Image Depth24Image
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
    47
        ImageReader
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    48
"
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
    49
! !
5
claus
parents: 1
diff changeset
    50
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    51
!Depth8Image class methodsFor:'queries'!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    52
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    53
imageDepth
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
    54
    "return the depth of images represented by instances of
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
    55
     this class - here we return 8"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    56
304f026e10cd Initial revision
claus
parents:
diff changeset
    57
    ^ 8
304f026e10cd Initial revision
claus
parents:
diff changeset
    58
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
    59
    "Modified: 20.4.1996 / 23:40:22 / cg"
81
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    60
! !
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    61
4ba554473294 *** empty log message ***
claus
parents: 75
diff changeset
    62
!Depth8Image methodsFor:'accessing'!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    63
304f026e10cd Initial revision
claus
parents:
diff changeset
    64
atX:x y:y
304f026e10cd Initial revision
claus
parents:
diff changeset
    65
    "retrieve a pixel at x/y; return a color.
304f026e10cd Initial revision
claus
parents:
diff changeset
    66
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
    67
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    68
38
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    69
    |value "{ Class: SmallInteger }"
2652fc96e660 *** empty log message ***
claus
parents: 35
diff changeset
    70
     index "{ Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    71
304f026e10cd Initial revision
claus
parents:
diff changeset
    72
    index := (width * y) + 1 + x.
304f026e10cd Initial revision
claus
parents:
diff changeset
    73
    value := bytes at:index.
304f026e10cd Initial revision
claus
parents:
diff changeset
    74
304f026e10cd Initial revision
claus
parents:
diff changeset
    75
    photometric == #whiteIs0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    76
	^ Color grey:100 - (100 / 255 * value)
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    77
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
    78
    photometric == #blackIs0 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    79
	^ Color grey:(100 / 255 * value)
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    80
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
    81
    photometric ~~ #palette ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    82
	self error:'format not supported'.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
    83
	^ nil
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    84
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
    85
    index := value + 1.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    86
    ^ colorMap at:index
1
304f026e10cd Initial revision
claus
parents:
diff changeset
    87
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    88
304f026e10cd Initial revision
claus
parents:
diff changeset
    89
atX:x y:y putValue:aPixelValue
304f026e10cd Initial revision
claus
parents:
diff changeset
    90
    "set the pixel at x/y to aPixelValue.
304f026e10cd Initial revision
claus
parents:
diff changeset
    91
     Pixels start at x=0 , y=0 for upper left pixel, end at
304f026e10cd Initial revision
claus
parents:
diff changeset
    92
     x = width-1, y=height-1 for lower right pixel"
304f026e10cd Initial revision
claus
parents:
diff changeset
    93
304f026e10cd Initial revision
claus
parents:
diff changeset
    94
    |index "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
    95
304f026e10cd Initial revision
claus
parents:
diff changeset
    96
    index := (width * y) + 1 + x.
304f026e10cd Initial revision
claus
parents:
diff changeset
    97
    bytes at:index put:aPixelValue.
304f026e10cd Initial revision
claus
parents:
diff changeset
    98
!
304f026e10cd Initial revision
claus
parents:
diff changeset
    99
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   100
valueAtX:x y:y
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   101
    "retrieve a pixel at x/y; return a pixelValue.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   102
     Pixels start at x=0 , y=0 for upper left pixel, end at
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   103
     x = width-1, y=height-1 for lower right pixel"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   104
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   105
    |index "{ Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   106
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   107
    index := (width * y) + 1 + x.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   108
    ^ bytes at:index.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   109
! !
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   110
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   111
!Depth8Image methodsFor:'converting greyscale images'!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   112
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   113
greyImageAsMonoFormOn:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   114
    "return a (thresholded) monochrome Form from the picture."
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   115
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   116
    |bytesPerRow
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   117
     bytesPerMonoRow monoData
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   118
     pixel       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   119
     byte        "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   120
     mask        "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   121
     srcIndex    "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   122
     dstIndex    "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   123
     nextSrc     "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   124
     nextDst     "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   125
     bitNumber   "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   126
     w           "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   127
     h           "{Class: SmallInteger }" |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   128
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   129
    w := width.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   130
    h := height.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   131
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   132
    bytesPerRow := self bytesPerRow.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   133
    bytesPerMonoRow := w // 8.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   134
    ((w \\ 8) ~~ 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   135
	bytesPerMonoRow := bytesPerMonoRow + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   136
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   137
    monoData := ByteArray uninitializedNew:(bytesPerMonoRow * h).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   138
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   139
    "8 bit -> 1 bit extract; take most significant bit"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   140
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   141
    srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   142
    dstIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   143
    1 to:h do:[:count |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   144
	nextSrc := srcIndex + bytesPerRow.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   145
	nextDst := dstIndex + bytesPerMonoRow.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   146
	bitNumber := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   147
	mask := 2r10000000.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   148
	[bitNumber <= w] whileTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   149
	    byte := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   150
	    pixel := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   151
	    srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   152
	    ((pixel bitAnd:2r10000000) ~~ 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   153
		byte := byte bitOr:mask
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   154
	    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   155
	    mask := mask bitShift: -1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   156
	    (mask == 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   157
		monoData at:dstIndex put:byte.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   158
		dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   159
		byte := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   160
		mask := 2r10000000
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   161
	    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   162
	    bitNumber := bitNumber + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   163
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   164
	(mask == 2r10000000) ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   165
	    monoData at:dstIndex put:byte.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   166
	    dstIndex := dstIndex + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   167
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   168
	srcIndex := nextSrc.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   169
	dstIndex := nextDst
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   170
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   171
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   172
    ^ Form width:w height:h fromArray:monoData on:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   173
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   174
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   175
greyImageAsPatternDitheredGreyFormOn:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   176
    "return a dithered greyForm from the grey picture.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   177
     Works for any destination depth.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   178
     Used to reduce the number of grey levels."
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   179
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   180
    |f depth
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   181
     map
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   182
     last ditherColors nDither first delta 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   183
"/     pixel0bytes pixel1bytes clr patterns formBytes ditherPattern
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   184
     w             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   185
     h             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   186
     v             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   187
     run           "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   188
     srcIndex      "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   189
"/     dstIndex      "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   190
"/     mask          "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   191
"/     outBits       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   192
"/     patternOffset "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   193
"/     patternBytes
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   194
"/     patternBits   "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   195
"/     index         "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   196
"/     p0            "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   197
"/     p1            "{Class: SmallInteger }" 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   198
    |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   199
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   200
    Transcript showCr:'dithering ..'. Transcript endEntry.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   201
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   202
    nDither := NumberOfDitherColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   203
    ditherColors := Array new:nDither.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   204
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   205
    first := (100 / nDither / 2).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   206
    delta := 100 / nDither.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   207
    0 to:nDither-1 do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   208
	ditherColors at:i+1 put:(Color grey:(i * delta + first)).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   209
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   210
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   211
    map := Array new:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   212
    1 to:256 do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   213
	v := i - 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   214
	v := (v * (nDither - 1) // 255) rounded.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   215
	" v is now 0 .. nDither-1 "
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   216
	map at:i put:(ditherColors at:(v + 1))
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   217
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   218
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   219
    depth := aDevice depth.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   220
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   221
    "tuning (general code is too slow)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   222
     get the patterns, fill form bytes here"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   223
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   224
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   225
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   226
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   227
    depth == 1 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   228
	^ self dither1PlaneUsingMap:map on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   229
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   230
        
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   231
"/      formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   232
"/      patterns := Array new:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   233
"/      pixel0bytes := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   234
"/      pixel1bytes := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   235
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   236
"/      "extract dither patterns and values to use for 1/0 bits
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   237
"/       in those from the dithercolors"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   238
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   239
"/      1 to:256 do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   240
"/          clr := (map at:i) on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   241
"/          ditherPattern := clr ditherForm.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   242
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   243
"/          ditherPattern isNil ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   244
"/              patterns at:i put:#[2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   245
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   246
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   247
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   248
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   249
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   250
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   251
"/                                  2r11111111].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   252
"/              pixel0bytes at:i put:clr colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   253
"/              pixel1bytes at:i put:clr colorId
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   254
"/          ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   255
"/              patterns at:i put:(ditherPattern bits).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   256
"/              pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   257
"/              pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   258
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   259
"/      ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   260
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   261
"/      srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   262
"/      dstIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   263
"/      mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   264
"/      outBits := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   265
"/      patternOffset := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   266
"/      1 to:h do:[:dstY |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   267
"/          last := nil.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   268
"/          1 to:w do:[:dstX |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   269
"/              v := bytes at:srcIndex.                             "pixel value"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   270
"/              srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   271
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   272
"/              v == last ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   273
"/                  index := v + 1.                                "index into map"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   274
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   275
"/                  patternBytes := patterns at:index.             "dither pattern for color"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   276
"/                  patternBits := patternBytes at:patternOffset.  "dither row"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   277
"/                  p0 := pixel0bytes at:index.                         "value for 0-dither bit"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   278
"/                  p1 := pixel1bytes at:index.                         "value for 1-dither bit"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   279
"/                  last := v.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   280
"/              ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   281
"/              outBits := outBits bitShift:1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   282
"/              (patternBits bitAnd:mask) == 0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   283
"/                  outBits := outBits bitOr:p0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   284
"/              ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   285
"/                  outBits := outBits bitOr:p1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   286
"/              ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   287
"/              mask := mask bitShift:-1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   288
"/              mask == 0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   289
"/                  mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   290
"/                  formBytes at:dstIndex put:outBits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   291
"/                  dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   292
"/                  outBits := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   293
"/              ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   294
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   295
"/          mask == 16r80 ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   296
"/              dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   297
"/              mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   298
"/              outBits := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   299
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   300
"/          patternOffset := patternOffset + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   301
"/          patternOffset == 9 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   302
"/              patternOffset := 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   303
"/          ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   304
"/      ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   305
"/      f := Form width:w height:h fromArray:formBytes.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   306
"/      ^ f
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   307
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   308
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   309
    depth == 2 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   310
	^ self dither2PlaneUsingMap:map on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   311
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   312
"/      formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   313
"/      patterns := Array new:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   314
"/      pixel0bytes := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   315
"/      pixel1bytes := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   316
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   317
"/      "extract dither patterns and values to use for 1/o bits
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   318
"/       in those from the dithercolors"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   319
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   320
"/      1 to:256 do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   321
"/          clr := (map at:i) on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   322
"/          ditherPattern := clr ditherForm.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   323
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   324
"/          ditherPattern isNil ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   325
"/              patterns at:i put:#[2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   326
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   327
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   328
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   329
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   330
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   331
"/                                  2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   332
"/                                  2r11111111].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   333
"/              pixel0bytes at:i put:clr colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   334
"/              pixel1bytes at:i put:clr colorId
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   335
"/          ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   336
"/              patterns at:i put:(ditherPattern bits).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   337
"/              pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   338
"/              pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   339
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   340
"/      ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   341
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   342
"/      srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   343
"/      dstIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   344
"/      mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   345
"/      outBits := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   346
"/      patternOffset := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   347
"/      1 to:h do:[:dstY |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   348
"/          last := nil.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   349
"/          1 to:w do:[:dstX |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   350
"/              v := bytes at:srcIndex.                             "pixel value"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   351
"/              srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   352
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   353
"/              v == last ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   354
"/                  index := v + 1.                                "index into map"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   355
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   356
"/                  patternBytes := patterns at:index.             "dither pattern for color"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   357
"/                  patternBits := patternBytes at:patternOffset.  "dither row"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   358
"/                  p0 := pixel0bytes at:index.                         "value for 0-dither bit"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   359
"/                  p1 := pixel1bytes at:index.                         "value for 1-dither bit"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   360
"/                  last := v.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   361
"/              ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   362
"/              outBits := outBits bitShift:2.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   363
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   364
"/              (patternBits bitAnd:mask) == 0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   365
"/                  outBits := outBits bitOr:p0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   366
"/              ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   367
"/                  outBits := outBits bitOr:p1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   368
"/              ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   369
"/              mask := mask bitShift:-1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   370
"/              mask == 16r08 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   371
"/                  formBytes at:dstIndex put:outBits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   372
"/                  dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   373
"/                  outBits := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   374
"/              ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   375
"/                  mask == 0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   376
"/                      mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   377
"/                      formBytes at:dstIndex put:outBits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   378
"/                      dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   379
"/                      outBits := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   380
"/                  ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   381
"/              ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   382
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   383
"/          ((mask == 16r80) or:[mask == 16r08]) ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   384
"/              formBytes at:dstIndex put:outBits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   385
"/              dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   386
"/              mask := 16r80.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   387
"/              outBits := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   388
"/          ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   389
"/          patternOffset := patternOffset + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   390
"/          patternOffset == 9 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   391
"/              patternOffset := 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   392
"/          ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   393
"/      ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   394
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   395
"/      f := Form width:w height:h depth:2.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   396
"/      f initGC.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   397
"/      f device drawBits:formBytes depth:2
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   398
"/                  width:w height:h x:0 y:0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   399
"/                   into:f id x:0 y:0 width:w height:h with:f gcId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   400
"/      ^ f
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   401
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   402
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   403
    "draw each pixel using dither color (let others do the dithering)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   404
     although the code is simple, its very slow"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   405
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   406
    f := Form width:width height:height depth:depth on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   407
    f isNil ifTrue:[^ nil].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   408
    f initGC.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   409
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   410
    srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   411
    1 to:h do:[:dstY |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   412
	run := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   413
	last := nil.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   414
	1 to:w do:[:dstX |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   415
	    |clr v|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   416
	    v := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   417
	    srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   418
	    clr := map at:(v + 1).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   419
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   420
	    clr == last ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   421
		run := run + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   422
	    ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   423
		(run ~~ 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   424
		    f fillRectangleX:dstX-run-1 y:dstY-1 width:run height:1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   425
		].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   426
		run := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   427
		f paint:clr.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   428
		last := clr
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   429
	    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   430
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   431
	f fillRectangleX:width-run y:dstY-1 width:run height:1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   432
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   433
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   434
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
   435
304f026e10cd Initial revision
claus
parents:
diff changeset
   436
!Depth8Image methodsFor:'converting palette images'!
304f026e10cd Initial revision
claus
parents:
diff changeset
   437
304f026e10cd Initial revision
claus
parents:
diff changeset
   438
paletteImageAs2PlaneFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
   439
    "return a 2-bit greyForm from the palette picture -
304f026e10cd Initial revision
claus
parents:
diff changeset
   440
     the result is a thresholded form, with white/lightGrey/darkGrey
304f026e10cd Initial revision
claus
parents:
diff changeset
   441
     and black for brightness values 100..75, 75..50, 50..25 and 25..0 %"
304f026e10cd Initial revision
claus
parents:
diff changeset
   442
304f026e10cd Initial revision
claus
parents:
diff changeset
   443
    |twoPlaneBits f
107
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   444
     map failed
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   445
     w        "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
   446
     h        "{ Class: SmallInteger }"
107
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   447
"/     v        "{ Class: SmallInteger }"
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   448
"/     bitCount "{ Class: SmallInteger }"
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   449
"/     bits     "{ Class: SmallInteger }"
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   450
"/     srcIndex "{ Class: SmallInteger }"
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   451
"/     dstIndex "{ Class: SmallInteger }"
ef48048a8b34 *** empty log message ***
claus
parents: 97
diff changeset
   452
     mapSize  "{ Class: SmallInteger }" |
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   453
304f026e10cd Initial revision
claus
parents:
diff changeset
   454
    w := width.
304f026e10cd Initial revision
claus
parents:
diff changeset
   455
    h := height.
304f026e10cd Initial revision
claus
parents:
diff changeset
   456
    twoPlaneBits := ByteArray uninitializedNew:(((w * 2 + 7) // 8) * h).
304f026e10cd Initial revision
claus
parents:
diff changeset
   457
304f026e10cd Initial revision
claus
parents:
diff changeset
   458
    map := ByteArray uninitializedNew:256.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   459
    mapSize := colorMap size.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   460
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   461
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   462
     map entries: 0 .. 3 give brightness in 4 thresholded steps
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   463
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   464
    1 to:mapSize do:[:i |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   465
	map at:i put:(colorMap at:i) brightness * 3 rounded
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   466
    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   467
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   468
    failed := true.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   469
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
   470
    register unsigned char *srcPtr, *dstPtr, *mapPtr;
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   471
    register __v, __bits, __bitCount;
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   472
    register j;
304f026e10cd Initial revision
claus
parents:
diff changeset
   473
    register i;
304f026e10cd Initial revision
claus
parents:
diff changeset
   474
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   475
    if ((__isByteArray(_INST(bytes)))
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   476
     && (__isByteArray(map))
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   477
     && (__isByteArray(twoPlaneBits))) {
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   478
	failed = false;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   479
	srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   480
	dstPtr = _ByteArrayInstPtr(twoPlaneBits)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   481
	mapPtr = _ByteArrayInstPtr(map)->ba_element;
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   482
	for (i=_intVal(h); i>0; i--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   483
	    __bitCount = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   484
	    __bits = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   485
	    for (j=_intVal(w); j>0; j--) {
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   486
		__v = mapPtr[*srcPtr++];
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   487
		__bits = (__bits<<2) | __v; 
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   488
		__bitCount++;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   489
		if (__bitCount == 4) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   490
		    *dstPtr++ = __bits;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   491
		    __bits = 0;
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   492
		    __bitCount = 0;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   493
		}
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   494
	    }
86
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   495
	    if (__bitCount != 0) {
032006651226 *** empty log message ***
claus
parents: 81
diff changeset
   496
		*dstPtr++ = __bits;
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   497
	    }
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   498
	}
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   499
    }
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   500
%}.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   501
    failed ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   502
"/
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   503
"/ the above code is equivalent to:
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   504
"/
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   505
"/        srcIndex := 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   506
"/        dstIndex := 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   507
"/        1 to:h do:[:row |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   508
"/            bitCount := 0.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   509
"/            bits := 0.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   510
"/            1 to:w do:[:col |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   511
"/                v := bytes at:srcIndex.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   512
"/                srcIndex := srcIndex + 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   513
"/                v := map at:(v + 1).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   514
"/                bits := (bits bitShift:2) bitOr:v.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   515
"/                bitCount := bitCount + 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   516
"/                (bitCount == 4) ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   517
"/                    twoPlaneBits at:dstIndex put:bits.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   518
"/                    dstIndex := dstIndex + 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   519
"/                    bits := 0.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   520
"/                    bitCount := 0
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   521
"/                ]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   522
"/            ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   523
"/            (bitCount ~~ 0) ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   524
"/                twoPlaneBits at:dstIndex put:bits.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   525
"/                dstIndex := dstIndex + 1
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   526
"/            ]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   527
"/        ]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   528
"/
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   529
	self primitiveFailed.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   530
	^ nil
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   531
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   532
304f026e10cd Initial revision
claus
parents:
diff changeset
   533
    f := Form width:w height:h depth:2 on:aDevice.
304f026e10cd Initial revision
claus
parents:
diff changeset
   534
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
   535
    f initGC.
304f026e10cd Initial revision
claus
parents:
diff changeset
   536
    (aDevice blackpixel == 0) ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   537
	"have to invert bits"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   538
	f function:#copyInverted
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   539
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
   540
    aDevice drawBits:twoPlaneBits depth:2 width:w height:h
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   541
		   x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
   542
		into:(f id) x:0 y:0 width:w height:h with:(f gcId).
1
304f026e10cd Initial revision
claus
parents:
diff changeset
   543
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
   544
!
304f026e10cd Initial revision
claus
parents:
diff changeset
   545
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   546
paletteImageAsDitheredPseudoFormOn:aDevice
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   547
    "return a dithered pseudoForm from the palette picture. Depend
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   548
     on dither colors being preallocated (see Color>>getColors*)"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   549
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   550
    ^ self paletteImageAsDitheredPseudoFormOn:aDevice 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   551
	   colors:Color fixColors 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   552
	   nRed:Color numFixRed
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   553
	   nGreen:Color numFixGreen
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   554
	   nBlue:Color numFixBlue
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   555
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   556
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   557
paletteImageAsDitheredPseudoFormOn:aDevice colors:fixColors nRed:nRed nGreen:nGreen nBlue:nBlue 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   558
    "return a dithered pseudoForm from the palette picture. 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   559
     Use the colors in the fixColors array, which must be fixR x fixG x fixB
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   560
     colors assigned to aDevice, such as the preallocated colors of the
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   561
     Color class. 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   562
     By passing the ditherColors as extra array, this method can
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   563
     also be used to dither an 8bit image into a smaller number of colors,
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   564
     for example to create Depth4Images."
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   565
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   566
    "the code below is a q&d hack - it needs a rewrite to use a
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   567
     floyd-steinberg dither (currently, the error is only forwarded
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   568
     to the next pixel on the right, which seems ok for photograph-like
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   569
     images, but leads to more artifacts with equal colored areas).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   570
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   571
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   572
    |pseudoBits f has8BitImage deviceDepth
156
claus
parents: 155
diff changeset
   573
     rgbBytes
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   574
     w     "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   575
     h     "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   576
     index "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   577
     fixR  "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   578
     fixG  "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   579
     fixB  "{Class: SmallInteger }"
156
claus
parents: 155
diff changeset
   580
     fixIds failed map colorMapSize
claus
parents: 155
diff changeset
   581
     error|
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   582
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   583
    aDevice ~~ Display ifTrue:[^ nil].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   584
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   585
    fixR := nRed.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   586
    fixR == 0 ifTrue:[ ^ nil].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   587
    fixG := nGreen.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   588
    fixG == 0 ifTrue:[ ^ nil].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   589
    fixB := nBlue.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   590
    fixB == 0 ifTrue:[ ^ nil].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   591
    "/ simple check
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   592
    (fixR * fixG * fixB) ~~ fixColors size ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   593
	self error:'invalid color array passed'.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   594
	^ nil
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   595
    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   596
    fixIds := (fixColors asArray collect:[:clr | clr colorId]) asByteArray.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   597
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   598
    deviceDepth := aDevice depth.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   599
    deviceDepth == 8 ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   600
	has8BitImage := true.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   601
    ] ifFalse:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   602
	has8BitImage := false.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   603
	aDevice supportedImageFormats do:[:fmt |
235
579f3f804a46 padding info in supportedFormats
Claus Gittinger <cg@exept.de>
parents: 230
diff changeset
   604
	    (fmt at:#bitsPerPixel) == 8 ifTrue:[
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   605
		has8BitImage := true.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   606
	    ]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   607
	]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   608
    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   609
    has8BitImage ifFalse:[^ nil].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   610
151
claus
parents: 134
diff changeset
   611
    'D8IMAGE: dithering ...' infoPrintNL.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   612
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   613
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   614
     collect color components as integer values
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   615
     (code below uses components percent * 2.55 asInteger everywhere, to avoid
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   616
      float arithmetic, rounding etc. Thus, the range is 0..255 here)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   617
    "
156
claus
parents: 155
diff changeset
   618
    colorMapSize := colorMap size.
claus
parents: 155
diff changeset
   619
    rgbBytes := ByteArray uninitializedNew:colorMapSize * 3.
claus
parents: 155
diff changeset
   620
claus
parents: 155
diff changeset
   621
    index := 1.
claus
parents: 155
diff changeset
   622
    1 to:colorMapSize do:[:i |
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   623
	|clr|
156
claus
parents: 155
diff changeset
   624
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   625
	clr := colorMap at:i.
156
claus
parents: 155
diff changeset
   626
	rgbBytes at:index put:(clr red * 2.55) asInteger.
claus
parents: 155
diff changeset
   627
	rgbBytes at:index+1 put:(clr green * 2.55) asInteger.
claus
parents: 155
diff changeset
   628
	rgbBytes at:index+2 put:(clr blue * 2.55) asInteger.
claus
parents: 155
diff changeset
   629
	index := index + 3.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   630
    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   631
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   632
    pseudoBits := ByteArray uninitializedNew:(width * height).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   633
156
claus
parents: 155
diff changeset
   634
    w := width + 2.
claus
parents: 155
diff changeset
   635
    error := ByteArray new:w*(3*2).
claus
parents: 155
diff changeset
   636
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   637
    w := width.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   638
    h := height.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   639
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   640
    failed := true.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   641
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   642
%{
156
claus
parents: 155
diff changeset
   643
/*
claus
parents: 155
diff changeset
   644
 * #   define FLOYD_STEINBERG
claus
parents: 155
diff changeset
   645
 */
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   646
    int __x, __y;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   647
    int __eR, __eG, __eB;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   648
    unsigned char *srcP, *dstP;
156
claus
parents: 155
diff changeset
   649
    unsigned char *rgbP;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   650
    unsigned char *idP;
156
claus
parents: 155
diff changeset
   651
    short *errP, *eP;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   652
    int __fR, __fG, __fB;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   653
    int iR, iG, iB;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   654
    int idx;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   655
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   656
    if (__isByteArray(_INST(bytes))
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   657
     && __isByteArray(pseudoBits)
156
claus
parents: 155
diff changeset
   658
     && __isByteArray(rgbBytes)
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   659
     && __isByteArray(fixIds)
156
claus
parents: 155
diff changeset
   660
     && __isByteArray(error)
97
dd6116883ac0 *** empty log message ***
claus
parents: 89
diff changeset
   661
     && __bothSmallInteger(fixR, fixG)
dd6116883ac0 *** empty log message ***
claus
parents: 89
diff changeset
   662
     && __isSmallInteger(fixB)) {
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   663
	failed = false;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   664
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   665
	srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   666
	dstP = _ByteArrayInstPtr(pseudoBits)->ba_element;
156
claus
parents: 155
diff changeset
   667
	rgbP = _ByteArrayInstPtr(rgbBytes)->ba_element;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   668
	idP = _ByteArrayInstPtr(fixIds)->ba_element;
156
claus
parents: 155
diff changeset
   669
	errP = (short *) _ByteArrayInstPtr(error)->ba_element;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   670
	__fR = _intVal(fixR)-1;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   671
	__fG = _intVal(fixG)-1;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   672
	__fB = _intVal(fixB)-1;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   673
156
claus
parents: 155
diff changeset
   674
#ifdef FLOYD_STEINBERG
claus
parents: 155
diff changeset
   675
	/*
claus
parents: 155
diff changeset
   676
	 * clear error accumulator
claus
parents: 155
diff changeset
   677
	 */
claus
parents: 155
diff changeset
   678
	eP = errP;
claus
parents: 155
diff changeset
   679
	for (__x=_intVal(w)+1; __x>=0; __x--) {
claus
parents: 155
diff changeset
   680
	    eP[0] = 0; eP[1] = 0; eP[2] = 0;
claus
parents: 155
diff changeset
   681
	    eP += 3;
claus
parents: 155
diff changeset
   682
	}
claus
parents: 155
diff changeset
   683
#endif
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   684
	for (__y=_intVal(h); __y>0; __y--) {
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   685
	    __eR = __eG = __eB = 0;
156
claus
parents: 155
diff changeset
   686
#ifdef FLOYD_STEINBERG
claus
parents: 155
diff changeset
   687
	    eP = &(errP[3]);
claus
parents: 155
diff changeset
   688
	    __eR += eP[0];
claus
parents: 155
diff changeset
   689
	    __eG += eP[1];
claus
parents: 155
diff changeset
   690
	    __eB += eP[2];
claus
parents: 155
diff changeset
   691
#endif
claus
parents: 155
diff changeset
   692
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   693
	    for (__x=_intVal(w); __x>0; __x--) {
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   694
		int __want;
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   695
		int pix;
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   696
		int __wantR, __wantG, __wantB;
156
claus
parents: 155
diff changeset
   697
		int idx;
claus
parents: 155
diff changeset
   698
		int tR, tG, tB;
claus
parents: 155
diff changeset
   699
		int nR, nG, nB;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   700
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   701
		pix = *srcP++;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   702
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   703
		/*
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   704
		 * wR, wG and wB is the wanted r/g/b value;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   705
		 * compute the index into the dId table ..
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   706
		 * values: 0..255; scale to 0..fR-1, 0..fG-1, 0..fB-1
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   707
		 *
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   708
		 * bad kludge: knows how to index into FixColor table
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   709
		 */
156
claus
parents: 155
diff changeset
   710
		idx = pix+pix+pix;  /* pix * 3 */
claus
parents: 155
diff changeset
   711
claus
parents: 155
diff changeset
   712
		__wantR = rgbP[idx]   + __eR;
claus
parents: 155
diff changeset
   713
		__wantG = rgbP[idx+1] + __eG;
claus
parents: 155
diff changeset
   714
		__wantB = rgbP[idx+2] + __eB;
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   715
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   716
		if (__wantR > 255) __want = 255;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   717
		else if (__wantR < 0) __want = 0;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   718
		else __want = __wantR;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   719
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   720
		iR = (__want * __fR + 128) / 255; /* red index rounded */
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   721
		idx = iR * (__fG+1);
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   722
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   723
		if (__wantG > 255) __want = 255;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   724
		else if (__wantG < 0) __want = 0;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   725
		else __want = __wantG;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   726
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   727
		iG = (__want * __fG + 128) / 255; /* green index rounded */
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   728
		idx = (idx + iG) * (__fB+1);
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   729
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   730
		if (__wantB > 255) __want = 255;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   731
		else if (__wantB < 0) __want = 0;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   732
		else __want = __wantB;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   733
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   734
		iB = (__want * __fB + 128) / 255; /* blue index rounded */
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   735
		idx = idx + iB;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   736
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   737
		/*
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   738
		 * store the corresponding dither colors colorId
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   739
		 */
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   740
		*dstP++ = idP[idx];
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   741
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   742
		/*
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   743
		 * the new error:
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   744
		 */
156
claus
parents: 155
diff changeset
   745
		__eR = __wantR - (iR * 255 / __fR); 
claus
parents: 155
diff changeset
   746
		__eG = __wantG - (iG * 255 / __fG); 
claus
parents: 155
diff changeset
   747
		__eB = __wantB - (iB * 255 / __fB); 
claus
parents: 155
diff changeset
   748
#ifdef FLOYD_STEINBERG
claus
parents: 155
diff changeset
   749
		/*
claus
parents: 155
diff changeset
   750
		 * distribute the error
claus
parents: 155
diff changeset
   751
		 */
claus
parents: 155
diff changeset
   752
		tR = __eR >> 4;  /* 16th of error */
claus
parents: 155
diff changeset
   753
		tG = __eG >> 4;
claus
parents: 155
diff changeset
   754
		tB = __eB >> 4;
claus
parents: 155
diff changeset
   755
claus
parents: 155
diff changeset
   756
		nR = eP[3] + (tR * 7);/* from accu: error for (x+1 / y) */
claus
parents: 155
diff changeset
   757
		nG = eP[4] + (tG * 7);/* plus 7/16'th of this error */
claus
parents: 155
diff changeset
   758
		nB = eP[5] + (tB * 7);
claus
parents: 155
diff changeset
   759
claus
parents: 155
diff changeset
   760
		eP[0] = tR*5;         /* 5/16th for (x / y+1) */
claus
parents: 155
diff changeset
   761
		eP[1] = tG*5;
claus
parents: 155
diff changeset
   762
		eP[2] = tB*5;
claus
parents: 155
diff changeset
   763
claus
parents: 155
diff changeset
   764
		eP[-3] = tR*3;        /* 3/16th for (x-1 / y+1) */
claus
parents: 155
diff changeset
   765
		eP[-2] = tG*3;
claus
parents: 155
diff changeset
   766
		eP[-1] = tB*3;
claus
parents: 155
diff changeset
   767
claus
parents: 155
diff changeset
   768
		eP[3] = __eR - (tR*15);  /* 1/16th for (x+1 / y+1) */
claus
parents: 155
diff changeset
   769
		eP[4] = __eG - (tG*15);
claus
parents: 155
diff changeset
   770
		eP[5] = __eB - (tB*15);
claus
parents: 155
diff changeset
   771
claus
parents: 155
diff changeset
   772
		__eR = nR;
claus
parents: 155
diff changeset
   773
		__eG = nG;
claus
parents: 155
diff changeset
   774
		__eB = nB;
claus
parents: 155
diff changeset
   775
claus
parents: 155
diff changeset
   776
		eP += 3;
claus
parents: 155
diff changeset
   777
#endif
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   778
	    }
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   779
	}
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   780
    }
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   781
%}.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   782
    failed ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   783
	self primitiveFailed.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   784
	^ nil
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   785
    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   786
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   787
    f := Form width:width height:height depth:deviceDepth on:aDevice.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   788
    f isNil ifTrue:[^ nil].
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   789
    "/
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   790
    "/ have to create a funny colorMap, where
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   791
    "/ color at:index == color colorId:index
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   792
    "/
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   793
    map := Array new:256.
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   794
    fixColors do:[:clr |
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   795
	map at:clr colorId + 1 put:clr
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   796
    ].
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   797
    f colorMap:map. 
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   798
    f initGC.
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   799
    f bits:pseudoBits.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   800
    aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth  
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   801
	       width:width height:height
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   802
		   x:0 y:0
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   803
		into:(f id) x:0 y:0 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   804
	       width:width height:height with:(f gcId).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   805
    ^ f
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   806
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   807
    "
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   808
     example: 
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   809
	color reduction from Depth8 to Depth4 (dithering) can be done by:
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   810
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   811
     |img8 reducedImg8 img4 map form|
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   812
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   813
     map := #( 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   814
		  (0     0   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   815
		  (0     0 100)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   816
		  (0    50   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   817
		  (0    50 100)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   818
		  (0   100   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   819
		  (0   100 100)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   820
		  (100   0   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   821
		  (100   0 100)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   822
		  (100  50   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   823
		  (100  50 100)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   824
		  (100 100   0)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   825
		  (100 100 100)) collect:[:rgb | (Color red:(rgb at:1)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   826
						      green:(rgb at:2)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   827
						       blue:(rgb at:3)) on:Display].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   828
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   829
     img8 := Image fromFile:'bitmaps/bf.im8'.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   830
     form := img8 paletteImageAsDitheredPseudoFormOn:Display 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   831
		      colors:map 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   832
			nRed:2
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   833
		      nGreen:3
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   834
		       nBlue:2.
155
9fdfa550dba1 *** empty log message ***
claus
parents: 154
diff changeset
   835
     img8 := Depth8Image fromForm:form.    'dithered version of original image'.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   836
     img4 := Depth4Image fromImage:img8.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   837
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   838
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   839
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   840
paletteImageAsGreyFormOn:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   841
    "return an 8-bit greyForm from the 8-bit palette picture;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   842
     only a translation has to be done"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   843
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   844
    |greyBits f map
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   845
     mapSize "{ Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   846
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   847
    greyBits := ByteArray uninitializedNew:(width * height).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   848
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   849
    map := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   850
    mapSize := colorMap size.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   851
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   852
    1 to:mapSize do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   853
	map at:i put:((colorMap at:i) brightness * 255) rounded
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   854
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   855
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   856
    bytes expandPixels:8         "xlate only"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   857
		width:width 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   858
	       height:height
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   859
		 into:greyBits
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   860
	      mapping:map.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   861
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   862
    f := Form width:width height:height depth:8 on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   863
    f isNil ifTrue:[^ nil].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   864
    f initGC.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   865
    aDevice drawBits:greyBits depth:8 width:width height:height
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   866
		       x:0 y:0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   867
		    into:(f id) x:0 y:0 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   868
		   width:width height:height with:(f gcId).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   869
    ^ f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   870
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   871
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   872
paletteImageAsMonoFormOn:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   873
    "return a 1-bit monoForm from the palette picture -
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   874
     the result is a thresholded form, with white for
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   875
     brightness values above 50%, black below"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   876
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   877
    |monoBits f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   878
     map
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   879
     failed
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   880
     w        "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   881
     h        "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   882
"/     v        "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   883
"/     bitCount "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   884
"/     bits     "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   885
"/     srcIndex "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   886
"/     dstIndex "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   887
     mapSize  "{ Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   888
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   889
    w := width.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   890
    h := height.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   891
    monoBits := ByteArray uninitializedNew:(((w + 7) // 8) * h).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   892
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   893
    map := ByteArray uninitializedNew:256.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   894
    mapSize := colorMap size.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   895
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   896
    "
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   897
     map entries: 0 for dark entries, 1 for bright entries
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   898
    "
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   899
    1 to:mapSize do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   900
	map at:i put:(colorMap at:i) brightness rounded
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   901
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   902
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   903
    failed := true.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   904
%{
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   905
    register unsigned char *srcPtr, *dstPtr, *mapPtr;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   906
    register __v, __bits, __bitCount;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   907
    register j;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   908
    register i;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   909
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   910
    if (__isByteArray(_INST(bytes))
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   911
     && __isByteArray(map)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   912
     && __isByteArray(monoBits)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   913
	failed = false;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   914
	srcPtr = _ByteArrayInstPtr(_INST(bytes))->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   915
	dstPtr = _ByteArrayInstPtr(monoBits)->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   916
	mapPtr = _ByteArrayInstPtr(map)->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   917
	for (i=_intVal(h); i>0; i--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   918
	    __bitCount = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   919
	    __bits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   920
	    for (j=_intVal(w); j>0; j--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   921
		__v = mapPtr[*srcPtr++];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   922
		__bits = (__bits<<1) | __v; 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   923
		__bitCount++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   924
		if (__bitCount == 8) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   925
		    *dstPtr++ = __bits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   926
		    __bits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   927
		    __bitCount = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   928
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   929
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   930
	    if (__bitCount != 0) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   931
		*dstPtr++ = __bits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   932
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   933
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   934
    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   935
%}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   936
.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   937
    failed ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   938
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   939
"/ the above code is equivalent to:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   940
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   941
"/        srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   942
"/        dstIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   943
"/        1 to:h do:[:row |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   944
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   945
"/            bitCount := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   946
"/            bits := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   947
"/            1 to:w do:[:col |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   948
"/                v := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   949
"/                srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   950
"/                v := map at:(v + 1).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   951
"/                bits := (bits bitShift:1) bitOr:v.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   952
"/                bitCount := bitCount + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   953
"/                (bitCount == 8) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   954
"/                    monoBits at:dstIndex put:bits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   955
"/                    dstIndex := dstIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   956
"/                    bits := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   957
"/                    bitCount := 0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   958
"/                ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   959
"/            ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   960
"/            (bitCount ~~ 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   961
"/                monoBits at:dstIndex put:bits.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   962
"/                dstIndex := dstIndex + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   963
"/            ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   964
"/        ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   965
"/
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   966
"/ we dont need the fall-back code; so trigger an error
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   967
	self primitiveFailed.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   968
	^ nil
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   969
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   970
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   971
    f := Form width:w height:h depth:1 on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   972
    f isNil ifTrue:[^ nil].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   973
    f initGC.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   974
"/    (aDevice blackpixel == 0) ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   975
"/        "have to invert bits"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   976
"/        f function:#copyInverted
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   977
"/    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   978
    aDevice drawBits:monoBits depth:1 width:w height:h
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   979
		   x:0 y:0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   980
		into:(f id) x:0 y:0 width:w height:h with:(f gcId).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   981
    ^ f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   982
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   983
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   984
paletteImageAsPatteredGreyFormOn:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   985
    "return a dithered greyForm from the 8-bit palette picture.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   986
     works for any destination depth - but is very slow for some."
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   987
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   988
    |f 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   989
     map run last ditherColors first delta
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   990
     clr depth grey
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   991
     nDither       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   992
     nColors       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   993
     w             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   994
     h             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   995
     v             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   996
     srcIndex      "{Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   997
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   998
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
   999
    Transcript showCr:'dithering ..'. Transcript endEntry.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1000
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1001
    nDither := NumberOfDitherColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1002
    ditherColors := Array new:nDither.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1003
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1004
    first := (100 / nDither / 2).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1005
    delta := 100 / nDither.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1006
    0 to:nDither-1 do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1007
	ditherColors at:i+1 put:(Color grey:(i * delta + first)).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1008
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1009
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1010
    nColors := colorMap size.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1011
    map := Array new:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1012
    1 to:nColors do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1013
	clr := colorMap at:i.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1014
	grey := clr brightness.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1015
	map at:i put:(ditherColors at:(v * (nDither - 1)) rounded)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1016
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1017
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1018
    "tuning - code below is so slooow"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1019
    "get the patterns, fill form bytes here"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1020
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1021
    depth := aDevice depth.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1022
    depth == 1 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1023
	^ self dither1PlaneUsingMap:map on:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1024
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1025
    depth == 2 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1026
	^ self dither2PlaneUsingMap:map on:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1027
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1028
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1029
    "draw each pixel using dither color (let others do the dithering)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1030
     although the code is simple, its very slow"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1031
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1032
    w := width.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1033
    h := height.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1034
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1035
    f := Form width:w height:h depth:depth on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1036
    f isNil ifTrue:[^ nil].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1037
    f initGC.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1038
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1039
    srcIndex := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1040
    1 to:h do:[:dstY |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1041
	run := 0.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1042
	last := nil.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1043
	1 to:w do:[:dstX |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1044
	    v := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1045
	    srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1046
	    clr := map at:(v + 1).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1047
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1048
	    clr == last ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1049
		run := run + 1
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1050
	    ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1051
		(run ~~ 0) ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1052
		    f fillRectangleX:dstX-run-1 y:dstY-1 width:run height:1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1053
		].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1054
		run := 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1055
		f paint:clr.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1056
		last := clr
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1057
	    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1058
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1059
	f fillRectangleX:w-run y:dstY-1 width:run height:1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1060
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1061
    ^ f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1062
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1063
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1064
paletteImageAsPseudoFormOn:aDevice
304f026e10cd Initial revision
claus
parents:
diff changeset
  1065
    "return a pseudoForm from the palette picture. The main work is
304f026e10cd Initial revision
claus
parents:
diff changeset
  1066
     in color reduction, when not all colors can be aquired."
304f026e10cd Initial revision
claus
parents:
diff changeset
  1067
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1068
    |pseudoBits f gcRound has8BitImage deviceDepth
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1069
     imgMap newImage pxl
154
claus
parents: 151
diff changeset
  1070
     usedColors usageCounts maxIndex map
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1071
     fit scale lastOK error 
154
claus
parents: 151
diff changeset
  1072
     div 
claus
parents: 151
diff changeset
  1073
     bitsPerRGB "{Class: SmallInteger }"
claus
parents: 151
diff changeset
  1074
     shift      "{Class: SmallInteger }"
claus
parents: 151
diff changeset
  1075
     m          "{Class: SmallInteger }" |
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1076
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1077
    Color fixColors notNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1078
	f := self paletteImageAsDitheredPseudoFormOn:aDevice.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1079
	f notNil ifTrue:[^ f].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1080
    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1081
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1082
    "find used colors"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1083
154
claus
parents: 151
diff changeset
  1084
    usedColors := bytes usedValues.    "gets us an array filled with used values"
claus
parents: 151
diff changeset
  1085
				       "(could use bytes asBag)"
claus
parents: 151
diff changeset
  1086
    maxIndex := usedColors max + 1.
claus
parents: 151
diff changeset
  1087
180
claus
parents: 158
diff changeset
  1088
    usedColors size > 20 ifTrue:[
claus
parents: 158
diff changeset
  1089
	('D8IMAGE: allocating ' , usedColors size printString , ' colors ...') infoPrintNL.
claus
parents: 158
diff changeset
  1090
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1091
304f026e10cd Initial revision
claus
parents:
diff changeset
  1092
    "sort by usage"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1093
    usageCounts := bytes usageCounts.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1094
    usageCounts := usedColors asArray collect:[:clr | usageCounts at:(clr + 1)].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1095
    usageCounts sort:[:a :b | a > b] with:usedColors.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1096
304f026e10cd Initial revision
claus
parents:
diff changeset
  1097
    "allocate the colors (in order of usage count)"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1098
154
claus
parents: 151
diff changeset
  1099
    imgMap := Array new:maxIndex.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1100
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1101
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1102
     first, try to get the exact colors ...
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1103
    "
154
claus
parents: 151
diff changeset
  1104
    bitsPerRGB := aDevice bitsPerRGB.
claus
parents: 151
diff changeset
  1105
    shift := (8 - bitsPerRGB) negated.
claus
parents: 151
diff changeset
  1106
    m := (1 bitShift:bitsPerRGB) - 1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1107
    div := m asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1108
304f026e10cd Initial revision
claus
parents:
diff changeset
  1109
    fit := true.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1110
    scale := 100.0 / div.       "to scale 0..255 into 0.0 .. 100.0"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1111
    lastOK := 0.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1112
    gcRound := 0.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1113
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1114
    usedColors do:[:aColorIndex |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1115
	|devColor color
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1116
	 r        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1117
	 g        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1118
	 b        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1119
	 mapIndex "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1120
	 rMask    "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1121
	 gMask    "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1122
	 bMask    "{Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1123
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1124
	fit ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1125
	    gMask := bMask := rMask := m.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1126
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1127
	    mapIndex := aColorIndex + 1.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1128
	    color := colorMap at:mapIndex.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1129
	    color colorId notNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1130
		"wow - an immediate hit"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1131
		devColor := color
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1132
	    ] ifFalse:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1133
		devColor := color exactOn:aDevice.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1134
		devColor isNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1135
		    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1136
		     could not allocate color - on the first round, do a GC to flush 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1137
		     unused colors - this may help if some colors where locked by 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1138
		     already free images.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1139
		    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1140
		    gcRound == 0 ifTrue:[
112
88383d87f382 *** empty log message ***
claus
parents: 107
diff changeset
  1141
			ObjectMemory scavenge; finalize.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1142
			devColor := color exactOn:aDevice.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1143
			gcRound := 1
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1144
		    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1145
		    devColor isNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1146
			gcRound == 1 ifTrue:[
158
claus
parents: 157
diff changeset
  1147
			    CollectGarbageWhenRunningOutOfColors ifTrue:[
claus
parents: 157
diff changeset
  1148
				'D8IMAGE: force GC for possible color reclamation.' infoPrintNL.
claus
parents: 157
diff changeset
  1149
				ObjectMemory incrementalGC; finalize.
claus
parents: 157
diff changeset
  1150
				devColor := color exactOn:aDevice.
claus
parents: 157
diff changeset
  1151
			    ].    
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1152
			    gcRound := 2
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1153
			]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1154
		    ]
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1155
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1156
	    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1157
	    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1158
		imgMap at:mapIndex put:devColor.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1159
		lastOK := lastOK + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1160
	    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1161
		fit := false
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1162
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1163
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1164
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1165
304f026e10cd Initial revision
claus
parents:
diff changeset
  1166
    fit ifFalse:[
157
claus
parents: 156
diff changeset
  1167
"/        |tree|
claus
parents: 156
diff changeset
  1168
"/
claus
parents: 156
diff changeset
  1169
"/        "/ first, create an octTree containing colors which we got ...
claus
parents: 156
diff changeset
  1170
"/        tree := ColorOctree new.
claus
parents: 156
diff changeset
  1171
"/
claus
parents: 156
diff changeset
  1172
"/        usedColors from:1 to:lastOK do:[:aColorIndex |
claus
parents: 156
diff changeset
  1173
"/            tree insert:(colorMap at:aColorIndex + 1).
claus
parents: 156
diff changeset
  1174
"/        ].
claus
parents: 156
diff changeset
  1175
"/
claus
parents: 156
diff changeset
  1176
"/        "/ then, remap remaining, using nearest from those already allocated
claus
parents: 156
diff changeset
  1177
"/
claus
parents: 156
diff changeset
  1178
"/        usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |      
claus
parents: 156
diff changeset
  1179
"/            |mapIndex|
claus
parents: 156
diff changeset
  1180
"/
claus
parents: 156
diff changeset
  1181
"/            mapIndex := aColorIndex + 1.
claus
parents: 156
diff changeset
  1182
"/            imgMap at:mapIndex put:(tree findBest:(colorMap at:mapIndex))
claus
parents: 156
diff changeset
  1183
"/        ].
claus
parents: 156
diff changeset
  1184
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1185
	"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1186
	 again, this time allow wrong colors (loop while increasing allowed error)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1187
	"
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1188
	error := 10.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1189
	[fit] whileFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1190
	    fit := true.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1191
	    usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1192
		|devColor color
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1193
		 r        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1194
		 g        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1195
		 b        "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1196
		 mapIndex "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1197
		 rMask    "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1198
		 gMask    "{Class: SmallInteger }"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1199
		 bMask    "{Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1200
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1201
		fit ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1202
		    gMask := bMask := rMask := m.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1203
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1204
		    mapIndex := aColorIndex + 1.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1205
		    color := colorMap at:mapIndex.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1206
		    r := (color red * 255 / 100) rounded.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1207
		    g := (color green * 255 / 100) rounded.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1208
		    b := (color blue * 255 / 100) rounded.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1209
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1210
		    color := Color red:((r bitShift:shift) bitAnd:rMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1211
				 green:((g bitShift:shift) bitAnd:gMask) * scale
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1212
				  blue:((b bitShift:shift) bitAnd:bMask) * scale.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1213
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1214
		    color colorId notNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1215
			"wow - an immediate hit"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1216
			devColor := color
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1217
		    ] ifFalse:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1218
			devColor := color nearestOn:aDevice error:error.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1219
			devColor isNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1220
			    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1221
			     no free color - on the first round, do a GC to flush unused
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1222
			     colors - this may help if some colors where locked by already
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1223
			     free images.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1224
			    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1225
			    gcRound == 0 ifTrue:[
112
88383d87f382 *** empty log message ***
claus
parents: 107
diff changeset
  1226
				ObjectMemory scavenge; finalize.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1227
				devColor := color nearestOn:aDevice error:error.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1228
				gcRound := 1
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1229
			    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1230
			    devColor isNil ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1231
				gcRound == 1 ifTrue:[
230
2e35533f0af2 dont do a full GC if running out of colors
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1232
				    CollectGarbageWhenRunningOutOfColors ifTrue:[
2e35533f0af2 dont do a full GC if running out of colors
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1233
					'D8IMAGE: force GC for possible color reclamation.' infoPrintNL.
2e35533f0af2 dont do a full GC if running out of colors
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1234
					ObjectMemory incrementalGC; finalize.
2e35533f0af2 dont do a full GC if running out of colors
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1235
					devColor := color nearestOn:aDevice error:error.
2e35533f0af2 dont do a full GC if running out of colors
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1236
				    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1237
				    gcRound := 2
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1238
				]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1239
			    ]
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1240
			].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1241
		    ].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1242
		    (devColor notNil and:[devColor colorId notNil]) ifTrue:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1243
			imgMap at:mapIndex put:devColor.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1244
			lastOK := lastOK + 1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1245
		    ] ifFalse:[
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1246
			fit := false
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1247
		    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1248
		].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1249
	    ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1250
	    error := error * 2.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1251
	    error > 1000 ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1252
		"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1253
		 break out, if the error becomes too big.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1254
		"
151
claus
parents: 134
diff changeset
  1255
		'D8IMAGE: hard color allocation problem - revert to b&w' infoPrintNL.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1256
		"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1257
		 map to b&w as a last fallback.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1258
		 (should really do a dither here)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1259
		"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1260
		usedColors from:(lastOK+1) to:(usedColors size) do:[:aColorIndex |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1261
		    |color
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1262
		     mapIndex "{ Class: SmallInteger }"|
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1263
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1264
		    mapIndex := aColorIndex + 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1265
		    color := colorMap at:mapIndex.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1266
		    color brightness > 0.5 ifTrue:[
154
claus
parents: 151
diff changeset
  1267
			color := Color white.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1268
		    ] ifFalse:[
154
claus
parents: 151
diff changeset
  1269
			color := Color black.
claus
parents: 151
diff changeset
  1270
		    ].
claus
parents: 151
diff changeset
  1271
		    imgMap at:mapIndex put:(color on:aDevice).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1272
		].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1273
		fit := true.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1274
	    ]
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1275
	].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1276
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1277
	error > 100 ifTrue:[
151
claus
parents: 134
diff changeset
  1278
	    'D8IMAGE: not enough colors for a reasonable image' infoPrintNL
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1279
	] ifFalse:[
151
claus
parents: 134
diff changeset
  1280
	    'D8IMAGE: not enough colors for exact picture' infoPrintNL.
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1281
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1282
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1283
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1284
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1285
     create translation map (from image colors to allocated colorIds)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1286
    "
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1287
    map := ByteArray new:256.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1288
    1 to:imgMap size do:[:i |
154
claus
parents: 151
diff changeset
  1289
	|clr|
claus
parents: 151
diff changeset
  1290
claus
parents: 151
diff changeset
  1291
	(clr := imgMap at:i) notNil ifTrue:[
claus
parents: 151
diff changeset
  1292
	    map at:i put:clr colorId
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1293
	]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1294
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1295
154
claus
parents: 151
diff changeset
  1296
    "
claus
parents: 151
diff changeset
  1297
     does the device support 8-bit images ?
claus
parents: 151
diff changeset
  1298
    "
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1299
    deviceDepth := aDevice depth.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1300
    deviceDepth == 8 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1301
	has8BitImage := true.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1302
    ] ifFalse:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1303
	has8BitImage := false.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1304
	aDevice supportedImageFormats do:[:fmt |
235
579f3f804a46 padding info in supportedFormats
Claus Gittinger <cg@exept.de>
parents: 230
diff changeset
  1305
	    (fmt at:#bitsPerPixel) == 8 ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1306
		has8BitImage := true.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1307
	    ]
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1308
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1309
    ].
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1310
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1311
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1312
     finally, create a form on the device and copy (& translate)
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1313
     the pixel values
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1314
    "
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1315
    has8BitImage ifTrue:[
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1316
	pseudoBits := ByteArray uninitializedNew:(width * height).
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1317
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1318
	bytes expandPixels:8         "xlate only"
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1319
		    width:width 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1320
		   height:height
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1321
		     into:pseudoBits
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1322
		  mapping:map.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1323
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1324
	map := nil.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1325
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1326
	f := Form width:width height:height depth:deviceDepth on:aDevice.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1327
	f isNil ifTrue:[^ nil].
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1328
	f colorMap:imgMap. 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1329
	f initGC.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1330
	aDevice drawBits:pseudoBits bitsPerPixel:8 depth:deviceDepth  
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1331
		   width:width height:height
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1332
		       x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1333
		    into:(f id) x:0 y:0 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1334
		   width:width height:height with:(f gcId).
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1335
	^ f
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1336
    ].
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1337
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1338
    "
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1339
     slow fall back: convert into appropriate depth image,
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1340
     by looping over each pixel individually
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1341
    "
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1342
    newImage := (Image implementorForDepth:deviceDepth) new.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1343
    newImage width:width.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1344
    newImage height:height.
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1345
    newImage bits:(ByteArray uninitializedNew:(height * newImage bytesPerRow)).
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1346
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1347
    0 to:height-1 do:[:row |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1348
	0 to:width-1 do:[:col |
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1349
	    pxl := self valueAtX:col y:row.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1350
	    newImage atX:col y:row putValue:(map at:pxl)
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1351
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1352
    ].
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1353
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1354
    f := Form width:width height:height depth:deviceDepth on:aDevice.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1355
    f isNil ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1356
    f colorMap:imgMap. 
304f026e10cd Initial revision
claus
parents:
diff changeset
  1357
    f initGC.
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1358
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1359
    aDevice drawBits:(newImage bits) depth:deviceDepth width:width height:height
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1360
		   x:0 y:0
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1361
		into:(f id) x:0 y:0 
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1362
	       width:width height:height with:(f gcId).
46
7b331e9012fd *** empty log message ***
claus
parents: 38
diff changeset
  1363
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1364
    ^ f
304f026e10cd Initial revision
claus
parents:
diff changeset
  1365
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
  1366
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1367
!Depth8Image methodsFor:'enumerating'!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1368
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1369
atY:y from:xLow to:xHigh do:aBlock
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1370
    "perform aBlock for each pixel from x1 to x2 in row y.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1371
     The block is passed the color at each pixel.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1372
     This method allows slighly faster processing of an
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1373
     image than using atX:y:, since some processing can be
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1374
     avoided when going from pixel to pixel. However, for
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1375
     real image processing, specialized methods should be written."
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1376
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1377
    |srcIndex "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1378
     index    "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1379
     value    "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1380
     x1       "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1381
     x2       "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1382
     color colors last|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1383
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1384
    photometric == #palette ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1385
	colors := colorMap.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1386
    ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1387
	colors := Array new:256.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1388
    ].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1389
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1390
    x1 := xLow.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1391
    x2 := xHigh.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1392
    srcIndex := (width * y) + 1 + x1.
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1393
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1394
    x1 to:x2 do:[:x |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1395
	value := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1396
	srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1397
	value ~~ last ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1398
	    last := value.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1399
	    index := value + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1400
	    color := colors at:index.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1401
	    color isNil ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1402
		photometric == #whiteIs0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1403
		    color := (Color grey:100 - (100 * value / 255))
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1404
		] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1405
		    photometric == #blackIs0 ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1406
			color := (Color grey:(100 * value / 255))
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1407
		    ] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1408
			photometric ~~ #palette ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1409
			    self error:'format not supported'.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1410
			    ^ nil
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1411
			]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1412
		    ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1413
		].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1414
		colors at:index put:color
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1415
	    ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1416
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1417
	aBlock value:x value:color
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1418
    ]
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1419
!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1420
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1421
valueAtY:y from:xLow to:xHigh do:aBlock
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1422
    "perform aBlock for each pixelValue from x1 to x2 in row y.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1423
     The block is passed the pixelValue at each pixel.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1424
     This method allows slighly faster processing of an
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1425
     image than using valueAtX:y:, since some processing can be
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1426
     avoided when going from pixel to pixel. However, for
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1427
     real image processing, specialized methods should be written."
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1428
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1429
    |srcIndex   "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1430
     pixelValue "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1431
     x1         "{ Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1432
     x2         "{ Class: SmallInteger }"|
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1433
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1434
    x1 := xLow.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1435
    x2 := xHigh.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1436
    srcIndex := (width * y) + 1 + x1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1437
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1438
    x1 to:x2 do:[:x |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1439
	pixelValue := bytes at:srcIndex.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1440
	srcIndex := srcIndex + 1.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1441
	aBlock value:x value:pixelValue 
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1442
    ]
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1443
! !
304f026e10cd Initial revision
claus
parents:
diff changeset
  1444
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1445
!Depth8Image methodsFor:'image manipulations'!
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1446
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1447
flipHorizontal
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1448
    "inplace horizontal flip"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1449
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1450
    |index  "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1451
     h      "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1452
     w      "{Class: SmallInteger }"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1453
     buffer |
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1454
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1455
    w := width - 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1456
    h := height - 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1457
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1458
    buffer := ByteArray new:width.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1459
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1460
    index := 1.
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1461
    0 to:h do:[:row |
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1462
	buffer replaceFrom:1 to:width with:bytes startingAt:index.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1463
	buffer reverse.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1464
	bytes replaceFrom:index to:index+w with:buffer startingAt:1.
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1465
	index := index + w + 1.
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1466
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1467
    "flush device info"
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1468
    self restored
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1469
!
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1470
134
claus
parents: 118
diff changeset
  1471
hardMagnifiedBy:extent
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1472
    "return a new image magnified by extent, aPoint.
12
9f0995fac1fa *** empty log message ***
claus
parents: 5
diff changeset
  1473
     This is the general magnification method, handling non-integral values"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1474
304f026e10cd Initial revision
claus
parents:
diff changeset
  1475
    |mX mY
304f026e10cd Initial revision
claus
parents:
diff changeset
  1476
     newWidth  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1477
     newHeight "{ Class: SmallInteger }"
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1478
     w         "{ Class: SmallInteger }"
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1479
     h         "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1480
     newImage newBytes
304f026e10cd Initial revision
claus
parents:
diff changeset
  1481
     value     "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1482
     srcRowIdx "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1483
     srcIndex  "{ Class: SmallInteger }"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1484
     dstIndex  "{ Class: SmallInteger }"|
304f026e10cd Initial revision
claus
parents:
diff changeset
  1485
304f026e10cd Initial revision
claus
parents:
diff changeset
  1486
    mX := extent x.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1487
    mY := extent y.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1488
    ((mX < 0) or:[mY < 0]) ifTrue:[^ nil].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1489
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].
304f026e10cd Initial revision
claus
parents:
diff changeset
  1490
304f026e10cd Initial revision
claus
parents:
diff changeset
  1491
    newWidth := (width * mX) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1492
    newHeight := (height * mY) truncated.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1493
304f026e10cd Initial revision
claus
parents:
diff changeset
  1494
    newBytes := ByteArray uninitializedNew:(newWidth * newHeight).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1495
304f026e10cd Initial revision
claus
parents:
diff changeset
  1496
    newImage := self species new.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1497
    newImage bits:newBytes.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1498
    newImage width:newWidth.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1499
    newImage height:newHeight.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1500
    newImage photometric:photometric.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1501
    newImage samplesPerPixel:samplesPerPixel.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1502
    newImage bitsPerSample:#(8).
304f026e10cd Initial revision
claus
parents:
diff changeset
  1503
    newImage colorMap:colorMap copy.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1504
304f026e10cd Initial revision
claus
parents:
diff changeset
  1505
    "walk over destination image fetching pixels from source image"
304f026e10cd Initial revision
claus
parents:
diff changeset
  1506
304f026e10cd Initial revision
claus
parents:
diff changeset
  1507
    mY := mY asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1508
    mX := mX asFloat.
304f026e10cd Initial revision
claus
parents:
diff changeset
  1509
%{
304f026e10cd Initial revision
claus
parents:
diff changeset
  1510
    unsigned char *_dstP = _ByteArrayInstPtr(newBytes)->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1511
    unsigned char *_srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1512
    unsigned char *_srcRowP;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1513
    int _width = _intVal(_INST(width));
304f026e10cd Initial revision
claus
parents:
diff changeset
  1514
    int _w = _intVal(newWidth) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1515
    int _h = _intVal(newHeight) - 1;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1516
    int _row, _col;
304f026e10cd Initial revision
claus
parents:
diff changeset
  1517
    double _mX = _floatVal(mX);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1518
    double _mY = _floatVal(mY);
304f026e10cd Initial revision
claus
parents:
diff changeset
  1519
304f026e10cd Initial revision
claus
parents:
diff changeset
  1520
    for (_row = 0; _row <= _h; _row++) {
71
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1521
	_srcRowP = _srcP + (_width * (int)((double)_row / _mY));
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1522
	for (_col = 0; _col <= _w; _col++) {
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1523
	    *_dstP++ = _srcRowP[(int)((double)_col / _mX)];
6a42b2b115f8 *** empty log message ***
claus
parents: 66
diff changeset
  1524
	}
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1525
    }
304f026e10cd Initial revision
claus
parents:
diff changeset
  1526
%}
304f026e10cd Initial revision
claus
parents:
diff changeset
  1527
.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1528
"/   the above C-code is equivalent to:
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1529
"/
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1530
"/    dstIndex := 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1531
"/    w := newWidth - 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1532
"/    h := newHeight - 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1533
"/    0 to:h do:[:row |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1534
"/        srcRowIdx := (width * (row // mY)) + 1.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1535
"/        0 to:w do:[:col |
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1536
"/            srcIndex := srcRowIdx + (col // mX).
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1537
"/            value := bytes at:srcIndex.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1538
"/            newBytes at:dstIndex put:value.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1539
"/            dstIndex := dstIndex + 1
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1540
"/        ]
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1541
"/    ].
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
  1542
"/
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1543
304f026e10cd Initial revision
claus
parents:
diff changeset
  1544
    ^ newImage
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1545
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1546
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1547
magnifyRowFrom:srcBytes offset:srcStart  
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1548
	  into:dstBytes offset:dstStart factor:mX
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1549
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1550
    "magnify a single pixel row - can only magnify by integer factors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1551
     Specially tuned for factors 2,3 and 4."
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1552
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1553
%{
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1554
    REGISTER unsigned char *srcP, *dstP;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1555
    REGISTER unsigned char _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1556
    int _mag;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1557
    REGISTER int i;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1558
    int _pixels;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1559
    OBJ w = _INST(width);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1560
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1561
    if (__bothSmallInteger(srcStart, dstStart)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1562
     && __bothSmallInteger(w, mX)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1563
     && __isByteArray(srcBytes) && __isByteArray(dstBytes)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1564
	_mag = _intVal(mX);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1565
	srcP = _ByteArrayInstPtr(srcBytes)->ba_element - 1 + _intVal(srcStart);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1566
	dstP = _ByteArrayInstPtr(dstBytes)->ba_element - 1 + _intVal(dstStart);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1567
	_pixels = _intVal(w);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1568
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1569
	switch (_mag) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1570
	    case 1:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1571
		break;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1572
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1573
	    case 2:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1574
		/* special code for common case */
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1575
		while (_pixels--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1576
		    _byte = *srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1577
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1578
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1579
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1580
		break;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1581
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1582
	    case 3:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1583
		/* special code for common case */
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1584
		while (_pixels--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1585
		    _byte = *srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1586
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1587
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1588
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1589
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1590
		break;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1591
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1592
	    case 4:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1593
		/* special code for common case */
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1594
		while (_pixels--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1595
		    _byte = *srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1596
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1597
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1598
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1599
		    *dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1600
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1601
		break;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1602
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1603
	    default:
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1604
		while (_pixels--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1605
		    _byte = *srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1606
		    for (i=_mag; i>0; i--)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1607
			*dstP++ = _byte;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1608
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1609
		break;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1610
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1611
	RETURN (self);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1612
    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1613
%}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1614
.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1615
    self primitiveFailed
1
304f026e10cd Initial revision
claus
parents:
diff changeset
  1616
! !
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1617
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1618
!Depth8Image methodsFor:'private'!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1619
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1620
dither1PlaneUsingMap:map on:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1621
    "a helper for dithering palette and greyscale images"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1622
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1623
    |f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1624
     patterns formBytes
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1625
     pixel0bytes pixel1bytes
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1626
     clr ditherPattern
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1627
     nColors       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1628
     w             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1629
     h             "{Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1630
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1631
    nColors := map size.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1632
    w := width.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1633
    h := height.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1634
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1635
    formBytes := ByteArray uninitializedNew:(w + 7 // 8) * h.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1636
    patterns := Array new:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1637
    pixel0bytes := ByteArray uninitializedNew:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1638
    pixel1bytes := ByteArray uninitializedNew:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1639
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1640
    "
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1641
     extract dither patterns and values to use for 1/0 bits
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1642
     in those from the dithercolors
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1643
    "
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1644
    1 to:nColors do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1645
	clr := (map at:i) on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1646
	ditherPattern := clr ditherForm.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1647
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1648
	ditherPattern isNil ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1649
	    patterns at:i put:#[2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1650
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1651
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1652
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1653
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1654
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1655
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1656
				2r11111111].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1657
	    pixel0bytes at:i put:clr colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1658
	    pixel1bytes at:i put:clr colorId
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1659
	] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1660
	    patterns at:i put:(ditherPattern bits).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1661
	    pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1662
	    pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1663
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1664
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1665
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1666
%{
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1667
    unsigned char *_srcP, *_dstP;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1668
    OBJ _patternBytes;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1669
    unsigned char _mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1670
    unsigned char _outBits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1671
    unsigned char _last, _v, _patternBits, _p0, _p1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1672
    int _h, _w;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1673
    int _patternOffset = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1674
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1675
    _srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1676
    _dstP = _ByteArrayInstPtr(formBytes)->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1677
    for (_h = _intVal(h); _h; _h--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1678
	_last = -1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1679
	for (_w = _intVal(w); _w; _w--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1680
	    _v = *_srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1681
	    if (_v != _last) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1682
		_patternBytes = _ArrayInstPtr(patterns)->a_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1683
		if (__isByteArray(_patternBytes)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1684
		    _patternBits = _ByteArrayInstPtr(_patternBytes)->ba_element[_patternOffset];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1685
		} else if (__isArray(_patternBytes)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1686
		    _patternBits = _intVal(_ArrayInstPtr(_patternBytes)->a_element[_patternOffset]);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1687
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1688
		_p0 = _ByteArrayInstPtr(pixel0bytes)->ba_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1689
		_p1 = _ByteArrayInstPtr(pixel1bytes)->ba_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1690
		_last = _v;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1691
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1692
	    _outBits <<= 1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1693
	    if (_patternBits & _mask)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1694
		_outBits |= _p1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1695
	    else
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1696
		_outBits |= _p0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1697
	    _mask >>= 1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1698
	    if (_mask == 0) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1699
		_mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1700
		*_dstP++ = _outBits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1701
		_outBits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1702
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1703
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1704
	if (_mask != 0x80) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1705
	    while (_mask != 0) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1706
		_outBits <<= 1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1707
		_mask >>= 1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1708
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1709
	    *_dstP++ = _outBits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1710
	    _mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1711
	    _outBits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1712
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1713
	_patternOffset++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1714
	if (_patternOffset == 8)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1715
	    _patternOffset = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1716
    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1717
%}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1718
.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1719
    f := Form width:w height:h fromArray:formBytes.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1720
    ^ f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1721
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1722
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1723
dither2PlaneUsingMap:map on:aDevice
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1724
    "a helper for dithering palette and greyscale images"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1725
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1726
    |f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1727
     patterns formBytes
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1728
     pixel0bytes pixel1bytes
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1729
     clr ditherPattern
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1730
     nColors       "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1731
     w             "{Class: SmallInteger }"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1732
     h             "{Class: SmallInteger }"|
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1733
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1734
    nColors := map size.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1735
    w := width.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1736
    h := height.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1737
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1738
    formBytes := ByteArray uninitializedNew:(w * 2 + 7 // 8) * h.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1739
    patterns := Array new:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1740
    pixel0bytes := ByteArray uninitializedNew:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1741
    pixel1bytes := ByteArray uninitializedNew:nColors.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1742
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1743
    "extract dither patterns and values to use for 1/0 bits
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1744
     in those from the dithercolors"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1745
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1746
    1 to:nColors do:[:i |
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1747
	clr := (map at:i) on:aDevice.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1748
	ditherPattern := clr ditherForm.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1749
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1750
	ditherPattern isNil ifTrue:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1751
	    patterns at:i put:#[2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1752
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1753
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1754
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1755
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1756
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1757
				2r11111111
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1758
				2r11111111].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1759
	    pixel0bytes at:i put:clr colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1760
	    pixel1bytes at:i put:clr colorId
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1761
	] ifFalse:[
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1762
	    patterns at:i put:(ditherPattern bits).
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1763
	    pixel0bytes at:i put:(ditherPattern colorMap at:1) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1764
	    pixel1bytes at:i put:(ditherPattern colorMap at:2) colorId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1765
	].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1766
    ].
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1767
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1768
%{
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1769
    unsigned char *_srcP, *_dstP;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1770
    OBJ _patternBytes;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1771
    unsigned char _mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1772
    unsigned char _outBits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1773
    unsigned char _last, _v, _patternBits, _p0, _p1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1774
    int _h, _w;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1775
    int _patternOffset = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1776
    int _outCount;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1777
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1778
    _srcP = _ByteArrayInstPtr(_INST(bytes))->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1779
    _dstP = _ByteArrayInstPtr(formBytes)->ba_element;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1780
    for (_h = _intVal(h); _h; _h--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1781
	_last = -1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1782
	_outCount = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1783
	for (_w = _intVal(w); _w; _w--) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1784
	    _v = *_srcP++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1785
	    if (_v != _last) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1786
		_patternBytes = _ArrayInstPtr(patterns)->a_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1787
		if (__isByteArray(_patternBytes)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1788
		    _patternBits = _ByteArrayInstPtr(_patternBytes)->ba_element[_patternOffset];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1789
		} else if (__isArray(_patternBytes)) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1790
		    _patternBits = _intVal(_ArrayInstPtr(_patternBytes)->a_element[_patternOffset]);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1791
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1792
		_p0 = _ByteArrayInstPtr(pixel0bytes)->ba_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1793
		_p1 = _ByteArrayInstPtr(pixel1bytes)->ba_element[_v];
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1794
		_last = _v;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1795
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1796
	    _outBits <<= 2;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1797
	    if (_patternBits & _mask)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1798
		_outBits |= _p1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1799
	    else
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1800
		_outBits |= _p0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1801
	    _mask >>= 1;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1802
	    _outCount++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1803
	    if (_outCount == 4) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1804
		*_dstP++ = _outBits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1805
		_outCount = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1806
		if (_mask == 0) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1807
		    _mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1808
		}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1809
	    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1810
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1811
	if (_outCount) {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1812
	    do {
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1813
		_outBits <<= 2;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1814
	    } while (++_outCount != 4);
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1815
	    *_dstP++ = _outBits;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1816
	}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1817
	_mask = 0x80;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1818
	_outBits = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1819
	_patternOffset++;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1820
	if (_patternOffset == 8)
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1821
	    _patternOffset = 0;
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1822
    }
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1823
%}
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1824
.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1825
    f := Form width:w height:h depth:2.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1826
    f initGC.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1827
    f device drawBits:formBytes depth:2 width:w height:h x:0 y:0
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1828
		 into:f id x:0 y:0 width:w height:h with:f gcId.
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1829
    ^ f
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1830
! !
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1831
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1832
!Depth8Image methodsFor:'queries'!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1833
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1834
bitsPerPixel
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1835
    "return the number of bits per pixel"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1836
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1837
    ^ 8
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1838
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1839
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1840
bitsPerRow
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1841
    "return the number of bits in one scanline of the image"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1842
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1843
    ^  width * 8
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1844
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1845
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1846
bytesPerRow
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1847
    "return the number of bytes in one scanline of the image"
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1848
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1849
    ^ width
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1850
!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1851
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1852
usedValues
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1853
    "return a collection of color values used in the receiver."
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1854
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1855
    ^ bytes usedValues
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1856
! !
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1857
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1858
!Depth8Image class methodsFor:'documentation'!
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1859
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1860
version
611
e0442439a3c6 documentation
Claus Gittinger <cg@exept.de>
parents: 579
diff changeset
  1861
    ^ '$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.36 1996-04-25 16:21:49 cg Exp $'
579
e381761190c4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 345
diff changeset
  1862
! !