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