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