PICTReader.st
author Claus Gittinger <cg@exept.de>
Wed, 19 Nov 2003 20:18:30 +0100
changeset 1849 e3c78a95e9f2
parent 1843 fef27ba933ff
child 1850 67d2c8b18c60
permissions -rw-r--r--
reads some pixel-images
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	      All Rights Reserved
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"{ Package: 'stx:libview2' }"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
ImageReader subclass:#PICTReader
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
    16
	instanceVariableNames:'currentOpcode rowBytes bounds srcRect dstRect mode ctSeed ctFlags
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
    17
		ctSize ctTable packType baseAddr pmVersion packSize hRes vRes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
    18
		pixelType pixelSize cmpCount cmpSize planeBytes pmTable
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
    19
		pmReserved picSize picFrame picVersion'
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
    20
	classVariableNames:'Opcodes'
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	poolDictionaries:''
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
	category:'Graphics-Images-Readers'
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    25
Object subclass:#PICTFrame
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    26
	instanceVariableNames:'image sourceRectangle destinationRectangle mode maskRegion'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    27
	classVariableNames:''
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    28
	poolDictionaries:''
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    29
	privateIn:PICTReader
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    30
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    31
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
!PICTReader class methodsFor:'documentation'!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
copyright
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
 COPYRIGHT (c) 1993 by Claus Gittinger
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
	      All Rights Reserved
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
 This software is furnished under a license and may be used
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
 only in accordance with the terms of that license and with the
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
 inclusion of the above copyright notice.   This software may not
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
 be provided or otherwise made available to, or used by, any
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
 other person.  No title to or ownership of the software is
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
 hereby transferred.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
documentation
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
"
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    50
    this class will eventually provide fnctionality for loading and storing
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    51
    Apple PICT files. (QuickTime).
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    53
    WARNING: this is a first sceletton, ported from the AidaWeb PICTReader.
1808
d230c22d908e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1807
diff changeset
    54
    The implementation is VERY incomplete - it is provided here to provide a starting
d230c22d908e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1807
diff changeset
    55
    point for porters.
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
    [See also:]
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
        Image Form Icon
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
        BlitImageReader FaceReader JPEGReader GIFReader PBMReader PCXReader 
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
        ST80FormReader TargaReader TIFFReader WindowsIconReader 
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
        XBMReader XPMReader XWDReader 
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
examples
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
"
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    67
  PICTReader fromFile:'/unsaved2/stefan/nil/home/stefan/dos/winword/shared/ms.pct'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    68
  PICTReader fromFile:'/phys/exept/tmp/pict/BLK.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    69
  PICTReader fromFile:'/phys/exept/tmp/pict/BLU.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    70
  PICTReader fromFile:'/phys/exept/tmp/pict/GRN.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    71
  PICTReader fromFile:'/phys/exept/tmp/pict/RED.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    72
  PICTReader fromFile:'/phys/exept/tmp/pict/WHT.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    73
  PICTReader fromFile:'/phys/exept/tmp/pict/YEL.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    74
  PICTReader fromFile:'/phys/exept/tmp/pict/FLAG_B24.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    75
  PICTReader fromFile:'/phys/exept/tmp/pict/MARBLES.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    76
  PICTReader fromFile:'/phys/exept/tmp/pict/TRU256.PCT'
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
    77
  PICTReader fromFile:'/phys/exept/tmp/pict/VENUS.PCT'
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    78
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    79
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    80
  example7 --- Version 2 PICTure ---
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    81
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    82
    | array stream image |
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    83
    array := #(
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    84
        16r0078
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    85
        16r0000 16r0000 16r006C 16r00A8
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    86
        16r0011
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    87
        16r02FF
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    88
        16r0C00
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    89
                16rFFFE
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    90
                16r0000
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    91
                16r0048 16r0000
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    92
                16r0048 16r0000
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    93
                16r0002 16r0002 16r006E 16r00AA
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    94
                16r0000
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    95
        16r001E
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    96
        16r0001
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    97
                16r000A
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    98
                16r0002 16r0002 16r006E 16r00AA
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
    99
        16r000A
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   100
                16r77DD 16r77DD 16r77DD 16r77DD
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   101
        16r0034
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   102
                16r0002 16r0002 16r006E 16r00AA
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   103
        16r000A
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   104
                16r8822 16r8822 16r8822 16r8822
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   105
        16r005C
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   106
        16r0008
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   107
                16r0008
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   108
        16r0071
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   109
                16r001A
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   110
                16r0002 16r0002 16r006E 16r00AA
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   111
                16r006E 16r0002 16r0002 16r0054 16r006E 16r00AA 16r006E 16r0002
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   112
        16r00FF
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   113
    ).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   114
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   115
    stream := WriteStream on: (ByteArray new: array size * 2 + 512).
1843
fef27ba933ff checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
   116
    stream next:512 put:0.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   117
    array do:
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   118
        [:n | 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   119
            stream nextPut: ((n bitAnd:16rFF00) bitShift: -8).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   120
            stream nextPut: (n bitAnd: 16r00FF)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   121
        ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   122
    image := PICTReader fromStream: (ReadStream on: stream contents).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   123
    image
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   124
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   125
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
  example8
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
  --- Version 1 PICTure ---
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    | array image |
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    array := #[
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
    16r00 16r4F
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
    16r11
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
            16r01
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
    16r01
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
            16r00 16r0A
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
    16r0A
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
            16r77 16rDD 16r77 16rDD 16r77 16rDD 16r77 16rDD
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
    16r34
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
    16r0A
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
            16r88 16r22 16r88 16r22 16r88 16r22 16r88 16r22
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
    16r5C
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    16r71
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
            16r00 16r1A
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
            16r00 16r02 16r00 16r02 16r00 16r6E 16r00 16rAA
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
            16r00 16r6E 16r00 16r02 16r00 16r02 16r00 16r54 16r00 16r6E 16r00 16rAA 16r00 16r6E 16r00 16r02
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
    16rFF
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
    ].
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   151
    array := (ByteArray new:512) , array.
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
    image := PICTReader fromStream: (ReadStream on: array).
1816
5450e44ed7e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1808
diff changeset
   153
    image
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
! !
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
!PICTReader class methodsFor:'initialization'!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   159
defineOpcodes00 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   160
        Opcodes at: 16r0000 put: ('NOP' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   161
        Opcodes at: 16r0001 put: ('Clip' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   162
        Opcodes at: 16r0002 put: ('BkPat' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   163
        Opcodes at: 16r0003 put: ('TxFont' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   164
        Opcodes at: 16r0004 put: ('TxFace' -> 1).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   165
        Opcodes at: 16r0005 put: ('TxMode' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   166
        Opcodes at: 16r0006 put: ('SpExtra' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   167
        Opcodes at: 16r0007 put: ('PnSize' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   168
        Opcodes at: 16r0008 put: ('PnMode' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   169
        Opcodes at: 16r0009 put: ('PnPat' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   170
        Opcodes at: 16r000A put: ('FillPat' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   171
        Opcodes at: 16r000B put: ('OvSize' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   172
        Opcodes at: 16r000C put: ('Origin' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   173
        Opcodes at: 16r000D put: ('TxSize' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   174
        Opcodes at: 16r000E put: ('FgColor' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   175
        Opcodes at: 16r000F put: ('BkColor' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   176
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   177
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   178
defineOpcodes01
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   179
        Opcodes at: 16r0010 put: ('TxRatio' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   180
        Opcodes at: 16r0011 put: ('VersionOp' -> 1).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   181
        Opcodes at: 16r0012 put: ('BkPixPat' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   182
        Opcodes at: 16r0013 put: ('PnPixPat' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   183
        Opcodes at: 16r0014 put: ('FillPixPat' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   184
        Opcodes at: 16r0015 put: ('PnLocHFrac' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   185
        Opcodes at: 16r0016 put: ('ChExtra' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   186
        Opcodes at: 16r0017 put: ('Apple0017' -> 'Not determined').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   187
        Opcodes at: 16r0018 put: ('Apple0018' -> 'Not determined').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   188
        Opcodes at: 16r0019 put: ('Apple0019' -> 'Not determined').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   189
        Opcodes at: 16r001A put: ('RGBFgCol' -> 6).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   190
        Opcodes at: 16r001B put: ('RGBBkCol' -> 6).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   191
        Opcodes at: 16r001C put: ('HiliteMode' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   192
        Opcodes at: 16r001D put: ('HiliteColor' -> 6).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   193
        Opcodes at: 16r001E put: ('DefHilite' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   194
        Opcodes at: 16r001F put: ('OpColor' -> 6).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   195
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   196
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   197
defineOpcodes02 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   198
        Opcodes at: 16r0020 put: ('Line' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   199
        Opcodes at: 16r0021 put: ('LineFrom' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   200
        Opcodes at: 16r0022 put: ('ShortLine' -> 6).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   201
        Opcodes at: 16r0023 put: ('ShortLineFrom' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   202
        Opcodes at: 16r0024 put: ('Apple0024' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   203
        Opcodes at: 16r0025 put: ('Apple0025' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   204
        Opcodes at: 16r0026 put: ('Apple0026' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   205
        Opcodes at: 16r0027 put: ('Apple0027' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   206
        Opcodes at: 16r0028 put: ('LongText' -> '5 + text').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   207
        Opcodes at: 16r0029 put: ('DHText' -> '2 + text').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   208
        Opcodes at: 16r002A put: ('DVText' -> '2 + text').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   209
        Opcodes at: 16r002B put: ('DHDVText' -> '3 + text').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   210
        Opcodes at: 16r002C put: ('fontName' -> '5 + name length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   211
        Opcodes at: 16r002D put: ('lineJustify' -> 10).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   212
        Opcodes at: 16r002E put: ('glyphState' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   213
        Opcodes at: 16r002F put: ('Apple002F' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   214
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   215
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   216
defineOpcodes03
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   217
        Opcodes at: 16r0030 put: ('frameRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   218
        Opcodes at: 16r0031 put: ('paintRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   219
        Opcodes at: 16r0032 put: ('eraseRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   220
        Opcodes at: 16r0033 put: ('invertRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   221
        Opcodes at: 16r0034 put: ('fillRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   222
        Opcodes at: 16r0035 put: ('Apple0035' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   223
        Opcodes at: 16r0036 put: ('Apple0036' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   224
        Opcodes at: 16r0037 put: ('Apple0037' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   225
        Opcodes at: 16r0038 put: ('frameSameRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   226
        Opcodes at: 16r0039 put: ('paintSameRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   227
        Opcodes at: 16r003A put: ('eraseSameRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   228
        Opcodes at: 16r003B put: ('invertSameRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   229
        Opcodes at: 16r003C put: ('fillSameRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   230
        Opcodes at: 16r003D put: ('Apple003D' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   231
        Opcodes at: 16r003E put: ('Apple003E' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   232
        Opcodes at: 16r003F put: ('Apple003F' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   233
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   234
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   235
defineOpcodes04
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   236
        Opcodes at: 16r0040 put: ('frameRRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   237
        Opcodes at: 16r0041 put: ('paintRRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   238
        Opcodes at: 16r0042 put: ('eraseRRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   239
        Opcodes at: 16r0043 put: ('invertRRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   240
        Opcodes at: 16r0044 put: ('fillRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   241
        Opcodes at: 16r0045 put: ('Apple0045' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   242
        Opcodes at: 16r0046 put: ('Apple0046' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   243
        Opcodes at: 16r0047 put: ('Apple0047' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   244
        Opcodes at: 16r0048 put: ('frameSameRRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   245
        Opcodes at: 16r0049 put: ('paintSameRRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   246
        Opcodes at: 16r004A put: ('eraseSameRRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   247
        Opcodes at: 16r004B put: ('invertSameRRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   248
        Opcodes at: 16r004C put: ('fillSameRRect' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   249
        Opcodes at: 16r004D put: ('Apple004D' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   250
        Opcodes at: 16r004E put: ('Apple004E' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   251
        Opcodes at: 16r004F put: ('Apple004F' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   252
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   253
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   254
defineOpcodes05
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   255
        Opcodes at: 16r0050 put: ('frameOval' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   256
        Opcodes at: 16r0051 put: ('paintOval' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   257
        Opcodes at: 16r0052 put: ('eraseOval' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   258
        Opcodes at: 16r0053 put: ('invertOval' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   259
        Opcodes at: 16r0054 put: ('fillRect' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   260
        Opcodes at: 16r0055 put: ('Apple0055' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   261
        Opcodes at: 16r0056 put: ('Apple0056' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   262
        Opcodes at: 16r0057 put: ('Apple0057' -> 8).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   263
        Opcodes at: 16r0058 put: ('frameSameOval' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   264
        Opcodes at: 16r0059 put: ('paintSameOval' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   265
        Opcodes at: 16r005A put: ('eraseSameOval' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   266
        Opcodes at: 16r005B put: ('invertSameOval' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   267
        Opcodes at: 16r005C put: ('fillSameOval' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   268
        Opcodes at: 16r005D put: ('Apple005D' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   269
        Opcodes at: 16r005E put: ('Apple005E' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   270
        Opcodes at: 16r005F put: ('Apple005F' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   271
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   272
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   273
defineOpcodes06
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   274
        Opcodes at: 16r0060 put: ('frameArc' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   275
        Opcodes at: 16r0061 put: ('paintArc' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   276
        Opcodes at: 16r0062 put: ('eraseArc' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   277
        Opcodes at: 16r0063 put: ('invertArc' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   278
        Opcodes at: 16r0064 put: ('fillRect' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   279
        Opcodes at: 16r0065 put: ('Apple0065' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   280
        Opcodes at: 16r0066 put: ('Apple0066' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   281
        Opcodes at: 16r0067 put: ('Apple0067' -> 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   282
        Opcodes at: 16r0068 put: ('frameSameArc' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   283
        Opcodes at: 16r0069 put: ('paintSameArc' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   284
        Opcodes at: 16r006A put: ('eraseSameArc' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   285
        Opcodes at: 16r006B put: ('invertSameArc' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   286
        Opcodes at: 16r006C put: ('fillSameArc' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   287
        Opcodes at: 16r006D put: ('Apple006D' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   288
        Opcodes at: 16r006E put: ('Apple006E' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   289
        Opcodes at: 16r006F put: ('Apple006F' -> 4).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   290
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   291
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   292
defineOpcodes07
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   293
        Opcodes at: 16r0070 put: ('framePoly' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   294
        Opcodes at: 16r0071 put: ('paintPoly' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   295
        Opcodes at: 16r0072 put: ('erasePoly' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   296
        Opcodes at: 16r0073 put: ('invertPoly' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   297
        Opcodes at: 16r0074 put: ('fillRect' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   298
        Opcodes at: 16r0075 put: ('Apple0075' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   299
        Opcodes at: 16r0076 put: ('Apple0076' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   300
        Opcodes at: 16r0077 put: ('Apple0077' -> 'Polygon size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   301
        Opcodes at: 16r0078 put: ('frameSamePoly' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   302
        Opcodes at: 16r0079 put: ('paintSamePoly' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   303
        Opcodes at: 16r007A put: ('eraseSamePoly' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   304
        Opcodes at: 16r007B put: ('invertSamePoly' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   305
        Opcodes at: 16r007C put: ('fillSamePoly' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   306
        Opcodes at: 16r007D put: ('Apple007D' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   307
        Opcodes at: 16r007E put: ('Apple007E' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   308
        Opcodes at: 16r007F put: ('Apple007F' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   309
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   310
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   311
defineOpcodes08
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   312
        Opcodes at: 16r0080 put: ('frameRgn' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   313
        Opcodes at: 16r0081 put: ('paintRgn' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   314
        Opcodes at: 16r0082 put: ('eraseRgn' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   315
        Opcodes at: 16r0083 put: ('invertRgn' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   316
        Opcodes at: 16r0084 put: ('fillRect' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   317
        Opcodes at: 16r0085 put: ('Apple0085' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   318
        Opcodes at: 16r0086 put: ('Apple0086' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   319
        Opcodes at: 16r0087 put: ('Apple0087' -> 'Region size').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   320
        Opcodes at: 16r0088 put: ('frameSameRgn' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   321
        Opcodes at: 16r0089 put: ('paintSameRgn' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   322
        Opcodes at: 16r008A put: ('eraseSameRgn' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   323
        Opcodes at: 16r008B put: ('invertSameRgn' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   324
        Opcodes at: 16r008C put: ('fillSameRgn' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   325
        Opcodes at: 16r008D put: ('Apple008D' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   326
        Opcodes at: 16r008E put: ('Apple008E' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   327
        Opcodes at: 16r008F put: ('Apple008F' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   328
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   329
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   330
defineOpcodes09
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   331
        Opcodes at: 16r0090 put: ('BitsRect' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   332
        Opcodes at: 16r0091 put: ('BitsRgn' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   333
        Opcodes at: 16r0092 put: ('Apple0092' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   334
        Opcodes at: 16r0093 put: ('Apple0093' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   335
        Opcodes at: 16r0094 put: ('Apple0094' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   336
        Opcodes at: 16r0095 put: ('Apple0095' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   337
        Opcodes at: 16r0096 put: ('Apple0096' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   338
        Opcodes at: 16r0097 put: ('Apple0097' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   339
        Opcodes at: 16r0098 put: ('PackBitsRect' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   340
        Opcodes at: 16r0099 put: ('PackBitsRgn' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   341
        Opcodes at: 16r009A put: ('DirectBitsRect' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   342
        Opcodes at: 16r009B put: ('DirectBitsRegn' -> 'Variable').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   343
        Opcodes at: 16r009C put: ('Apple009C' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   344
        Opcodes at: 16r009D put: ('Apple009D' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   345
        Opcodes at: 16r009E put: ('Apple009E' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   346
        Opcodes at: 16r009F put: ('Apple009F' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   347
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   348
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   349
defineOpcodes10
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   350
        Opcodes at: 16r00A0 put: ('ShortComment' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   351
        Opcodes at: 16r00A1 put: ('LongComment' -> '4 + data').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   352
        Opcodes at: 16r00A2 put: ('Apple00A2' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   353
        Opcodes at: 16r00A3 put: ('Apple00A3' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   354
        Opcodes at: 16r00A4 put: ('Apple00A4' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   355
        Opcodes at: 16r00A5 put: ('Apple00A5' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   356
        Opcodes at: 16r00A6 put: ('Apple00A6' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   357
        Opcodes at: 16r00A7 put: ('Apple00A7' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   358
        Opcodes at: 16r00A8 put: ('Apple00A8' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   359
        Opcodes at: 16r00A9 put: ('Apple00A9' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   360
        Opcodes at: 16r00AA put: ('Apple00AA' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   361
        Opcodes at: 16r00AB put: ('Apple00AB' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   362
        Opcodes at: 16r00AC put: ('Apple00AC' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   363
        Opcodes at: 16r00AD put: ('Apple00AD' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   364
        Opcodes at: 16r00AE put: ('Apple00AE' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   365
        Opcodes at: 16r00AF put: ('Apple00AF' -> '2 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   366
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   367
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   368
defineOpcodes99
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   369
        Opcodes at: 16r00FF put: ('OpEndPic' -> 0).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   370
        Opcodes at: 16r02FF put: ('Version' -> 2).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   371
        Opcodes at: 16r0C00 put: ('HeaderOp' -> 24).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   372
        Opcodes at: 16r8200 put: ('CompressedQuickTime' -> '4 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   373
        Opcodes at: 16r8201 put: ('UncompressedQuickTime' -> '4 + data length').
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   374
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   375
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
initialize
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
    "install myself in the Image classes fileFormat table
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   378
     for the `.pic' and '.pict' extensions."
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   379
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   380
    MIMETypes defineImageType:nil suffix:'pict' reader:self.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   381
    MIMETypes defineImageType:nil suffix:'pic'  reader:self.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   382
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   383
    "PictReader initialize."
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   384
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   385
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   386
initializeOpcodes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   387
        "PictImageStream initializeOpcodes."
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   389
        Opcodes := IdentityDictionary new: 100.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   390
        self defineOpcodes00.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   391
        self defineOpcodes01.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   392
        self defineOpcodes02.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   393
        self defineOpcodes03.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   394
        self defineOpcodes04.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   395
        self defineOpcodes05.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   396
        self defineOpcodes06.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   397
        self defineOpcodes07.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   398
        self defineOpcodes08.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   399
        self defineOpcodes09.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   400
        self defineOpcodes10.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   401
        self defineOpcodes99.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   402
        ^Opcodes
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
! !
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   405
!PICTReader class methodsFor:'opcodes'!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   406
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   407
opcodeAt: opcode 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   408
        "PictImageStream opcodeAt: 16r8201."
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   409
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   410
        | key value string |
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   411
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   412
        Opcodes isNil ifTrue:[
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   413
            self initializeOpcodes
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   414
        ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   415
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   416
        (Opcodes includesKey: opcode)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   417
                ifTrue: [^Opcodes at: opcode].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   418
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   419
        string := opcode printStringRadix: 16.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   420
        string := string leftPaddedTo:4 with:$0.   "/ 4 - string size timesRepeat: [string := '0' , string]. "
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   421
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   422
        key := 'Apple' , string.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   423
        (16r00B0 <= opcode and: [opcode <= 16r00CF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   424
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   425
                        [value := 0.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   426
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   427
        (16r00D0 <= opcode and: [opcode <= 16r00FE])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   428
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   429
                        [value := '4 + data length'.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   430
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   431
        (16r0100 <= opcode and: [opcode <= 16r01FF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   432
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   433
                        [value := 2.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   434
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   435
        (16r0200 <= opcode and: [opcode <= 16r02FE])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   436
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   437
                        [value := 4.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   438
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   439
        (16r0300 <= opcode and: [opcode <= 16r0BFF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   440
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   441
                        [value := 22.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   442
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   443
        (16r0C01 <= opcode and: [opcode <= 16r7EFF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   444
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   445
                        [value := 24.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   446
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   447
        (16r7F00 <= opcode and: [opcode <= 16r7FFF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   448
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   449
                        [value := 254.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   450
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   451
        (16r8000 <= opcode and: [opcode <= 16r80FF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   452
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   453
                        [value := 0.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   454
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   455
        (16r8100 <= opcode and: [opcode <= 16r81FF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   456
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   457
                        [value := '4 + data length'.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   458
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   459
        (16r8201 <= opcode and: [opcode <= 16rFFFF])
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   460
                ifTrue: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   461
                        [value := '4 + data length'.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   462
                        ^key -> value].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   463
        ^nil
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   464
! !
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   465
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
!PICTReader class methodsFor:'testing'!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
isValidImageFile:aFileName
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
    "return true, if aFileName contains a sunraster image"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    |inStream nr|
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
    inStream := self streamReadingFile:aFileName.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
    inStream isNil ifTrue:[^ false].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
    "try sun raster"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
    inStream binary.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
    ((inStream nextWord == 16r59A6) 
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
    and:[inStream nextWord == 16r6A95]) ifTrue: [
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
	inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
	^ true
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
    ].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
    inStream isPositionable ifFalse:[^ false].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
    "try sun bitmap image format"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
    inStream text.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
    inStream reset.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
    "must start with a comment"
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    inStream skipSeparators.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
    inStream next ~~ $/ ifTrue:[^ false].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
    inStream next ~~ $* ifTrue:[^ false].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
    (inStream skipThroughAll: 'idth') isNil ifTrue: [
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
	inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
	^ false
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
    ].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
    inStream next; skipSeparators.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    nr := Integer readFrom: inStream.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
    (nr isNil or:[nr <= 0]) ifTrue: [
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
	inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
	^ false
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
    ].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
    (inStream skipThroughAll: 'eight') isNil ifTrue: [
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
	inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
	^ false
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
    ].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
    inStream next; skipSeparators.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
    nr := Integer readFrom: inStream.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
    (nr isNil or:[nr <= 0]) ifTrue: [
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
	inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
	^ false
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
    ].
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
    inStream close.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
    ^ true
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
! !
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   521
!PICTReader methodsFor:'commands'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   522
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   523
xBitsRect
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   524
        self debug:[ Transcript show:'xBitsRect'; cr ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   525
        ^self xPackBitsRect
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   526
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   527
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   528
xBitsRgn
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   529
        self debug:[ Transcript show:'xBitsRgn'; cr ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   530
        ^self xPackBitsRgn
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   531
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   532
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   533
xDHDVText
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   534
        | dh dv count string |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   535
        self debug:[ Transcript show:'xDHDVText'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   536
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   537
        dh := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   538
        dv := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   539
        count := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   540
        string := (self next: count) asString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   541
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   542
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   543
                        [Transcript space; show: dh printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   544
                        Transcript space; show: dv printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   545
                        Transcript space; show: count printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   546
                        Transcript space; show: string printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   547
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   548
                with: dh
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   549
                with: dv
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   550
                with: count
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   551
                with: string
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   552
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   553
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   554
xDHText
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   555
        | dh count string |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   556
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   557
        self debug:[ Transcript show:'xDHText'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   558
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   559
        dh := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   560
        count := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   561
        string := (self next: count) asString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   562
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   563
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   564
                        [Transcript space; show: dh printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   565
                        Transcript space; show: count printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   566
                        Transcript space; show: string printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   567
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   568
                with: dh
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   569
                with: count
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   570
                with: string
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   571
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   572
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   573
xDVText
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   574
        | dv count string |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   575
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   576
        self debug:[ Transcript show:'xDVText'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   577
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   578
        dv := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   579
        count := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   580
        string := (self next: count) asString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   581
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   582
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   583
                        [Transcript space; show: dv printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   584
                        Transcript space; show: count printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   585
                        Transcript space; show: string printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   586
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   587
                with: dv
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   588
                with: count
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   589
                with: string
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   590
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   591
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   592
xDirectBitsRect
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   593
        | record |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   594
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   595
        self debug:[ Transcript show:'xDirectBitsRect'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   596
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   597
        record := self readDirectPixMap: false.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   598
        self debug: [Transcript space; show: record printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   599
        imageSequence add: record.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   600
        ^record
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   601
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   602
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   603
xDirectBitsRgn
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   604
        ^self readDirectPixMap: true
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   605
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   606
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   607
xFontName
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   608
        | dataLength fontId nameLength fontName |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   609
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   610
        self debug:[ Transcript show:'xFontName'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   611
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   612
        dataLength := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   613
        fontId := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   614
        nameLength := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   615
        fontName := (self next: nameLength) asString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   616
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   617
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   618
                        [Transcript space; show: dataLength printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   619
                        Transcript space; show: fontId printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   620
                        Transcript space; show: nameLength printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   621
                        Transcript space; show: fontName printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   622
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   623
                with: dataLength
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   624
                with: fontId
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   625
                with: nameLength
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   626
                with: fontName
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   627
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   628
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   629
xLongComment
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   630
        | kind size bytes aStream char |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   631
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   632
        self debug:[ Transcript show:'xLongComment'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   633
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   634
        kind := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   635
        size := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   636
        bytes := self next: size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   637
        aStream := WriteStream on: (String new: bytes size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   638
        bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   639
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   640
                        [:byte | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   641
                        char := Character value: byte.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   642
                        ((33 <= byte and: [byte <= 126])
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   643
                                or: [char = Character tab or: [char = Character space or: [char = Character cr]]])
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   644
                                ifTrue: [aStream nextPut: char]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   645
                                ifFalse: [aStream nextPut: Character space]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   646
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   647
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   648
                        [Transcript space; show: kind printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   649
                        Transcript space; show: size printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   650
                        Transcript space; show: aStream contents printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   651
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   652
                with: kind
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   653
                with: size
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   654
                with: bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   655
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   656
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   657
xLongText
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   658
        | point count string |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   659
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   660
        self debug:[ Transcript show:'xLongText'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   661
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   662
        point := self readPoint.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   663
        count := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   664
        string := (self next: count) asString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   665
        self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   666
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   667
                        [Transcript space; show: point printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   668
                        Transcript space; show: count printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   669
                        Transcript space; show: string printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   670
        ^Array
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   671
                with: point
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   672
                with: count
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   673
                with: string
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   674
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   675
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   676
xPackBitsRect
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   677
        | position word record |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   678
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   679
        self debug:[ Transcript show:'xPackBitsRect'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   680
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   681
        position := self position.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   682
        word := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   683
        self position: position.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   684
        (word bitShift: -15)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   685
                = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   686
                ifTrue: [record := self readPixMap: false]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   687
                ifFalse: [record := self readBitMap: false].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   688
        self debug: [Transcript space; show: record printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   689
        imageSequence add: record.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   690
        ^record
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   691
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   692
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   693
xPackBitsRgn
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   694
        | position word record |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   695
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   696
        self debug:[ Transcript show:'xPackBitsRgn'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   697
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   698
        position := self position.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   699
        word := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   700
        self position: position.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   701
        (word bitShift: -15)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   702
                = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   703
                ifTrue: [record := self readPixMap: true]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   704
                ifFalse: [record := self readBitMap: true].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   705
        self debug: [Transcript space; show: record printString].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   706
        imageSequence add: record.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   707
        ^record
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   708
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   709
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   710
!PICTReader methodsFor:'debugging'!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   711
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   712
debug: aBlock
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   713
    aBlock value
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   714
! !
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   715
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   716
!PICTReader methodsFor:'decoding'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   717
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   718
readBitData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   719
        | bitData |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   720
        bitData := ByteArray new: rowBytes * bounds height.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   721
        self progress: 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   722
        1 to: bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   723
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   724
                        [:column | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   725
                        | start stop replacement |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   726
                        start := column - 1 * rowBytes + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   727
                        stop := column * rowBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   728
                        replacement := self readBitRowData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   729
                        bitData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   730
                                replaceBytesFrom: start
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   731
                                to: stop
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   732
                                with: replacement
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   733
                                startingAt: 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   734
                        self progress: column / bounds height].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   735
        ^bitData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   736
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   737
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   738
readBitMap: isMaskRgn 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   739
        | bitData anImage pad anArray maskRgn |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   740
        rowBytes := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   741
        bounds := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   742
        srcRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   743
        dstRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   744
        mode := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   745
        bitData := self readBitData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   746
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   747
        pad := rowBytes * 8 - bounds width.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   748
        pad >= 8
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   749
                ifTrue: [pad >= 16
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   750
                                ifTrue: [pad := 32]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   751
                                ifFalse: [pad := 16]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   752
                ifFalse: [pad := 8].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   753
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   754
        anImage := Image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   755
                                extent: bounds width @ bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   756
                                depth: 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   757
                                palette: MappedPalette monochromeDefault
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   758
                                bits: bitData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   759
                                pad: pad.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   760
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   761
        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   762
"/ OLD
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   763
"/        anArray := Array
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   764
"/                    with: anImage
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   765
"/                    with: srcRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   766
"/                    with: dstRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   767
"/                    with: mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   768
"/        isMaskRgn = true ifTrue: [anArray := anArray , (Array with: maskRgn)].
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   769
"/ NEW:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   770
        anArray := PICTFrame new
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   771
                    image:anImage 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   772
                    sourceRectangle:srcRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   773
                    destinationRectangle:dstRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   774
                    mode:mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   775
        isMaskRgn = true ifTrue: [
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   776
            anArray maskRegion:maskRgn
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   777
        ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   778
        ^anArray
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   779
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   780
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   781
readBitRowData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   782
        | rawData byteCount |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   783
        rowBytes < 8
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   784
                ifTrue: [rawData := self next: rowBytes]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   785
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   786
                        [rowBytes > 250
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   787
                                ifTrue: [byteCount := self nextWord]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   788
                                ifFalse: [byteCount := self next].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   789
                        rawData := self unPackBits: (self next: byteCount)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   790
        ^rawData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   791
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   792
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   793
readColorTable
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   794
        ctSeed := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   795
        ctFlags := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   796
        ctSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   797
        ctTable := Array new: ctSize + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   798
        1 to: ctTable size
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   799
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   800
                        [:i | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   801
                        | value rgb |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   802
                        value := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   803
                        value yourself.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   804
                        rgb := self nextWord bitShift: 32.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   805
                        rgb := rgb + (self nextWord bitShift: 16).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   806
                        rgb := rgb + self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   807
                        ctTable at: i put: rgb]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   808
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   809
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   810
readDataLength2
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   811
        | length bytes |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   812
        length := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   813
        bytes := self next: length.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   814
        " self debug: [Transcript space; show: bytes printString]. "
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   815
        ^Array with: length with: bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   816
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   817
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   818
readDataLength4
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   819
        | length bytes |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   820
        length := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   821
        bytes := self next: length.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   822
        " self debug: [Transcript space; show: bytes printString]. "
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   823
        ^Array with: length with: bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   824
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   825
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   826
readDirectPixData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   827
        packType = 0 ifTrue: [^self errorSorryNotSupported].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   828
        packType = 1 ifTrue: [^self errorSorryNotSupported].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   829
        packType = 2 ifTrue: [^self errorSorryNotSupported].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   830
        packType = 3 ifTrue: [^self errorSorryNotSupported].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   831
        packType = 4 ifTrue: [^self readDirectPixData4].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   832
        ^self errorUnexpectedPakingType
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   833
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   834
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   835
readDirectPixData4
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   836
        | palette image row scalingValue color index r g b |
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   837
"/        palette := FixedPalette
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   838
"/                                redShift: 16
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   839
"/                                redMask: 255
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   840
"/                                greenShift: 8
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   841
"/                                greenMask: 255
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   842
"/                                blueShift: 0
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   843
"/                                blueMask: 255.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   844
        image := Image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   845
                                extent: bounds width @ bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   846
                                depth: 24
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   847
                                palette: palette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   848
        self progress: 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   849
        0 to: bounds height - 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   850
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   851
                        [:y | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   852
                        | x |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   853
                        x := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   854
                        row := self readDirectPixRowData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   855
                        r := row size // 3 * 0 + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   856
                        g := row size // 3 * 1 + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   857
                        b := row size // 3 * 2 + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   858
                        row size // 3
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   859
                                timesRepeat: 
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   860
                                        [
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   861
                                        "/ ST/X
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   862
                                        image pixelAtX:x y:y put:( ((((row at: r) bitShift:8)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   863
                                                                    bitOr:(row at: g)) bitShift:8)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   864
                                                                   bitOr:(row at: b)).
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   865
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   866
                                        "/ VW
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   867
"/                                        scalingValue := ColorValue scalingValue.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   868
"/                                        color := ColorValue
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   869
"/                                                                scaledRed: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   870
"/                                                                                convertValue: ((row at: r)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   871
"/                                                                                                bitAnd: 255)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   872
"/                                                                                from: 255
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   873
"/                                                                                to: scalingValue)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   874
"/                                                                scaledGreen: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   875
"/                                                                                convertValue: ((row at: g)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   876
"/                                                                                                bitAnd: 255)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   877
"/                                                                                from: 255
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   878
"/                                                                                to: scalingValue)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   879
"/                                                                scaledBlue: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   880
"/                                                                                convertValue: (row at: b)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   881
"/                                                                                from: 255
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   882
"/                                                                                to: scalingValue).
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   883
"/                                        index := palette indexOfPaintNearest: color.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   884
"/                                        image
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   885
"/                                                atX: x
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   886
"/                                                y: y
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   887
"/                                                put: index.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   888
                                        r := r + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   889
                                        g := g + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   890
                                        b := b + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   891
                                        x := x + 1].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   892
                        self progress: y / (bounds height - 1)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   893
        ^image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   894
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   895
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   896
readDirectPixMap: isMaskRgn 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   897
        | anImage maskRgn anArray |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   898
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   899
        baseAddr := self nextLong.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   900
        rowBytes := self nextWord bitAnd: 16r3FFF.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   901
        bounds := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   902
        pmVersion := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   903
        packType := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   904
        packSize := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   905
        hRes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   906
        vRes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   907
        pixelType := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   908
        pixelSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   909
        cmpCount := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   910
        cmpSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   911
        planeBytes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   912
        pmTable := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   913
        pmReserved := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   914
        srcRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   915
        dstRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   916
        mode := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   917
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   918
        anImage := self readDirectPixData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   919
        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   920
"/ OLD:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   921
"/        anArray := Array
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   922
"/                                with: anImage
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   923
"/                                with: srcRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   924
"/                                with: dstRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   925
"/                                with: mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   926
"/        isMaskRgn = true ifTrue: [
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   927
"/            anArray := anArray , (Array with: maskRgn)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   928
"/        ].
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   929
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   930
"/ NEW:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   931
        anArray := PICTFrame new
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   932
                    image:anImage 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   933
                    sourceRectangle:srcRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   934
                    destinationRectangle:dstRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   935
                    mode:mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   936
        isMaskRgn = true ifTrue: [
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   937
            anArray maskRegion:maskRgn
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
   938
        ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   939
        ^anArray
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   940
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   941
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   942
readDirectPixRowData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   943
        | rawData byteCount |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   944
        (packType = 1 or: [rowBytes < 8])
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   945
                ifTrue: [rawData := self next: rowBytes]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   946
                ifFalse: [packType = 2
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   947
                                ifTrue: [rawData := self next: (rowBytes * (3 / 4)) asInteger]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   948
                                ifFalse: [packType > 2
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   949
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   950
                                                        [rowBytes > 250
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   951
                                                                ifTrue: [byteCount := self nextWord]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   952
                                                                ifFalse: [byteCount := self next].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   953
                                                        rawData := self unPackBits: (self next: byteCount)]]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   954
        ^rawData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   955
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   956
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   957
readHeader
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   958
        | position byte |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   959
        picSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   960
        picFrame := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   961
        position := self position.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   962
        byte := self next.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   963
        byte = 16r11
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   964
                ifTrue: [picVersion := self next]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   965
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   966
                        [byte := self next.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   967
                        byte = 16r11
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   968
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   969
                                        [picVersion := self next.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   970
                                        self next]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   971
                                ifFalse: [^self errorCanNotRead]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   972
        self position: position
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   973
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   974
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   975
readPixData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   976
        | pixData |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   977
        pixData := ByteArray new: rowBytes * bounds height.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   978
        self progress: 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   979
        1 to: bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   980
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   981
                        [:column | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   982
                        | start stop replacement |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   983
                        start := column - 1 * rowBytes + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   984
                        stop := column * rowBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   985
                        replacement := self readPixRowData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   986
                        pixData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   987
                                replaceBytesFrom: start
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   988
                                to: stop
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   989
                                with: replacement
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   990
                                startingAt: 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   991
                        self progress: column / bounds height].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   992
        ^pixData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   993
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   994
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   995
readPixMap: isMaskRgn 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   996
        | pixData aPalette anImage pad maskRgn anArray |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
   997
        rowBytes := self nextWord bitAnd: 16r3FFF.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   998
        bounds := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   999
        pmVersion := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1000
        packType := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1001
        packSize := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1002
        hRes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1003
        vRes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1004
        pixelType := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1005
        pixelSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1006
        cmpCount := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1007
        cmpSize := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1008
        planeBytes := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1009
        pmTable := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1010
        pmReserved := self nextLong.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1011
        self readColorTable.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1012
        srcRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1013
        dstRect := self readRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1014
        mode := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1015
        isMaskRgn = true ifTrue: [maskRgn := self readRegion].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1016
        pixData := self readPixData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1017
        aPalette := MappedPalette withColors: (ctTable collect: [:rgb | self colorValueFrom: rgb]).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1018
        pad := rowBytes * 8 - (bounds width * pixelSize).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1019
        pad >= 8
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1020
                ifTrue: [pad >= 16
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1021
                                ifTrue: [pad := 32]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1022
                                ifFalse: [pad := 16]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1023
                ifFalse: [pad := 8].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1024
        anImage := Image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1025
                                extent: bounds width @ bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1026
                                depth: pixelSize
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1027
                                palette: aPalette
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1028
                                bits: pixData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1029
                                pad: pad.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1030
        " self debug: [anImage displayOn: ScheduledControllers activeController view graphicsContext]. "
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1031
"/ OLD:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1032
"/        anArray := Array
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1033
"/                                with: anImage
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1034
"/                                with: srcRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1035
"/                                with: dstRect
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1036
"/                                with: mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1037
"/        isMaskRgn = true ifTrue: [anArray := anArray , (Array with: maskRgn)].
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1038
"/ NEW:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1039
        anArray := PICTFrame new
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1040
                    image:anImage 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1041
                    sourceRectangle:srcRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1042
                    destinationRectangle:dstRect 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1043
                    mode:mode.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1044
        isMaskRgn = true ifTrue: [
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1045
            anArray maskRegion:maskRgn
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1046
        ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1047
        ^anArray
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1048
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1049
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1050
readPixRowData
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1051
        packType = 0 ifTrue: [^self readBitRowData].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1052
        packType = 1 ifTrue: [^self readBitRowData].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1053
        ^self errorCanNotRead
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1054
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1055
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1056
readPoint
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1057
        | x y point |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1058
        x := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1059
        y := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1060
        point := x @ y.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1061
        ^point
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1062
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1063
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1064
readPolygon
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1065
        | length bytes |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1066
        length := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1067
        bytes := self next: length - 2.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1068
        " self
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1069
                debug: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1070
                        [Transcript space; show: length printString.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1071
                        Transcript space; show: bytes printString]. "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1072
        ^Array with: length with: bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1073
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1074
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1075
readRect
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1076
        | top left bottom right rect |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1077
        top := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1078
        left := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1079
        bottom := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1080
        right := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1081
        rect := left @ top corner: right @ bottom.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1082
        ^rect
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1083
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1084
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1085
readRegion
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1086
        | length bytes |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1087
        length := self nextWord.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1088
        bytes := self next: length - 2.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1089
        " self debug: 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1090
                [Transcript space; show: length printString.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1091
                Transcript space; show: bytes printString]. "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1092
        ^Array with: length with: bytes
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1093
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1094
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1095
!PICTReader methodsFor:'encoding'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1096
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1097
bitData: bitData 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1098
        | imageRowBytes packStream |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1099
        imageRowBytes := bounds width * pixelSize + 31 // 32 * 4.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1100
        packStream := WriteStream on: (ByteArray new: bitData size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1101
        self progress: 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1102
        1 to: bounds height
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1103
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1104
                        [:h | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1105
                        | rowBits packedBits |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1106
                        rowBits := bitData copyFrom: h - 1 * imageRowBytes + 1 to: h - 1 * imageRowBytes + rowBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1107
                        rowBytes < 8
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1108
                                ifTrue: [packStream nextPutAll: rowBits]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1109
                                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1110
                                        [packedBits := self packBits: rowBits.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1111
                                        rowBytes > 250
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1112
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1113
                                                        [packStream nextPut: ((packedBits size bitShift: -8)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1114
                                                                        bitAnd: 255).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1115
                                                        packStream nextPut: (packedBits size bitAnd: 255)]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1116
                                                ifFalse: [packStream nextPut: packedBits size].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1117
                                        packStream nextPutAll: packedBits].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1118
                        self progress: h / bounds height].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1119
        ^packStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1120
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1121
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1122
directPixData4: anImage 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1123
        | packStream palette r g b index color scalingValue stream |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1124
        packStream := WriteStream on: (ByteArray new: anImage bits size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1125
        palette := anImage palette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1126
        self progress: 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1127
        0 to: bounds height - 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1128
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1129
                        [:y | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1130
                        r := WriteStream on: ByteArray new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1131
                        g := WriteStream on: ByteArray new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1132
                        b := WriteStream on: ByteArray new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1133
                        0 to: bounds width - 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1134
                                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1135
                                        [:x | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1136
                                        index := anImage atX: x y: y.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1137
                                        (palette includesKey: index)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1138
                                                ifTrue: [color := palette at: index]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1139
                                                ifFalse: [color := palette at: (index bitAnd: palette maxIndex)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1140
                                        scalingValue := ColorValue scalingValue.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1141
                                        r nextPut: (self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1142
                                                        convertValue: color scaledRed
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1143
                                                        from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1144
                                                        to: 255).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1145
                                        g nextPut: (self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1146
                                                        convertValue: color scaledGreen
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1147
                                                        from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1148
                                                        to: 255).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1149
                                        b nextPut: (self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1150
                                                        convertValue: color scaledBlue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1151
                                                        from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1152
                                                        to: 255)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1153
                        stream := WriteStream on: ByteArray new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1154
                        stream nextPutAll: r contents.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1155
                        stream nextPutAll: g contents.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1156
                        stream nextPutAll: b contents.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1157
                        packStream nextPutAll: (self directPixRowData: stream contents).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1158
                        self progress: y / (bounds height - 1)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1159
        ^packStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1160
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1161
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1162
directPixRowData: row 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1163
        | aStream rawData byteCount |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1164
        aStream := WriteStream on: (ByteArray new: row size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1165
        rawData := self packBits: row.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1166
        byteCount := rawData size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1167
        rowBytes > 250
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1168
                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1169
                        [aStream nextPut: ((byteCount bitShift: -8)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1170
                                        bitAnd: 255).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1171
                        aStream nextPut: (byteCount bitAnd: 255)]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1172
                ifFalse: [aStream nextPut: byteCount].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1173
        aStream nextPutAll: rawData.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1174
        ^aStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1175
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1176
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1177
nextPutImage24: image 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1178
        | anImage endOpcode |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1179
        Cursor wait showWhile: [anImage := image "convertToPalette: (FixedPalette
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1180
                                                redShift: 16
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1181
                                                redMask: 255
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1182
                                                greenShift: 8
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1183
                                                greenMask: 255
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1184
                                                blueShift: 0
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1185
                                                blueMask: 255)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1186
                                        renderedBy: ErrorDiffusion new"].
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1187
        baseAddr := 16r000000FF.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1188
        rowBytes := anImage width * 32 + 7 // 8.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1189
        bounds := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1190
        pmVersion := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1191
        packType := 4.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1192
        packSize := 0.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1193
        hRes := 16r00480000.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1194
        vRes := 16r00480000.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1195
        pixelType := 16.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1196
        pixelSize := 32.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1197
        cmpCount := 3.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1198
        cmpSize := 8.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1199
        planeBytes := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1200
        pmTable := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1201
        pmReserved := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1202
        srcRect := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1203
        dstRect := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1204
        mode := 64.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1205
        endOpcode := 16r00FF.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1206
        self writeImage24: anImage.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1207
        self writeOpcode: endOpcode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1208
        ^anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1209
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1210
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1211
sortPalette: image 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1212
        | max array color |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1213
        max := 1 bitShift: pixelSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1214
        array := Array new: image palette maxIndex + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1215
        1 to: array size
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1216
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1217
                        [:i | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1218
                        color := image palette at: i - 1 ifAbsent: [ColorValue white].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1219
                        array at: i put: (self rgbIntegerFrom: color)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1220
        array size > max
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1221
                ifTrue: [array := array copyFrom: 1 to: max]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1222
                ifFalse: [array size < max ifTrue: [array := array , (Array new: max - array size withAll: 0)]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1223
        array := array asSortedCollection reverse collect: [:rgb | self colorValueFrom: rgb].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1224
        ^image convertToPalette: (MappedPalette withColors: array)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1225
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1226
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1227
writeBits24: bits 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1228
        | currentOpecode |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1229
        currentOpecode := 16r009A.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1230
        self writeOpcode: currentOpecode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1231
        self nextLongPut: baseAddr.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1232
        self nextWordPut: rowBytes + (1 bitShift: 15).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1233
        self writeRect: bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1234
        self nextWordPut: pmVersion.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1235
        self nextWordPut: packType.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1236
        self nextLongPut: packSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1237
        self nextLongPut: hRes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1238
        self nextLongPut: vRes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1239
        self nextWordPut: pixelType.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1240
        self nextWordPut: pixelSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1241
        self nextWordPut: cmpCount.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1242
        self nextWordPut: cmpSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1243
        self nextLongPut: planeBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1244
        self nextLongPut: pmTable.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1245
        self nextLongPut: pmReserved.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1246
        self writeRect: srcRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1247
        self writeRect: dstRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1248
        self nextWordPut: mode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1249
        self nextPutAll: bits
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1250
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1251
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1252
writeBits: bits palette: palette 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1253
        rowBytes < 8
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1254
                ifTrue: [currentOpcode := 16r90]
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1255
                ifFalse: [currentOpcode := 16r0098].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1256
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1257
                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1258
                        [self writeOpcode: currentOpcode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1259
                        self nextWordPut: rowBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1260
                        self writeRect: bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1261
                        self writeRect: srcRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1262
                        self writeRect: dstRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1263
                        self nextWordPut: mode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1264
                        self nextPutAll: bits]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1265
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1266
                        [self writeOpcode: currentOpcode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1267
                        self nextWordPut: rowBytes + (1 bitShift: 15).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1268
                        self writeRect: bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1269
                        self nextWordPut: pmVersion.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1270
                        self nextWordPut: packType.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1271
                        self nextLongPut: packSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1272
                        self nextLongPut: hRes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1273
                        self nextLongPut: vRes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1274
                        self nextWordPut: pixelType.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1275
                        self nextWordPut: pixelSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1276
                        self nextWordPut: cmpCount.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1277
                        self nextWordPut: cmpSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1278
                        self nextLongPut: planeBytes.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1279
                        self nextLongPut: pmTable.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1280
                        self nextLongPut: pmReserved.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1281
                        self nextLongPut: ctSeed.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1282
                        self nextWordPut: ctFlags.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1283
                        self nextWordPut: ctSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1284
                        ctTable := Array new: palette maxIndex + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1285
                        1 to: ctTable size
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1286
                                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1287
                                        [:i | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1288
                                        | color value rgb |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1289
                                        color := palette at: i - 1 ifAbsent: [ColorValue white].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1290
                                        value := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1291
                                        rgb := self rgbIntegerFrom: color.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1292
                                        ctTable at: i put: rgb.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1293
                                        self nextWordPut: value.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1294
                                        self nextWordPut: ((rgb bitShift: -32)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1295
                                                        bitAnd: 65535).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1296
                                        self nextWordPut: ((rgb bitShift: -16)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1297
                                                        bitAnd: 65535).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1298
                                        self nextWordPut: (rgb bitAnd: 65535)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1299
                        self writeRect: srcRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1300
                        self writeRect: dstRect.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1301
                        self nextWordPut: mode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1302
                        self nextPutAll: bits]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1303
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1304
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1305
writeClip: aRectangle 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1306
        picVersion = 1
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1307
                ifTrue: [self writeOpcode: 16r01]
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1308
                ifFalse: [self writeOpcode: 16r0001].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1309
        self nextWordPut: 10.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1310
        self writeRect: aRectangle
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1311
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1312
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1313
writeHeader24: bits 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1314
        | pictCodeSize |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1315
        pictCodeSize := 2.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1316
        picSize := 40.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1317
        picSize := picSize + pictCodeSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1318
        picSize := picSize + pictCodeSize + 10.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1319
        picSize := picSize + pictCodeSize + 68 + bits size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1320
        bits size odd ifTrue: [picSize := picSize + 1].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1321
        picSize := picSize + pictCodeSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1322
        self nextWordPut: picSize \\ 65535.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1323
        self writeRect: picFrame.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1324
        self nextWordPut: 17.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1325
        self nextWordPut: 767.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1326
        self nextWordPut: 3072.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1327
        1 to: 2 do: [:i | self nextWordPut: 65535].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1328
        1 to: 4 do: [:i | self nextWordPut: 0].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1329
        self nextWordPut: picFrame width.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1330
        1 to: 1 do: [:i | self nextWordPut: 0].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1331
        self nextWordPut: picFrame height.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1332
        1 to: 3 do: [:i | self nextWordPut: 0]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1333
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1334
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1335
writeHeader: bits palette: palette
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1336
        | pictCodeSize |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1337
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1338
                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1339
                        [pictCodeSize := 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1340
                        picSize := 12.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1341
                        picSize := picSize + pictCodeSize + 10.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1342
                        picSize := picSize + pictCodeSize + 10 + 8 + 8 + 2 + bits size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1343
                        picSize := picSize + pictCodeSize]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1344
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1345
                        [pictCodeSize := 2.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1346
                        picSize := 40.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1347
                        picSize := picSize + pictCodeSize.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1348
                        picSize := picSize + pictCodeSize + 10.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1349
                        picSize := picSize + pictCodeSize + 46 + 8 + (palette maxIndex + 1 * 8) + 8 + 8 + 2 + bits size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1350
                        bits size odd ifTrue: [picSize := picSize + 1].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1351
                        picSize := picSize + pictCodeSize].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1352
        self nextWordPut: picSize \\ 65535.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1353
        self writeRect: picFrame.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1354
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1355
                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1356
                        [self nextPut: 17.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1357
                        self nextPut: 1]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1358
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1359
                        [self nextWordPut: 17.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1360
                        self nextWordPut: 767.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1361
                        self nextWordPut: 3072.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1362
                        1 to: 2 do: [:i | self nextWordPut: 65535].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1363
                        1 to: 4 do: [:i | self nextWordPut: 0].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1364
                        self nextWordPut: picFrame width.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1365
                        1 to: 1 do: [:i | self nextWordPut: 0].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1366
                        self nextWordPut: picFrame height.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1367
                        1 to: 3 do: [:i | self nextWordPut: 0]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1368
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1369
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1370
writeImage24: anImage 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1371
        | bits |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1372
        bits := self directPixData4: anImage.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1373
        self writeHeader24: ByteArray new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1374
        self writeClip: bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1375
        self writeBits24: bits.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1376
        ^anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1377
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1378
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1379
writeImage: anImage 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1380
        | image bits |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1381
        image := self sortPalette: anImage.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1382
        bits := self bitData: image bits.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1383
        self writeHeader: bits palette: image palette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1384
        self writeClip: bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1385
        self writeBits: bits palette: image palette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1386
        ^anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1387
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1388
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1389
writeOpcode: opcode 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1390
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1391
                ifTrue: [self nextPut: opcode]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1392
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1393
                        [self position odd ifTrue: [self nextPut: 0].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1394
                        self nextWordPut: opcode]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1395
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1396
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1397
writeRect: aRectangle 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1398
        self nextWordPut: aRectangle top.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1399
        self nextWordPut: aRectangle left.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1400
        self nextWordPut: aRectangle bottom.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1401
        self nextWordPut: aRectangle right
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1402
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1403
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1404
!PICTReader methodsFor:'interpreting'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1405
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1406
fixedOpcode: opcodeName additionalData: additionalData 
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1407
    | bytes |
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1408
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1409
    " self debug: [Transcript space; show: opcodeName]. "
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1410
    bytes := self next: additionalData.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1411
    " self debug: [Transcript space; show: bytes printString] "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1412
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1413
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1414
interpretOpcode: association 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1415
        | opcodeName additionalData |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1416
        opcodeName := association key.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1417
        additionalData := association value.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1418
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1419
        self debug:[ Transcript show: 'op:'; show:opcodeName; show:' ['; show:additionalData; show:']'; cr ].
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1420
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1421
        additionalData isString
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1422
                ifTrue: [self variableOpcode: opcodeName additionalData: additionalData]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1423
                ifFalse: [self fixedOpcode: opcodeName additionalData: additionalData]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1424
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1425
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1426
nextOpcode
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1427
        | association |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1428
        " self debug: [Transcript cr.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1429
                     Transcript show: (self hexString4: self position).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1430
                     Transcript show: ':']. "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1431
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1432
                ifTrue: [currentOpcode := self next]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1433
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1434
                        [self position odd ifTrue: [self next].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1435
                        currentOpcode := self nextWord].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1436
        association := self class opcodeAt: currentOpcode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1437
        association isNil ifTrue: [^self errorUnexpectedOpcode].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1438
        self interpretOpcode: association.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1439
        ^association
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1440
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1441
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1442
variableOpcode: opcodeName additionalData: additionalData 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1443
        | aSymbol |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1444
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1445
        " self debug: [Transcript space; show: opcodeName]. "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1446
        additionalData = 'Polygon size' ifTrue: [^self readPolygon].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1447
        additionalData = 'Region size' ifTrue: [^self readRegion].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1448
        additionalData = '2 + data length' ifTrue: [^self readDataLength2].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1449
        additionalData = '4 + data length' ifTrue: [^self readDataLength4].
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1450
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1451
        (opcodeName copyFrom: 1 to: ('Apple' size min: opcodeName size))
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1452
                = 'Apple' ifTrue: [^self errorUnexpectedOpcode].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1453
        aSymbol := ((String with: $x with: opcodeName first asUppercase)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1454
                                , (opcodeName copyFrom: 2 to: opcodeName size)) asSymbol.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1455
        (self respondsTo: aSymbol)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1456
                ifTrue: [^self perform: aSymbol].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1457
        ^self errorUnexpectedOpcode
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1458
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1459
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1460
!PICTReader methodsFor:'printing'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1461
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1462
hexString2: aNumber 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1463
        | aString aStream |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1464
        aString := aNumber printStringRadix: 16.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1465
        aStream := WriteStream on: (String new: 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1466
        aStream nextPutAll: '16r'.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1467
        2 - aString size timesRepeat: [aStream nextPutAll: '0'].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1468
        aStream nextPutAll: aString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1469
        ^aStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1470
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1471
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1472
hexString4: aNumber 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1473
        | aString aStream |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1474
        aString := aNumber printStringRadix: 16.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1475
        aStream := WriteStream on: (String new: 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1476
        aStream nextPutAll: '16r'.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1477
        4 - aString size timesRepeat: [aStream nextPutAll: '0'].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1478
        aStream nextPutAll: aString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1479
        ^aStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1480
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1481
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1482
hexString8: aNumber 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1483
        | aString aStream |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1484
        aString := aNumber printStringRadix: 16.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1485
        aStream := WriteStream on: (String new: 12).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1486
        aStream nextPutAll: '16r'.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1487
        8 - aString size timesRepeat: [aStream nextPutAll: '0'].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1488
        aStream nextPutAll: aString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1489
        ^aStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1490
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1491
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1492
!PICTReader methodsFor:'private'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1493
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1494
colorValueFrom: rgbInteger 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1495
        | scalingValue |
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1496
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1497
        ^ Color 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1498
            redShort:((rgbInteger bitShift: -32) bitAnd: 65535)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1499
            greenShort:((rgbInteger bitShift: -16) bitAnd: 65535) 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1500
            blueShort:(rgbInteger bitAnd: 65535)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1501
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1502
"/        scalingValue := ColorValue scalingValue.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1503
"/        ^ColorValue
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1504
"/                scaledRed: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1505
"/                                convertValue: ((rgbInteger bitShift: -32)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1506
"/                                                bitAnd: 65535)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1507
"/                                from: 65535
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1508
"/                                to: scalingValue)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1509
"/                scaledGreen: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1510
"/                                convertValue: ((rgbInteger bitShift: -16)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1511
"/                                                bitAnd: 65535)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1512
"/                                from: 65535
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1513
"/                                to: scalingValue)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1514
"/                scaledBlue: (self
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1515
"/                                convertValue: (rgbInteger bitAnd: 65535)
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1516
"/                                from: 65535
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1517
"/                                to: scalingValue)
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1518
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1519
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1520
errorSorryNotSupported
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1521
        self error: 'sorry, not supported'.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1522
        ^nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1523
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1524
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1525
errorUnexpectedOpcode
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1526
        | string |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1527
        picVersion = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1528
                ifTrue: [string := self hexString2: currentOpcode]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1529
                ifFalse: [string := self hexString4: currentOpcode].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1530
        string := (self hexString8: self position)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1531
                                , ': ' , string.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1532
        self error: 'unexpected opcode: ' , string.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1533
        ^nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1534
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1535
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1536
errorUnexpectedPakingType
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1537
        self error: 'unexpected packing type: ' , packType printString.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1538
        ^nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1539
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1540
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1541
mergeImages
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1542
        | aRectangle aDepth aPalette anImage aPattern indexValue |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1543
        aRectangle := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1544
        aDepth := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1545
        aPalette := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1546
        imageSequence
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1547
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1548
                        [:array | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1549
                        aRectangle isNil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1550
                                ifTrue: [aRectangle := array at: 3]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1551
                                ifFalse: [aRectangle := aRectangle merge: (array at: 3)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1552
                        aDepth isNil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1553
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1554
                                        [aDepth := (array at: 1) depth.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1555
                                        aPalette := (array at: 1) palette]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1556
                                ifFalse: [aDepth < (array at: 1) depth
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1557
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1558
                                                        [aDepth := (array at: 1) depth.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1559
                                                        aPalette := (array at: 1) palette]]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1560
        anImage := Image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1561
                                extent: aRectangle extent
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1562
                                depth: aDepth
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1563
                                palette: aPalette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1564
        aPattern := Image
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1565
                                extent: 16 @ 16
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1566
                                depth: anImage depth
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1567
                                palette: anImage palette.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1568
        indexValue := aPattern palette indexOfPaintNearest: ColorValue white.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1569
        0 to: aPattern width - 1 do: [:x | 0 to: aPattern height - 1 do: [:y | aPattern atPoint: x @ y put: indexValue]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1570
        anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1571
                tile: aRectangle
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1572
                from: Point zero
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1573
                in: aPattern
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1574
                rule: RasterOp over.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1575
        imageSequence
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1576
                do: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1577
                        [:array | 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1578
                        | srcImage srcR dstR |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1579
                        srcImage := array at: 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1580
                        srcR := array at: 2.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1581
                        dstR := array at: 3.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1582
                        srcImage palette = aPalette ifFalse: [srcImage := srcImage convertToPalette: aPalette renderedBy: ErrorDiffusion new].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1583
                        dstR := dstR translatedBy: Point zero - aRectangle origin.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1584
                        anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1585
                                copy: dstR
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1586
                                from: srcR origin
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1587
                                in: srcImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1588
                                rule: RasterOp over].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1589
        ^anImage
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1590
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1591
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1592
packBits: bits 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1593
        | packStream prev writeBlock bitSize bitPos start code replicateSize literalSize |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1594
        packStream := WriteStream on: (ByteArray new: bits size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1595
        prev := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1596
        writeBlock := [:asc | asc key < 0
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1597
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1598
                                        ["replicate"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1599
                                        packStream nextPut: asc key negated.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1600
                                        packStream nextPut: asc value]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1601
                                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1602
                                        ["literal"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1603
                                        | litStart litStop |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1604
                                        litStart := asc value first.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1605
                                        litStop := asc value last.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1606
                                        asc key = (litStop - litStart) ifFalse: [self error: 'can''t happen'].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1607
                                        [litStop - litStart + 1 > 128]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1608
                                                whileTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1609
                                                        [packStream nextPut: 127.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1610
                                                        litStart to: litStart + 127 do: [:litIndex | packStream nextPut: (bits at: litIndex)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1611
                                                        litStart := litStart + 128].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1612
                                        litStart <= litStop
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1613
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1614
                                                        [packStream nextPut: litStop - litStart + 1 - 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1615
                                                        litStart to: litStop do: [:litIndex | packStream nextPut: (bits at: litIndex)]]]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1616
        bitSize := bits size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1617
        bitPos := 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1618
        [bitPos <= bitSize]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1619
                whileTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1620
                        [start := bitPos.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1621
                        code := bits at: start.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1622
                        [(bitPos := bitPos + 1) <= bitSize and: [(bits at: bitPos)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1623
                                        = code]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1624
                                whileTrue: [].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1625
                        replicateSize := bitPos - start.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1626
                        replicateSize > 128
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1627
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1628
                                        [prev == nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1629
                                                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1630
                                                        [writeBlock value: prev.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1631
                                                        prev := nil].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1632
                                        [replicateSize > 128]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1633
                                                whileTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1634
                                                        [writeBlock value: -129 -> code.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1635
                                                        start := start + 128.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1636
                                                        replicateSize := replicateSize - 128]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1637
                        replicateSize = 2
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1638
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1639
                                        ["treat as literal"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1640
                                        literalSize := 2.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1641
                                        prev ~~ nil ifTrue: [prev key >= 0
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1642
                                                        ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1643
                                                                ["prev is literal"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1644
                                                                literalSize := literalSize + prev value size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1645
                                                                start := prev value first]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1646
                                                        ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1647
                                                                [writeBlock value: prev.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1648
                                                                prev := nil]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1649
                                        prev := literalSize - 1 -> (start to: start + literalSize - 1)]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1650
                                ifFalse: [replicateSize > 2
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1651
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1652
                                                        [prev == nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1653
                                                                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1654
                                                                        [writeBlock value: prev.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1655
                                                                        prev := nil].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1656
                                                        prev := (256 - (replicateSize - 1)) negated -> code]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1657
                                                ifFalse: ["replicateSize < 2"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1658
                                                        bitPos := bitPos - 1]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1659
                        (start := bitPos) <= bitSize
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1660
                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1661
                                        [code := bits at: start.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1662
                                        [(bitPos := bitPos + 1) <= bitSize and: [(bits at: bitPos)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1663
                                                        ~= code]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1664
                                                whileTrue: [code := bits at: bitPos].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1665
                                        bitPos <= bitSize ifTrue: [bitPos := bitPos - 1].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1666
                                        literalSize := bitPos - start.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1667
                                        literalSize > 0
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1668
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1669
                                                        [prev ~~ nil ifTrue: [prev key >= 0
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1670
                                                                        ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1671
                                                                                ["prev is literal"
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1672
                                                                                literalSize := literalSize + prev value size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1673
                                                                                start := prev value first]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1674
                                                                        ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1675
                                                                                [writeBlock value: prev.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1676
                                                                                prev := nil]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1677
                                                        prev := literalSize - 1 -> (start to: start + literalSize - 1)]]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1678
        prev == nil
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1679
                ifFalse: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1680
                        [writeBlock value: prev.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1681
                        prev := nil].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1682
        ^packStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1683
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1684
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1685
progress:fraction
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1686
    self reportProgress:fraction
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1687
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1688
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1689
rgbIntegerFrom: aColorValue 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1690
        | scalingValue |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1691
        scalingValue := ColorValue scalingValue.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1692
        ^((self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1693
                convertValue: aColorValue scaledRed
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1694
                from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1695
                to: 65535)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1696
                bitShift: 32)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1697
                + ((self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1698
                                convertValue: aColorValue scaledGreen
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1699
                                from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1700
                                to: 65535)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1701
                                bitShift: 16) + (self
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1702
                        convertValue: aColorValue scaledBlue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1703
                        from: scalingValue
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1704
                        to: 65535)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1705
!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1706
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1707
unPackBits: bits 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1708
        | unpackStream bitSize bitPos code |
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1709
        unpackStream := WriteStream on: (ByteArray new: bits size).
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1710
        bitSize := bits size.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1711
        bitPos := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1712
        [(bitPos := bitPos + 1) <= bitSize]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1713
                whileTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1714
                        [code := bits at: bitPos.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1715
                        code < 128
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1716
                                ifTrue: [1 to: code + 1 do: [:i | unpackStream nextPut: (bits at: (bitPos := bitPos + 1))]]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1717
                                ifFalse: [code > 128
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1718
                                                ifTrue: 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1719
                                                        [bitPos := bitPos + 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1720
                                                        1 to: 256 - code + 1 do: [:i | unpackStream nextPut: (bits at: bitPos)]]]].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1721
        ^unpackStream contents
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1722
! !
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1723
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1724
!PICTReader methodsFor:'reading'!
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1725
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1726
fromStream: aStream 
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1727
    "read an image in my format from aStream.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1728
     Dtermine if its a raster or icon file."
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1729
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1730
    |endOpcode|
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1731
1816
5450e44ed7e9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1808
diff changeset
  1732
"/    ^ self fileFormatError:'Sorry - PICT image implementation is incomplete'.
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1733
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1734
    inStream := aStream.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1735
    aStream binary.
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1736
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1737
    inStream skip:512.      "apples file header"
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1738
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1739
    currentOpcode := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1740
    imageSequence := OrderedCollection new.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1741
    self readHeader.
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1742
    self reportDimension.
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1743
    endOpcode := 16r00FF.
1843
fef27ba933ff checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
  1744
    [currentOpcode = endOpcode] whileFalse: [self nextOpcode].
fef27ba933ff checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
  1745
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1746
    imageSequence isEmpty ifTrue: [^nil].
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1747
    imageSequence size = 1 ifTrue: [
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1748
        "/ OLD:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1749
        "/ ^ imageSequence first first
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1750
        "/ NEW:
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1751
        ^ imageSequence first image
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1752
    ].
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1753
    ^ self mergeImages
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1754
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1755
    "
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1756
     PICTReader fromFile:'/unsaved2/stefan/nil/home/stefan/dos/winword/shared/ms.pct'
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1757
    "
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1758
! !
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1759
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1760
!PICTReader methodsFor:'support-IO'!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1761
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1762
next
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1763
    ^ inStream nextByte
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1764
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1765
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1766
next:numBytes 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1767
        ^ inStream next:numBytes
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1768
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1769
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1770
nextLong
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1771
"/    ^ (inStream next bitShift: 24)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1772
"/            + (inStream next bitShift: 16) + (inStream next bitShift: 8) + inStream next
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1773
    ^ inStream nextUnsignedLongMSB:true
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1774
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1775
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1776
nextLongPut:a32BitW 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1777
"/    outStream nextPut: ((a32BitW bitShift: -24)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1778
"/                    bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1779
"/    outStream nextPut: ((a32BitW bitShift: -16)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1780
"/                    bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1781
"/    outStream nextPut: ((a32BitW bitShift: -8)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1782
"/                    bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1783
"/    outStream nextPut: (a32BitW bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1784
    outStream nextPutLong:a32BitW MSB:true.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1785
    ^a32BitW
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1786
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1787
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1788
nextPut:aByte 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1789
    outStream nextPut:aByte
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1790
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1791
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1792
nextWord
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1793
    ^ inStream nextUnsignedShortMSB:true
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1794
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1795
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1796
nextWordPut:a16BitW 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1797
"/    outStream nextPut: ((a16BitW bitShift: -8)
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1798
"/                    bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1799
"/    outStream nextPut: (a16BitW bitAnd: 255).
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1800
    outStream nextPutShort:a16BitW MSB:true.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1801
    ^a16BitW
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1802
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1803
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1804
position
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1805
    ^ inStream position
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1806
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1808
position:arg 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1809
    inStream position:arg
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1810
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1811
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1812
size
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1813
    self halt.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1814
    ^ outStream size
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1815
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1816
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1817
skip: anInteger 
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1818
self halt.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1819
    ^ inStream skip: anInteger
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1820
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1821
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1822
space
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1823
    ^ outStream space
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1824
!
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1825
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1826
tab
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1827
    ^ outStream tab
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1828
! !
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1829
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1830
!PICTReader methodsFor:'writing'!
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1831
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1832
nextPutImage: anImage 
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1833
        | endOpcode |
1807
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1834
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1835
    ^ self fileFormatError:'Sorry - PICT image implementation is incomplete'.
aa6be4550ac7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1806
diff changeset
  1836
1806
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1837
"/        (anImage isKindOf: Image) not ifTrue: [^self errorCanNotWrite].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1838
"/        ((imageStream isKindOf: ExternalStream)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1839
"/                or: [(imageStream respondsTo: #stream)
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1840
"/                                and: [imageStream stream isKindOf: ExternalStream]])
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1841
"/                ifTrue: [self nextPutAll: (ByteArray new: 512)].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1842
"/        picSize := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1843
"/        picFrame := 0 @ 0 extent: anImage extent.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1844
"/        anImage bitsPerPixel = 1
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1845
"/                ifTrue: [picVersion := 1]
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1846
"/                ifFalse: [picVersion := 2].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1847
"/        anImage bitsPerPixel > 8 ifTrue: [^self nextPutImage24: anImage].
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1848
"/        rowBytes := anImage width * anImage bitsPerPixel + 7 // 8.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1849
"/        bounds := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1850
"/        pmVersion := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1851
"/        packType := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1852
"/        packSize := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1853
"/        hRes := '16r00480000' asNumber.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1854
"/        vRes := '16r00480000' asNumber.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1855
"/        pixelType := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1856
"/        pixelSize := anImage bitsPerPixel.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1857
"/        cmpCount := 1.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1858
"/        cmpSize := anImage bitsPerPixel.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1859
"/        planeBytes := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1860
"/        pmTable := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1861
"/        pmReserved := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1862
"/        ctSeed := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1863
"/        ctFlags := '16r8000' asNumber.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1864
"/        ctSize := anImage palette maxIndex.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1865
"/        ctTable := nil.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1866
"/        srcRect := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1867
"/        dstRect := anImage bounds.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1868
"/        mode := 0.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1869
"/        endOpcode := '16r00FF' asNumber.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1870
"/        self writeImage: anImage.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1871
"/        self writeOpcode: endOpcode.
69e71e3497c0 still not working
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
  1872
"/        ^anImage
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1873
! !
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1874
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1875
!PICTReader::PICTFrame methodsFor:'accessing'!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1876
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1877
destinationRectangle
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1878
    ^ destinationRectangle
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1879
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1880
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1881
image
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1882
    ^ image
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1883
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1884
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1885
image:imageArg sourceRectangle:sourceRectangleArg destinationRectangle:destinationRectangleArg mode:modeArg 
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1886
    "set instance variables (automatically generated)"
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1887
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1888
    image := imageArg.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1889
    sourceRectangle := sourceRectangleArg.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1890
    destinationRectangle := destinationRectangleArg.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1891
    mode := modeArg.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1892
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1893
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1894
maskRegion
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1895
    ^ maskRegion
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1896
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1897
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1898
maskRegion:something
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1899
    maskRegion := something.
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1900
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1901
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1902
mode
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1903
    ^ mode
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1904
!
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1905
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1906
sourceRectangle
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1907
    ^ sourceRectangle
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1908
! !
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1909
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1910
!PICTReader class methodsFor:'documentation'!
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1911
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1912
version
1849
e3c78a95e9f2 reads some pixel-images
Claus Gittinger <cg@exept.de>
parents: 1843
diff changeset
  1913
    ^ '$Header: /cvs/stx/stx/libview2/PICTReader.st,v 1.7 2003-11-19 19:18:30 cg Exp $'
1804
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1914
! !
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1915
f84ff77deaea initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1916
PICTReader initialize!