ByteArray.st
author Claus Gittinger <cg@exept.de>
Thu, 06 Mar 1997 15:29:25 +0100
changeset 2447 e83cf6acfdcf
parent 2145 d243ffafeae3
child 2464 e44ab57ff8ae
permissions -rw-r--r--
fixed #fromPackedString:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
10
claus
parents: 5
diff changeset
    13
ArrayedCollection variableByteSubclass:#ByteArray
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    14
	instanceVariableNames:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    15
	classVariableNames:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    16
	poolDictionaries:''
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
    17
	category:'Collections-Arrayed'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
    20
!ByteArray class methodsFor:'documentation'!
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    21
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    22
copyright
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    23
"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    24
 COPYRIGHT (c) 1989 by Claus Gittinger
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    25
	      All Rights Reserved
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    26
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    27
 This software is furnished under a license and may be used
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    28
 only in accordance with the terms of that license and with the
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    30
 be provided or otherwise made available to, or used by, any
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    31
 other person.  No title to or ownership of the software is
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    32
 hereby transferred.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    33
"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    34
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    35
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
documentation
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
    ByteArrays store integers in the range 0..255.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    39
    In contrast to normal arrays (which store pointers to their elements),
362
claus
parents: 359
diff changeset
    40
    byteArrays store the values in a dense & compact way. ByteArrays can
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    41
    be used to hold the data for bitmaps, images and other bulk data.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    42
    ByteArrays are also used to store the bytecode-instructions of an
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    43
    interpreted method and are used as superclass for Strings.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    44
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    45
    ByteArrays can be used as literals i.e. you can enter ByteArray-constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    46
    as #[ element1 element2 .... elementN] and also use byteArray constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    47
    as elements in a constant array.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    48
    As in: #( #[1 1 1] #[2 2 2] #[3 3 3])
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    49
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    50
    If you have to communicate structure-data (in the C-sense) with external
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    51
    programs/data-bases, see a companion class (Structure) in the goodies directory.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    52
    It allows the definition of subclasses of ByteArray, which transparently fetch
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    53
    and store C-structure fields.
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
    54
2145
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    55
    [warning:]
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    56
        read the warning about 'growing fixed size collection'
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    57
        in ArrayedCollection's documentation
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    58
1290
15ba3221b89b documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
    59
    [author:]
15ba3221b89b documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
    60
        Claus Gittinger
15ba3221b89b documentation
Claus Gittinger <cg@exept.de>
parents: 1266
diff changeset
    61
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
    62
    [See also:]
2145
d243ffafeae3 more docu
Claus Gittinger <cg@exept.de>
parents: 1974
diff changeset
    63
        Array CharacterArray String
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    64
"
2
claus
parents: 1
diff changeset
    65
! !
claus
parents: 1
diff changeset
    66
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
    67
!ByteArray class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    68
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    69
fromPackedString:aString
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    70
    "ST-80 compatibility: decode a byteArray from a packed string in which
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    71
     6bits are encoded per character. The argument, aString must be a multiple 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    72
     of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    73
     the radix-encoding used in good old PDP11 times ;-)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    74
     ST-80 uses this encoding for Images ...
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    75
     PS: It took a while to figure that one out ... I dont like it ;-)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    76
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    77
    |index    "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    78
     dstIndex "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    79
     stop     "{ Class: SmallInteger }"
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    80
     sixBits  "{ Class: SmallInteger }"
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    81
     n        "{ Class: SmallInteger }"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    82
     sz       "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    83
     lastCharacter bytes|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    84
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    85
    sz := aString size.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    86
    sz == 0 ifTrue:[^ self new].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    87
    stop := sz // 4 * 3.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    88
    "the size modulu 3 is encoded in the last character, if its in the
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    89
     range 97 .. otherwise, its exact."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    90
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    91
    lastCharacter := aString last.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    92
    lastCharacter asciiValue > 96 ifTrue:[
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    93
        stop := stop - 3 + lastCharacter asciiValue - 96
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    94
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    95
    bytes := self new:stop.
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    96
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    97
    index := 1. dstIndex := 1.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
    98
    [dstIndex <= stop] whileTrue:[
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
    99
        "take 4 characters ..."
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   100
        sixBits := (aString at:index) asciiValue.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   101
        sixBits := sixBits bitAnd:16r3F.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   102
        n := sixBits.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   103
        
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   104
        sixBits := (aString at:index+1) asciiValue.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   105
        sixBits := sixBits bitAnd:16r3F.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   106
        n := (n bitShift:6) + sixBits.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   107
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   108
        sixBits := (aString at:index+2) asciiValue.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   109
        sixBits := sixBits bitAnd:16r3F.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   110
        n := (n bitShift:6) + sixBits.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   111
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   112
        sixBits := (aString at:index+3) asciiValue.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   113
        sixBits := sixBits bitAnd:16r3F.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   114
        n := (n bitShift:6) + sixBits.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   115
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   116
        index := index + 4.
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   117
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   118
        "/ now have 24 bits in n
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   119
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   120
        bytes at:dstIndex put:(n bitShift:-16).
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   121
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   122
        dstIndex < stop ifTrue:[
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   123
            bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF).
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   124
            dstIndex+2 <= stop ifTrue:[
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   125
                bytes at:dstIndex+2 put:(n bitAnd:16rFF).
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   126
            ]
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   127
        ].
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   128
        dstIndex := dstIndex + 3.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   129
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   130
    ^ bytes
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   131
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   132
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   133
     ByteArray fromPackedString:(#[1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   134
     ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   135
     ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   136
     ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   137
     ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   138
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   139
    "
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   140
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
   141
    "Modified: 6.3.1997 / 15:28:52 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   142
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   143
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
uninitializedNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   145
    "return a new instance of the receiver with uninitialized
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
     (i.e. undefined) contents. The indexed elements have any random
75
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   147
     value. However, any named instance variables are still nilled. 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   148
     For use, when contents will be set anyway shortly after - this
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   149
     is a bit faster than the regular basicNew:, which clears the bytes.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   150
     Of course, it only makes a difference for very big ByteArrays, such
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   151
     as used for images/bitmaps.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   152
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   153
     Notice: if you want to port code using uninitializedNew: to another
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   154
     smalltalk, you have to add an 'uninitializedNew: -> basicNew:'-calling 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   155
     method to the ByteArray class of the other smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    OBJ newobj;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    INT instsize, nInstVars, nindexedinstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
249
claus
parents: 221
diff changeset
   162
    if (__isSmallInteger(anInteger)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   163
	nindexedinstvars = __intVal(anInteger);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   164
	if (nindexedinstvars >= 0) {
249
claus
parents: 221
diff changeset
   165
	    if (self == ByteArray) {
claus
parents: 221
diff changeset
   166
		/*
claus
parents: 221
diff changeset
   167
		 * the most common case
claus
parents: 221
diff changeset
   168
		 */
claus
parents: 221
diff changeset
   169
		instsize = OHDR_SIZE + nindexedinstvars;
835
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
   170
		if (__CanDoQuickNew(instsize)) {
8bd6f4aa8130 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 834
diff changeset
   171
		    __qCheckedNew(newobj, instsize);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   172
		    __InstPtr(newobj)->o_class = self;
249
claus
parents: 221
diff changeset
   173
		    RETURN (newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   174
		}
249
claus
parents: 221
diff changeset
   175
	    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   176
	    nInstVars = __intVal(__ClassInstPtr(self)->c_ninstvars);
249
claus
parents: 221
diff changeset
   177
	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   178
	    __PROTECT_CONTEXT__
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
   179
	    __qNew(newobj, instsize);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
   180
	    __UNPROTECT_CONTEXT__
281
d63a7d2c31a6 *** empty log message ***
claus
parents: 249
diff changeset
   181
	    if (newobj != nil) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   182
		__InstPtr(newobj)->o_class = self;
367
a2114577b799 *** empty log message ***
claus
parents: 362
diff changeset
   183
		__qSTORE(newobj, self);
249
claus
parents: 221
diff changeset
   184
		if (nInstVars) {
claus
parents: 221
diff changeset
   185
		    /*
claus
parents: 221
diff changeset
   186
		     * still have to nil out named instvars ...
claus
parents: 221
diff changeset
   187
		     */
788
e80f1c42b87b dont use memset4 if its undefined
Claus Gittinger <cg@exept.de>
parents: 628
diff changeset
   188
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4)
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   189
		    memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
#else
249
claus
parents: 221
diff changeset
   191
# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)
claus
parents: 221
diff changeset
   192
		    /*
claus
parents: 221
diff changeset
   193
		     * knowing that nil is 0
claus
parents: 221
diff changeset
   194
		     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   195
		    memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
249
claus
parents: 221
diff changeset
   196
# else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   197
		    op = __InstPtr(newobj)->i_instvars;
249
claus
parents: 221
diff changeset
   198
		    while (nInstVars--)
claus
parents: 221
diff changeset
   199
			*op++ = nil;
claus
parents: 221
diff changeset
   200
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   202
		}
249
claus
parents: 221
diff changeset
   203
		RETURN ( newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   204
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   205
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   208
.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   209
    (anInteger isMemberOf:SmallInteger) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   210
	(anInteger < 0) ifTrue:[
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   211
	    ^ self error:'bad (negative) argument to new'
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   212
	].
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   213
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   214
	 memory allocation failed.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   215
	 When we arrive here, there was no memory, even after
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   216
	 a garbage collect. This means, that the VM wanted to
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   217
	 get some more memory from the Operatingsystem, which
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   218
	 was not kind enough to give some.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   219
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   220
	^ ObjectMemory allocationFailureSignal raise.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   221
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
    ^ self basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   225
!ByteArray class methodsFor:'binary storage'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   227
binaryDefinitionFrom: stream manager: manager
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   228
    "get a ByteArray from the binary stream.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   229
     ByteArrays are stored as 4-byte size, followed by the bytes"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   231
    "take care of subclasses ..."
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   232
    self == ByteArray ifTrue:[
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   233
	^ (stream next: (stream nextNumber: 4))
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   234
    ].
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   235
    ^ super binaryDefinitionFrom: stream manager: manager
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   236
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   237
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   238
!ByteArray class methodsFor:'queries'!
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   239
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   240
isBuiltInClass
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   241
    "return true if this class is known by the run-time-system.
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   242
     Here, true is returned for myself, false for subclasses."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   243
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   244
    ^ self == ByteArray
1266
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   245
cef9b3cd49df commentary
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
   246
    "Modified: 23.4.1996 / 15:56:25 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   247
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   248
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
   249
!ByteArray methodsFor:'accessing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   251
basicAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   252
    "return the indexed instance variable with index, anInteger
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   253
     - redefined here to be slighly faster than the default in Object.
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   254
     Q: is it worth the extra code ?"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   255
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   256
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   257
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   258
    REGISTER int indx;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   259
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   260
    REGISTER OBJ cls;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   261
    REGISTER int nIndex;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   262
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   263
    if (__isSmallInteger(index)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   264
	indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   265
	slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   266
	if ((cls = __qClass(slf)) != @global(ByteArray)) {
1384
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   267
	    if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   268
		!= __MASKSMALLINT(BYTEARRAY)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   269
		goto fail;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   270
	    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   271
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   272
	}
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   273
	nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   274
	if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   275
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   276
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   277
    }
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   278
  fail: ;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   279
%}.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   280
    ^ super basicAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   281
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   282
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   283
basicAt:index put:value
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   284
    "set the indexed instance variable with index, anInteger to value.
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   285
     Returns value (sigh).
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   286
     - redefined here to be slighly faster than the default in Object.
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   287
     Q: is it worth the extra code ?"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
    REGISTER int indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
    int nIndex;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   293
    int val;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   294
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   295
    REGISTER OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   296
249
claus
parents: 221
diff changeset
   297
    if (__bothSmallInteger(index, value)) {
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   298
        val = __intVal(value);
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   299
        if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   300
            indx = __intVal(index) - 1;
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   301
            slf = self;
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   302
            if ((cls = __qClass(slf)) != @global(ByteArray)) {
1384
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   303
                if (((INT)__ClassInstPtr(cls)->c_flags & __MASKSMALLINT(ARRAYMASK))
ab9536f4f998 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1335
diff changeset
   304
                    != __MASKSMALLINT(BYTEARRAY)) {
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   305
                    goto fail;
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   306
                }
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   307
                indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   308
            }
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   309
            nIndex = __byteArraySize(slf);
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   310
            if ((unsigned)indx < (unsigned)nIndex) {
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   311
                __ByteArrayInstPtr(slf)->ba_element[indx] = val;
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   312
                RETURN ( value );
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   313
            }
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   314
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   315
    }
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   316
  fail: ;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   317
%}.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   318
    ^ super basicAt:index put:value
1230
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   319
c349c4e9e594 commentary
Claus Gittinger <cg@exept.de>
parents: 1213
diff changeset
   320
    "Modified: 19.4.1996 / 11:14:40 / cg"
2
claus
parents: 1
diff changeset
   321
!
claus
parents: 1
diff changeset
   322
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   323
byteAt:index
249
claus
parents: 221
diff changeset
   324
    "return the byte at index. 
claus
parents: 221
diff changeset
   325
     For ByteArray, this is the same as basicAt:; 
claus
parents: 221
diff changeset
   326
     however, for strings or symbols, this returns a numeric byteValue
claus
parents: 221
diff changeset
   327
     instead of a character."
claus
parents: 221
diff changeset
   328
claus
parents: 221
diff changeset
   329
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   330
claus
parents: 221
diff changeset
   331
    REGISTER int indx;
claus
parents: 221
diff changeset
   332
    int nIndex;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   333
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   334
    REGISTER OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   335
249
claus
parents: 221
diff changeset
   336
    if (__isSmallInteger(index)) {
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   337
	indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   338
	slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   339
	if ((cls = __qClass(slf)) != @global(ByteArray))
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   340
	    indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   341
	nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   342
	if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   343
	    RETURN ( __MKSMALLINT(__ByteArrayInstPtr(slf)->ba_element[indx]) );
249
claus
parents: 221
diff changeset
   344
	}
claus
parents: 221
diff changeset
   345
    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   346
%}.
249
claus
parents: 221
diff changeset
   347
    ^ (super basicAt:index) asInteger
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   348
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   349
249
claus
parents: 221
diff changeset
   350
byteAt:index put:value
claus
parents: 221
diff changeset
   351
    "set the byte at index. For ByteArray, this is the same as basicAt:put:.
claus
parents: 221
diff changeset
   352
     However, for Strings, this expects a byteValue to be stored."
claus
parents: 221
diff changeset
   353
claus
parents: 221
diff changeset
   354
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   355
claus
parents: 221
diff changeset
   356
    REGISTER int indx;
claus
parents: 221
diff changeset
   357
    int nIndex;
claus
parents: 221
diff changeset
   358
    int val;
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   359
    REGISTER OBJ slf;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   360
    REGISTER OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   361
249
claus
parents: 221
diff changeset
   362
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   363
	val = __intVal(value);
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   364
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   365
	    indx = __intVal(index) - 1;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   366
	    slf = self;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   367
	    if ((cls = __qClass(slf)) != ByteArray)
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   368
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   369
	    nIndex = __byteArraySize(slf);
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   370
	    if ((unsigned)indx < (unsigned)nIndex) {
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   371
		__ByteArrayInstPtr(slf)->ba_element[indx] = val;
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   372
		RETURN ( value );
249
claus
parents: 221
diff changeset
   373
	    }
claus
parents: 221
diff changeset
   374
	}
claus
parents: 221
diff changeset
   375
    }
1147
a83c86d02b59 can do low..hi index check with one compare
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   376
%}.
249
claus
parents: 221
diff changeset
   377
    ^ super basicAt:index put:value
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   378
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   379
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   380
doubleAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   381
    "return the 8-bytes starting at index as a Float.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   382
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   383
     Notice also, that the bytes are expected to be in this machines
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   384
     float representation - if the bytearray originated from another
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   385
     machine, some conversion is usually needed."
2
claus
parents: 1
diff changeset
   386
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   387
    |newFloat|
359
claus
parents: 343
diff changeset
   388
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   389
    newFloat := Float basicNew.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   390
    1 to:8 do:[:destIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   391
	newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
359
claus
parents: 343
diff changeset
   392
    ].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   393
    ^ newFloat.
359
claus
parents: 343
diff changeset
   394
!
claus
parents: 343
diff changeset
   395
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   396
doubleAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   397
    "store the value of the argument, aFloat into the receiver
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   398
     starting at index.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   399
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   400
     Notice also, that the bytes are expected to be in this machines
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   401
     float representation - if the bytearray originated from another
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   402
     machine, some conversion is usually needed."
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   403
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   404
    1 to:8 do:[:srcIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   405
	self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex)
359
claus
parents: 343
diff changeset
   406
    ].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   407
    ^ aFloat
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   408
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   409
2
claus
parents: 1
diff changeset
   410
doubleWordAt:index
claus
parents: 1
diff changeset
   411
    "return the 4-bytes starting at index as an (unsigned) Integer.
359
claus
parents: 343
diff changeset
   412
     The value is retrieved in the machines natural byte order.
claus
parents: 343
diff changeset
   413
     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"
claus
parents: 343
diff changeset
   414
claus
parents: 343
diff changeset
   415
%{  /* NOCONTEXT */
claus
parents: 343
diff changeset
   416
claus
parents: 343
diff changeset
   417
    REGISTER int indx;
claus
parents: 343
diff changeset
   418
    int nIndex;
claus
parents: 343
diff changeset
   419
    union {
claus
parents: 343
diff changeset
   420
	char u_char[4];
claus
parents: 343
diff changeset
   421
	unsigned u_uint;
claus
parents: 343
diff changeset
   422
    } val;
claus
parents: 343
diff changeset
   423
    OBJ cls;
claus
parents: 343
diff changeset
   424
claus
parents: 343
diff changeset
   425
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   426
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   427
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   428
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   429
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   430
	    nIndex = __byteArraySize(self);
claus
parents: 343
diff changeset
   431
	    if ((indx+3) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   432
		val.u_char[0] = __ByteArrayInstPtr(self)->ba_element[indx+0-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   433
		val.u_char[1] = __ByteArrayInstPtr(self)->ba_element[indx+1-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   434
		val.u_char[2] = __ByteArrayInstPtr(self)->ba_element[indx+2-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   435
		val.u_char[3] = __ByteArrayInstPtr(self)->ba_element[indx+3-1];
359
claus
parents: 343
diff changeset
   436
		if ((val.u_uint >= 0) && (val.u_uint <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   437
		    RETURN ( __MKSMALLINT(val.u_uint) );
359
claus
parents: 343
diff changeset
   438
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   439
		RETURN ( __MKULARGEINT(val.u_uint) );
359
claus
parents: 343
diff changeset
   440
	    }
claus
parents: 343
diff changeset
   441
	}
claus
parents: 343
diff changeset
   442
    }
claus
parents: 343
diff changeset
   443
%}.
claus
parents: 343
diff changeset
   444
    ^ SubscriptOutOfBoundsSignal raise.
claus
parents: 343
diff changeset
   445
claus
parents: 343
diff changeset
   446
    "
claus
parents: 343
diff changeset
   447
     |b|
claus
parents: 343
diff changeset
   448
claus
parents: 343
diff changeset
   449
     b := ByteArray withAll:#(1 2 3 4).
claus
parents: 343
diff changeset
   450
     (b doubleWordAt:1) printStringRadix:16   
claus
parents: 343
diff changeset
   451
    "
claus
parents: 343
diff changeset
   452
!
claus
parents: 343
diff changeset
   453
claus
parents: 343
diff changeset
   454
doubleWordAt:index MSB:msb
claus
parents: 343
diff changeset
   455
    "return the 4-bytes starting at index as an (unsigned) Integer.
claus
parents: 343
diff changeset
   456
     The value is retrieved MSB-first, if the msb-arg is true;
claus
parents: 343
diff changeset
   457
     LSB-first otherwise.
claus
parents: 343
diff changeset
   458
     Q: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"
2
claus
parents: 1
diff changeset
   459
claus
parents: 1
diff changeset
   460
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   461
claus
parents: 1
diff changeset
   462
    REGISTER int indx;
claus
parents: 1
diff changeset
   463
    int nIndex;
claus
parents: 1
diff changeset
   464
    int val;
249
claus
parents: 221
diff changeset
   465
    OBJ cls;
2
claus
parents: 1
diff changeset
   466
249
claus
parents: 221
diff changeset
   467
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   468
	indx = __intVal(index);
249
claus
parents: 221
diff changeset
   469
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   470
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   471
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
249
claus
parents: 221
diff changeset
   472
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   473
	    if ((indx+3) <= nIndex) {
359
claus
parents: 343
diff changeset
   474
		if (msb == true) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   475
		    val = __ByteArrayInstPtr(self)->ba_element[indx-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   476
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx+1-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   477
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx+2-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   478
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx+3-1];
359
claus
parents: 343
diff changeset
   479
		} else {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   480
		    val = __ByteArrayInstPtr(self)->ba_element[indx+3-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   481
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx+2-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   482
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx+1-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   483
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx-1];
359
claus
parents: 343
diff changeset
   484
		}
249
claus
parents: 221
diff changeset
   485
		if ((val >= 0) && (val <= _MAX_INT)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   486
		    RETURN ( __MKSMALLINT(val) );
249
claus
parents: 221
diff changeset
   487
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   488
		RETURN ( __MKULARGEINT(val) );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   489
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   490
	}
2
claus
parents: 1
diff changeset
   491
    }
359
claus
parents: 343
diff changeset
   492
%}.
claus
parents: 343
diff changeset
   493
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   494
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   495
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   496
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   497
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   498
     b := ByteArray withAll:#(1 2 3 4).
359
claus
parents: 343
diff changeset
   499
     (b doubleWordAt:1 MSB:true) printStringRadix:16.   
claus
parents: 343
diff changeset
   500
     (b doubleWordAt:1 MSB:false) printStringRadix:16   
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   501
    "
2
claus
parents: 1
diff changeset
   502
!
claus
parents: 1
diff changeset
   503
claus
parents: 1
diff changeset
   504
doubleWordAt:index put:value
claus
parents: 1
diff changeset
   505
    "set the 4-bytes starting at index from the (unsigned) Integer value.
359
claus
parents: 343
diff changeset
   506
     The value should be in the range 0 to 16rFFFFFFFF
claus
parents: 343
diff changeset
   507
     (for negative values, the stored value is not defined).
claus
parents: 343
diff changeset
   508
     The value is stored in the machines natural byte order.
claus
parents: 343
diff changeset
   509
     Q: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
claus
parents: 343
diff changeset
   510
claus
parents: 343
diff changeset
   511
    |t|
claus
parents: 343
diff changeset
   512
claus
parents: 343
diff changeset
   513
%{  /* NOCONTEXT */
claus
parents: 343
diff changeset
   514
claus
parents: 343
diff changeset
   515
    REGISTER int indx;
claus
parents: 343
diff changeset
   516
    int nIndex;
claus
parents: 343
diff changeset
   517
    union {
claus
parents: 343
diff changeset
   518
	char u_char[4];
claus
parents: 343
diff changeset
   519
	unsigned u_uint;
claus
parents: 343
diff changeset
   520
    } val;
claus
parents: 343
diff changeset
   521
    OBJ cls;
claus
parents: 343
diff changeset
   522
claus
parents: 343
diff changeset
   523
    if (__isSmallInteger(index)) {
claus
parents: 343
diff changeset
   524
	if (__isSmallInteger(value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   525
	    val.u_uint = __intVal(value);
359
claus
parents: 343
diff changeset
   526
	} else {
claus
parents: 343
diff changeset
   527
	    val.u_uint = __longIntVal(value);
claus
parents: 343
diff changeset
   528
	    if (val.u_uint == 0) goto error;
claus
parents: 343
diff changeset
   529
	}
claus
parents: 343
diff changeset
   530
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   531
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   532
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   533
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   534
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   535
	    nIndex = __qSize(self) - OHDR_SIZE;
claus
parents: 343
diff changeset
   536
	    if ((indx+3) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   537
		__ByteArrayInstPtr(self)->ba_element[indx+0-1] = val.u_char[0];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   538
		__ByteArrayInstPtr(self)->ba_element[indx+1-1] = val.u_char[1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   539
		__ByteArrayInstPtr(self)->ba_element[indx+2-1] = val.u_char[2];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   540
		__ByteArrayInstPtr(self)->ba_element[indx+3-1] = val.u_char[3];
359
claus
parents: 343
diff changeset
   541
		RETURN ( value );
claus
parents: 343
diff changeset
   542
	    }
claus
parents: 343
diff changeset
   543
	}
claus
parents: 343
diff changeset
   544
    }
claus
parents: 343
diff changeset
   545
  error: ;
claus
parents: 343
diff changeset
   546
%}.
claus
parents: 343
diff changeset
   547
    ^ SubscriptOutOfBoundsSignal raise.
claus
parents: 343
diff changeset
   548
claus
parents: 343
diff changeset
   549
    "
claus
parents: 343
diff changeset
   550
     |b|
claus
parents: 343
diff changeset
   551
     b := ByteArray new:4.
claus
parents: 343
diff changeset
   552
     b doubleWordAt:1 put:16r04030201.
claus
parents: 343
diff changeset
   553
     b inspect
claus
parents: 343
diff changeset
   554
    "
claus
parents: 343
diff changeset
   555
!
claus
parents: 343
diff changeset
   556
claus
parents: 343
diff changeset
   557
doubleWordAt:index put:value MSB:msb
claus
parents: 343
diff changeset
   558
    "set the 4-bytes starting at index from the (unsigned) Integer value.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   559
     The value must be in the range 0 to 16rFFFFFFFF.
359
claus
parents: 343
diff changeset
   560
     The value is stored MSB-first if msb is true; LSB-first otherwise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   561
     question: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
2
claus
parents: 1
diff changeset
   562
claus
parents: 1
diff changeset
   563
    |t|
claus
parents: 1
diff changeset
   564
claus
parents: 1
diff changeset
   565
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   566
claus
parents: 1
diff changeset
   567
    REGISTER int indx;
claus
parents: 1
diff changeset
   568
    int nIndex;
claus
parents: 1
diff changeset
   569
    int val;
249
claus
parents: 221
diff changeset
   570
    OBJ cls;
2
claus
parents: 1
diff changeset
   571
359
claus
parents: 343
diff changeset
   572
    if (__isSmallInteger(index)) {
claus
parents: 343
diff changeset
   573
	if (__isSmallInteger(value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   574
	    val = __intVal(value);
359
claus
parents: 343
diff changeset
   575
	} else {
claus
parents: 343
diff changeset
   576
	    val = __longIntVal(value);
claus
parents: 343
diff changeset
   577
	    if (val == 0) goto error;
claus
parents: 343
diff changeset
   578
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   579
	indx = __intVal(index);
359
claus
parents: 343
diff changeset
   580
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   581
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   582
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
359
claus
parents: 343
diff changeset
   583
	    nIndex = __qSize(self) - OHDR_SIZE;
claus
parents: 343
diff changeset
   584
	    if ((indx+3) <= nIndex) {
claus
parents: 343
diff changeset
   585
		if (msb == true) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   586
		    __ByteArrayInstPtr(self)->ba_element[indx+3-1] = val & 0xFF;
359
claus
parents: 343
diff changeset
   587
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   588
		    __ByteArrayInstPtr(self)->ba_element[indx+2-1] = val & 0xFF;
249
claus
parents: 221
diff changeset
   589
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   590
		    __ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
249
claus
parents: 221
diff changeset
   591
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   592
		    __ByteArrayInstPtr(self)->ba_element[indx+0-1] = val & 0xFF;
359
claus
parents: 343
diff changeset
   593
		} else {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   594
		    __ByteArrayInstPtr(self)->ba_element[indx+0-1] = val & 0xFF;
359
claus
parents: 343
diff changeset
   595
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   596
		    __ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
359
claus
parents: 343
diff changeset
   597
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   598
		    __ByteArrayInstPtr(self)->ba_element[indx+2-1] = val & 0xFF;
249
claus
parents: 221
diff changeset
   599
		    val >>= 8;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
   600
		    __ByteArrayInstPtr(self)->ba_element[indx+3-1] = val & 0xFF;
249
claus
parents: 221
diff changeset
   601
		}
359
claus
parents: 343
diff changeset
   602
		RETURN ( value );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   603
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   604
	}
2
claus
parents: 1
diff changeset
   605
    }
359
claus
parents: 343
diff changeset
   606
  error: ;
claus
parents: 343
diff changeset
   607
%}.
claus
parents: 343
diff changeset
   608
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   609
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   610
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   611
     |b|
359
claus
parents: 343
diff changeset
   612
     b := ByteArray new:8.
claus
parents: 343
diff changeset
   613
     b doubleWordAt:1 put:16r04030201 MSB:true.
claus
parents: 343
diff changeset
   614
     b doubleWordAt:5 put:16r04030201 MSB:false.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   615
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   616
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   617
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   618
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   619
floatAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   620
    "return the 4-bytes starting at index as a Float.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   621
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   622
     therefore this method reads a 4-byte float from the byteArray and returns
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   623
     a float object which keeps an 8-byte double internally.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   624
     Notice also, that the bytes are expected to be in this machines
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   625
     float representation and order - if the bytearray originated from another
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   626
     machine, some conversion is usually needed."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   627
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   628
    |newFloat|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   629
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   630
    newFloat := Float basicNew.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   631
    UninterpretedBytes isBigEndian ifFalse:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   632
	5 to:8 do:[:destIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   633
	    newFloat basicAt:destIndex put:(self at:index - 5 + destIndex)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   634
	].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   635
    ] ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   636
	1 to:4 do:[:destIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   637
	    newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   638
	].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   639
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   640
    ^ newFloat.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   641
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   642
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   643
floatAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   644
    "store the 4 bytes of value of the argument, aFloat into the receiver
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   645
     starting at index.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   646
     Notice, that (currently) ST/X Floats are what DOubles are in ST-80.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   647
     Notice also, that the bytes are expected to be in this machines
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   648
     float representation - if the bytearray originated from another
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   649
     machine, some conversion is usually needed."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   650
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   651
    UninterpretedBytes isBigEndian ifFalse:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   652
	5 to:8 do:[:srcIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   653
	    self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   654
	].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   655
    ] ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   656
	1 to:4 do:[:srcIndex|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   657
	    self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   658
	].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   659
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   660
    ^ aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   661
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   662
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   663
ieeDoubleAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   664
    "retrieve the 8 bytes starting at index as a float.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   665
     The 8 bytes are assumed to be in IEE floating point single precision
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   666
     number format."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   667
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   668
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   669
     currently, we assume that the machines native number format is already
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   670
     IEE format - we need some more code here whenever ST/X is ported
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   671
     to an IBM 370 or old VAX etc.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   672
     To date, all supported systems use IEE float numbers, so there should be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   673
     no problem.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   674
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   675
    ^ self doubleAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   676
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   677
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   678
ieeDoubleAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   679
    "store the value of the argument, aFloat into the receiver
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   680
     starting at index. Storage is in IEE floating point double precision format.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   681
     (i.e. 8 bytes are stored)."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   682
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   683
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   684
     currently, we assume that the machines native number format is already
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   685
     IEE format - we need some more code here whenever ST/X is ported
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   686
     to an IBM 370 or old VAX etc.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   687
     To date, all supported systems use IEE float numbers, so there should be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   688
     no problem.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   689
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   690
    ^ self doubleAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   691
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   692
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   693
ieeFloatAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   694
    "retrieve the 4 bytes starting at index as a float.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   695
     The 4 bytes are assumed to be in IEE floating point single precision
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   696
     number format."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   697
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   698
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   699
     currently, we assume that the machines native number format is already
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   700
     IEE format - we need some more code here whenever ST/X is ported
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   701
     to an IBM 370 or old VAX etc.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   702
     To date, all supported systems use IEE float numbers, so there should be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   703
     no problem.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   704
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   705
    ^ self floatAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   706
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   707
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   708
ieeFloatAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   709
    "store the value of the argument, aFloat into the receiver
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   710
     starting at index. Storage is in IEE floating point single precision format.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   711
     (i.e. 4 bytes are stored). Since ST/X floats are really doubles, the low-
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   712
     order 4 bytes of the precision is lost."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   713
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   714
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   715
     currently, we assume that the machines native number format is already
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   716
     IEE format - we need some more code here whenever ST/X is ported
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   717
     to an IBM 370 or old VAX etc.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   718
     To date, all supported systems use IEE float numbers, so there should be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   719
     no problem.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   720
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   721
    ^ self floatAt:index put:aFloat
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   722
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   723
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   724
quadWordAt:index MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   725
    "return the 8-bytes starting at index as an (unsigned) Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   726
     Depending on msb, the value is retrieved MSB or LSB-first."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   727
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   728
    |l 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   729
     bIdx  "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   730
     delta "{ Class: SmallInteger }"|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   731
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   732
    l := LargeInteger basicNew numberOfDigits:8.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   733
    msb ifTrue:[
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   734
        bIdx := index + 7.
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   735
        delta := -1
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   736
    ] ifFalse:[
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   737
        bIdx := index.
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   738
        delta := 1
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   739
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   740
    1 to:8 do:[:i |
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   741
        l digitAt:i put:(self basicAt:bIdx).
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   742
        bIdx := bIdx + delta
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   743
    ].
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   744
    ^ l compressed
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   745
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   746
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   747
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   748
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   749
     b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   750
     (b quadWordAt:1 MSB:false) printStringRadix:16  
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   751
    "
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   752
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
   753
    "Modified: 5.11.1996 / 14:06:21 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   754
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   755
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   756
quadWordAt:index put:anInteger MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   757
    "set the 8-bytes starting at index from the (unsigned) Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   758
     The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   759
     Depending on msb, the value is stored MSB-first or LSB-first."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   760
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   761
    |bIdx  "{ Class: SmallInteger }"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   762
     delta "{ Class: SmallInteger }"|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   763
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   764
    msb ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   765
	bIdx := index + 7.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   766
	delta := -1
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   767
    ] ifFalse:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   768
	bIdx := index.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   769
	delta := 1
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   770
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   771
    1 to:8 do:[:i |
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   772
	self basicAt:bIdx put:(anInteger digitAt:i).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   773
	bIdx := bIdx + delta.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   774
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   775
    ^ anInteger
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   776
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   777
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   778
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   779
     b := ByteArray new:8.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   780
     b quadWordAtIndex:1 put:16r0807060504030201 MSB:false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   781
     b inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   782
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   783
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   784
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   785
signedByteAt:index
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   786
    "return the byte at index as a signed 8 bit value.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   787
     This may be worth a primitive."
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   788
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   789
    ^ (self at:index) signExtendedByteValue
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   790
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   791
"/    |b "{ Class: SmallInteger }"|
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   792
"/
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   793
"/    b := self at:index.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   794
"/    (b > 16r7F) ifTrue:[
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   795
"/        ^ b - 16r100
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   796
"/    ].
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   797
"/    ^ b
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   798
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   799
    "
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   800
     |b|
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   801
     b := ByteArray new:2.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   802
     b at:1 put:16rFF.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   803
     b at:2 put:16r7F.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   804
     b signedByteAt:1  
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   805
    "
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   806
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   807
    "Modified: 1.7.1996 / 21:13:53 / cg"
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   808
!
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   809
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   810
signedByteAt:index put:aSignedByteValue
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   811
    "return the byte at index as a signed 8 bit value.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   812
     Return the signedByteValue argument.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   813
     This may be worth a primitive."
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   814
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   815
    |b "{ Class: SmallInteger }"|
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   816
1335
2de29ef6d91e oops - signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
   817
    aSignedByteValue >= 0 ifTrue:[
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   818
        b := aSignedByteValue
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   819
    ] ifFalse:[
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   820
        b := 16r100 + aSignedByteValue
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   821
    ].
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   822
    self at:index put:b.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   823
    ^ aSignedByteValue
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   824
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   825
    "
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   826
     |b|
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   827
     b := ByteArray new:2.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   828
     b signedByteAt:1 put:-1.
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   829
     b at:1   
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   830
    "
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   831
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   832
    "Modified: 1.7.1996 / 21:12:37 / cg"
1213
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   833
!
10d17781616f added #signedByteAt: / #signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1169
diff changeset
   834
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   835
signedDoubleWordAt:index
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   836
    "return the 4-bytes starting at index as a signed Integer.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   837
     The value is retrieved in the machines natural byte order.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   838
     This may be worth a primitive."
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   839
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   840
    |w|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   841
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   842
    w := self doubleWordAt:index.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   843
    (w > (16r7FFFFFFF)) ifTrue:[
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   844
        ^ w - (16r100000000)
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   845
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   846
    ^ w
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   847
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   848
"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   849
    w := self doubleWordAt:index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   850
    (w > 16r7FFFFFFF) ifTrue:[
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   851
        ^ w - 16r100000000
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   852
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   853
    ^ w
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   854
"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   855
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   856
    "
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   857
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   858
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   859
     b doubleWordAt:1 put:16rFFFFFFFF.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   860
     (b signedDoubleWordAt:1)    
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   861
    "
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   862
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   863
    "Modified: 1.7.1996 / 21:11:28 / cg"
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   864
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   865
359
claus
parents: 343
diff changeset
   866
signedDoubleWordAt:index MSB:msb
claus
parents: 343
diff changeset
   867
    "return the 4-bytes starting at index as a signed Integer.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   868
     Depending on msb, the value is retrieved MSB-first or LSB-first.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   869
     This may be worth a primitive."
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   870
359
claus
parents: 343
diff changeset
   871
    |w|
claus
parents: 343
diff changeset
   872
claus
parents: 343
diff changeset
   873
    w := self doubleWordAt:index MSB:msb.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   874
    (w > (16r7FFFFFFF)) ifTrue:[
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   875
        ^ w - (16r100000000)
359
claus
parents: 343
diff changeset
   876
    ].
claus
parents: 343
diff changeset
   877
    ^ w
claus
parents: 343
diff changeset
   878
"
claus
parents: 343
diff changeset
   879
    w := self doubleWordAt:index.
claus
parents: 343
diff changeset
   880
    (w > 16r7FFFFFFF) ifTrue:[
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   881
        ^ w - 16r100000000
359
claus
parents: 343
diff changeset
   882
    ].
claus
parents: 343
diff changeset
   883
    ^ w
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   884
"
359
claus
parents: 343
diff changeset
   885
claus
parents: 343
diff changeset
   886
    "
claus
parents: 343
diff changeset
   887
     |b|
claus
parents: 343
diff changeset
   888
     b := ByteArray new:4.
claus
parents: 343
diff changeset
   889
     b doubleWordAt:1 put:16rFFFFFFFF.
claus
parents: 343
diff changeset
   890
     (b signedDoubleWordAt:1)    
claus
parents: 343
diff changeset
   891
    "
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   892
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   893
    "Modified: 1.7.1996 / 21:11:33 / cg"
359
claus
parents: 343
diff changeset
   894
!
claus
parents: 343
diff changeset
   895
claus
parents: 343
diff changeset
   896
signedDoubleWordAt:index put:value
claus
parents: 343
diff changeset
   897
    "set the 4-bytes starting at index from the signed Integer value.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   898
     The value is stored in the machines natural byte order.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   899
     This may be worth a primitive."
359
claus
parents: 343
diff changeset
   900
claus
parents: 343
diff changeset
   901
    |v|
claus
parents: 343
diff changeset
   902
1331
5fdba9507742 oops - signedDoubleWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1330
diff changeset
   903
    value >= 0 ifTrue:[
5fdba9507742 oops - signedDoubleWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1330
diff changeset
   904
        v := value
359
claus
parents: 343
diff changeset
   905
    ] ifFalse:[
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   906
        v := value + 16r100000000
359
claus
parents: 343
diff changeset
   907
    ].
claus
parents: 343
diff changeset
   908
    self doubleWordAt:index put:v.
claus
parents: 343
diff changeset
   909
    ^ value
claus
parents: 343
diff changeset
   910
claus
parents: 343
diff changeset
   911
    "
claus
parents: 343
diff changeset
   912
     |b|
claus
parents: 343
diff changeset
   913
     b := ByteArray new:4.
claus
parents: 343
diff changeset
   914
     b signedDoubleWordAt:1 put:-1.
claus
parents: 343
diff changeset
   915
     (b doubleWordAt:1) printStringRadix:16   
claus
parents: 343
diff changeset
   916
    "
1331
5fdba9507742 oops - signedDoubleWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1330
diff changeset
   917
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   918
    "Modified: 1.7.1996 / 21:11:39 / cg"
359
claus
parents: 343
diff changeset
   919
!
claus
parents: 343
diff changeset
   920
claus
parents: 343
diff changeset
   921
signedDoubleWordAt:index put:value MSB:msb
claus
parents: 343
diff changeset
   922
    "set the 4-bytes starting at index from the signed Integer value.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   923
     Depending on msb, the value is stored MSB-first or LSB-first.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   924
     This may be worth a primitive."
359
claus
parents: 343
diff changeset
   925
claus
parents: 343
diff changeset
   926
    |v|
claus
parents: 343
diff changeset
   927
1335
2de29ef6d91e oops - signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
   928
    value >= 0 ifTrue:[
2de29ef6d91e oops - signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
   929
        v := value
359
claus
parents: 343
diff changeset
   930
    ] ifFalse:[
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   931
        v := value + 16r100000000
359
claus
parents: 343
diff changeset
   932
    ].
claus
parents: 343
diff changeset
   933
    self doubleWordAt:index put:v MSB:msb.
claus
parents: 343
diff changeset
   934
    ^ value
claus
parents: 343
diff changeset
   935
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   936
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   937
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   938
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   939
     b signedDoubleWordAt:1 put:-1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   940
     (b doubleWordAt:1) printStringRadix:16   
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   941
    "
1335
2de29ef6d91e oops - signedByteAt:put:
Claus Gittinger <cg@exept.de>
parents: 1331
diff changeset
   942
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   943
    "Modified: 1.7.1996 / 21:11:46 / cg"
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   944
!
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   945
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   946
signedWordAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   947
    "return the 2-bytes starting at index as a signed Integer.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   948
     The value is retrieved in the machines natural byte order.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   949
     This may be worth a primitive."
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   950
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   951
    ^ (self wordAt:index) signExtendedShortValue
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   952
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   953
"/    |w "{ Class: SmallInteger }"|
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   954
"/
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   955
"/    w := self wordAt:index.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   956
"/    (w > 16r7FFF) ifTrue:[
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   957
"/        ^ w - 16r10000
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   958
"/    ].
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   959
"/    ^ w
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   960
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   961
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   962
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   963
     b := ByteArray new:2.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   964
     b wordAt:1 put:16rFFFF.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   965
     b signedWordAt:1  
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   966
    "
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   967
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   968
    "Modified: 1.7.1996 / 21:14:38 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   969
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   970
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   971
signedWordAt:index MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   972
    "return the 2-bytes starting at index as a signed Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   973
     The value is retrieved MSB-first if the msb-arg is true,
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   974
     LSB-first otherwise.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   975
     This may be worth a primitive."
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   976
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   977
    ^ (self wordAt:index MSB:msb) signExtendedShortValue
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   978
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   979
"/    |w "{ Class: SmallInteger }"|
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   980
"/
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   981
"/    w := self wordAt:index MSB:msb.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   982
"/    (w > 16r7FFF) ifTrue:[
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   983
"/        ^ w - 16r10000
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   984
"/    ].
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   985
"/    ^ w
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   986
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   987
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   988
     |b|
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   989
     b := ByteArray new:2.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   990
     b wordAt:1 put:16r0080.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   991
     b signedWordAt:1 MSB:true.  
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   992
     b signedWordAt:1 MSB:false.  
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   993
    "
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   994
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
   995
    "Modified: 1.7.1996 / 21:15:57 / cg"
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   996
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   997
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   998
signedWordAt:index put:value
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
   999
    "set the 2-bytes starting at index from the signed Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1000
     The stored value must be in the range -32768 .. +32676.
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1001
     The value is stored in the machines natural byteorder.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1002
     This may be worth a primitive."
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1003
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1004
    |v|
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1005
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1006
    value >= 0 ifTrue:[
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1007
        v := value
359
claus
parents: 343
diff changeset
  1008
    ] ifFalse:[
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1009
        v := 16r10000 + value
395
claus
parents: 384
diff changeset
  1010
    ].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1011
    self wordAt:index put:v.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1012
    ^ value
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1013
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1014
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1015
     |b|
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1016
     b := ByteArray new:6.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1017
     b signedWordAt:1 put:-1.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1018
     b signedWordAt:3 put:-2.
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1019
     b signedWordAt:5 put:0.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1020
     b inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1021
    "
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1022
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1023
    "Modified: 1.7.1996 / 21:12:07 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1024
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1025
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1026
signedWordAt:index put:value MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1027
    "set the 2-bytes starting at index from the signed Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1028
     The stored value must be in the range -32768 .. +32676.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1029
     The value is stored MSB-first, if the msb-arg is true;
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1030
     LSB-first otherwise.
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1031
     This may be worth a primitive."
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1032
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1033
    |v|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1034
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1035
    value >= 0 ifTrue:[
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1036
        v := value
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1037
    ] ifFalse:[
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1038
        v := 16r10000 + value
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1039
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1040
    self wordAt:index put:v MSB:msb.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1041
    ^ value
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1042
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1043
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1044
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1045
     b := ByteArray new:4.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1046
     b signedWordAt:1 put:-1.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1047
     b signedWordAt:3 put:-2.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1048
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1049
    "
1330
41c850b3b550 oops - signedWordAt:put: was wrong for 0
Claus Gittinger <cg@exept.de>
parents: 1290
diff changeset
  1050
1505
45b665448fac can now use largeInteger constants
Claus Gittinger <cg@exept.de>
parents: 1472
diff changeset
  1051
    "Modified: 1.7.1996 / 21:12:13 / cg"
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1052
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1053
1649
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1054
stringAt:index size:count
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1055
    "extract a string, given initial index and number of characters (bytes)"
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1056
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1057
    ^ (self copyFrom:index to:(index + count - 1)) asString
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1058
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1059
    "Modified: 9.9.1996 / 15:28:08 / cg"
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1060
    "Created: 9.9.1996 / 15:28:48 / cg"
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1061
!
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1062
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1063
wordAt:index
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1064
    "return the 2-bytes starting at index as an (unsigned) Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1065
     The value is retrieved in the machines natural byte order
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1066
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1067
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1068
%{  /* NOCONTEXT */
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1069
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1070
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1071
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1072
    union {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1073
	char u_char[2];
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1074
	unsigned short u_ushort;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1075
    } val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1076
    OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1077
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1078
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1079
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1080
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1081
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1082
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1083
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1084
	    if ((indx+1) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1085
		val.u_char[0] = __ByteArrayInstPtr(self)->ba_element[indx-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1086
		val.u_char[1] = __ByteArrayInstPtr(self)->ba_element[indx-1+1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1087
		RETURN ( __MKSMALLINT(val.u_ushort) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1088
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1089
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1090
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1091
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1092
    ^ SubscriptOutOfBoundsSignal raise.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1093
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1094
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1095
wordAt:index MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1096
    "return the 2-bytes starting at index as an (unsigned) Integer.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1097
     The value is retrieved MSB (high 8 bits at lower index) if msb is true;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1098
     LSB-first (i.e. low 8-bits at lower byte index) if its false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1099
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1100
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1101
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1102
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1103
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1104
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1105
    int val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1106
    OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1107
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1108
    if (__isSmallInteger(index)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1109
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1110
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1111
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1112
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1113
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1114
	    if ((indx+1) <= nIndex) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1115
		if (msb == true) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1116
		    val = __ByteArrayInstPtr(self)->ba_element[indx-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1117
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx-1+1];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1118
		} else {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1119
		    val = __ByteArrayInstPtr(self)->ba_element[indx+1-1];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1120
		    val = (val << 8) + __ByteArrayInstPtr(self)->ba_element[indx-1];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1121
		}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1122
		RETURN ( __MKSMALLINT(val) );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1123
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1124
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1125
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1126
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1127
    ^ SubscriptOutOfBoundsSignal raise.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1128
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1129
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1130
wordAt:index put:value
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1131
    "set the 2-bytes starting at index from the (unsigned) Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1132
     The stored value must be in the range 0 .. 16rFFFF. 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1133
     The value is stored in the machines natural byteorder.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1134
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1135
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1136
%{  /* NOCONTEXT */
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1137
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1138
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1139
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1140
    int v;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1141
    union {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1142
	char u_char[2];
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1143
	unsigned short u_ushort;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1144
    } val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1145
    OBJ cls;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1146
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1147
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1148
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1149
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1150
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1151
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1152
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1153
	    if ((indx+1) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1154
		val.u_ushort = v = __intVal(value);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1155
		if ((v & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1156
		    __ByteArrayInstPtr(self)->ba_element[indx-1] = val.u_char[0];
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1157
		    __ByteArrayInstPtr(self)->ba_element[indx-1+1] = val.u_char[1];
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1158
		    RETURN ( value );
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1159
		}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1160
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1161
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1162
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1163
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1164
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1165
	^ self elementBoundsError
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1166
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1167
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1168
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1169
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1170
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1171
     b := ByteArray new:4.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1172
     b wordAt:1 put:16r0102.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1173
     b wordAt:3 put:16r0304.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1174
     b inspect  
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1175
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1176
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1177
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1178
wordAt:index put:value MSB:msb
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1179
    "set the 2-bytes starting at index from the (unsigned) Integer value.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1180
     The stored value must be in the range 0 .. 16rFFFF. 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1181
     The value is stored LSB-first (i.e. the low 8bits are stored at the
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1182
     lower index) if msb is false, MSB-first otherwise.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1183
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1184
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1185
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1186
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1187
    REGISTER int indx;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1188
    int nIndex;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1189
    int val;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1190
    OBJ cls;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1191
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1192
    if (__bothSmallInteger(index, value)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1193
	indx = __intVal(index);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1194
	if (indx > 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1195
	    if ((cls = __qClass(self)) != @global(ByteArray))
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1196
		indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1197
	    nIndex = __byteArraySize(self);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1198
	    if ((indx+1) <= nIndex) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1199
		val = __intVal(value);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1200
		if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1201
		    if (msb == true) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1202
			__ByteArrayInstPtr(self)->ba_element[indx-1+1] = val & 0xFF;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1203
			__ByteArrayInstPtr(self)->ba_element[indx-1] = (val>>8) & 0xFF;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1204
		    } else {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1205
			__ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1206
			__ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1207
		    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1208
		    RETURN ( value );
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1209
		}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1210
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1211
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1212
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1213
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1214
    ((value < 0) or:[value > 16rFFFF]) ifTrue:[
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1215
	^ self elementBoundsError
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1216
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1217
    ^ SubscriptOutOfBoundsSignal raise.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1218
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1219
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1220
     |b|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1221
     b := ByteArray new:8.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1222
     b wordAt:1 put:16r0102 MSB:false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1223
     b wordAt:3 put:16r0304 MSB:false.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1224
     b wordAt:5 put:16r0102 MSB:true.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1225
     b wordAt:7 put:16r0304 MSB:true.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1226
     b inspect  
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1227
    "
1649
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1228
!
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1229
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1230
zeroByteStringAt:index maximumSize:count
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1231
    "extract a zeroByte-delimited string, given initial index and
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1232
     maximum number of characters (bytes)"
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1233
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1234
    |bytes idx|
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1235
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1236
    bytes := self copyFrom:index to:(index + count - 1).
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1237
    idx := bytes indexOf:0.
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1238
    idx ~~ 0 ifTrue:[ bytes := bytes copyTo:idx-1 ].
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1239
    ^ bytes asString
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1240
74626d4c1d96 added string extraction stuff
Claus Gittinger <cg@exept.de>
parents: 1527
diff changeset
  1241
    "Created: 9.9.1996 / 15:28:34 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1242
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1243
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1244
!ByteArray methodsFor:'binary storage'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1245
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1246
storeBinaryDefinitionOn:stream manager:manager
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1247
    "append a binary representation of the receiver onto stream.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1248
     Redefined since ByteArrays are stored with a special type code and
1261
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
  1249
     in a more compact way.
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
  1250
     This is an internal interface for binary storage mechanism."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1251
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1252
    "not, if I have named instance variables"
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1253
    self class instSize ~~ 0 ifTrue:[
1261
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
  1254
        ^ super storeBinaryDefinitionOn:stream manager:manager
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1255
    ].
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1256
    manager putIdOfClass:(self class) on: stream.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1257
    stream nextNumber:4 put:(self basicSize).
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1258
    stream nextPutAll:(self asByteArray)
1261
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
  1259
7b2953df4efa commentary
Claus Gittinger <cg@exept.de>
parents: 1244
diff changeset
  1260
    "Modified: 23.4.1996 / 09:30:02 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1261
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1262
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1263
!ByteArray methodsFor:'converting'!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1264
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1265
asByteArray
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1266
    "return the receiver as a byteArray"
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1267
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1268
    "could be an instance of a subclass..."
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1269
    self class == ByteArray ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1270
	^ self
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1271
    ].
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1272
    ^ super asByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1273
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1274
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1275
     'hello world' asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1276
     #(1 2 3 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1277
     #(1 2 256 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1278
    "
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1279
! !
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1280
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1281
!ByteArray methodsFor:'copying'!
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1282
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1283
copyFrom:start to:stop
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1284
    "return the subcollection starting at index start, anInteger and ending
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1285
     at stop, anInteger.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1286
     - reimplemented here for speed"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1287
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1288
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1289
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1290
#if !defined(FAST_MEMCPY)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1291
    REGISTER unsigned char *srcp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1292
#endif
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1293
    REGISTER unsigned char *dstp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1294
    REGISTER int count;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1295
    int len, index1, index2, sz;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1296
    OBJ newByteArray;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1297
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1298
    if (__isByteArray(self)
249
claus
parents: 221
diff changeset
  1299
     && __bothSmallInteger(start, stop)) {
claus
parents: 221
diff changeset
  1300
	len = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1301
	index1 = __intVal(start);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1302
	index2 = __intVal(stop);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1303
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1304
	if ((index1 <= index2) && (index1 > 0)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1305
	    if (index2 <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1306
		count = index2 - index1 + 1;
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1307
		__PROTECT_CONTEXT__
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1308
		sz = OHDR_SIZE + count;
1695
465e1eba8e8e removed useless context-arg of all qMK macros - needs full recompile.
Claus Gittinger <cg@exept.de>
parents: 1688
diff changeset
  1309
		__qNew(newByteArray, sz);
834
c68ed1088b42 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 829
diff changeset
  1310
		__UNPROTECT_CONTEXT__
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1311
		if (newByteArray != nil) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1312
		    __InstPtr(newByteArray)->o_class = ByteArray;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1313
		    dstp = __ByteArrayInstPtr(newByteArray)->ba_element;
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1314
#ifdef FAST_MEMCPY
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1315
		    bcopy(__ByteArrayInstPtr(self)->ba_element + index1 - 1, dstp, count);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1316
#else
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1317
		    srcp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1318
		    while (count--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1319
			*dstp++ = *srcp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1320
		    }
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1321
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1322
		    RETURN ( newByteArray );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1323
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1324
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1325
	}
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1326
    }
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1327
%}.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1328
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1329
     fall back in case of non-integer index or out-of-bound index;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1330
     will eventually lead to an out-of-bound signal raise
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1331
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1332
    ^ super copyFrom:start to:stop
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1333
! !
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1334
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1335
!ByteArray methodsFor:'filling and replacing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1336
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1337
from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1338
    "fill part of the receiver with aNumber.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1339
     - reimplemented here for speed"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1340
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1341
%{  /* NOCONTEXT */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1342
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1343
    REGISTER unsigned char *dstp;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1344
    REGISTER int count, value;
249
claus
parents: 221
diff changeset
  1345
    int len, index1, index2;
claus
parents: 221
diff changeset
  1346
    int nInst;
claus
parents: 221
diff changeset
  1347
    OBJ cls;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1348
249
claus
parents: 221
diff changeset
  1349
    if (__isSmallInteger(aNumber)
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1350
     && __bothSmallInteger(start, stop)
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1351
     && __isBytes(self)) {
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1352
	len = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1353
	index1 = __intVal(start);
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1354
	index2 = __intVal(stop);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1355
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1356
	dstp = __ByteArrayInstPtr(self)->ba_element + index1 - 1;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1357
	if ((cls = __qClass(self)) != ByteArray) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1358
	    nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1359
	    dstp += nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1360
	    len -= nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1361
	}
249
claus
parents: 221
diff changeset
  1362
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1363
	value = __intVal(aNumber);
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1364
	if (((value & ~0xFF) == 0) /* i.e. (value >= 0) && (value <= 255) */
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1365
	 && (index1 <= index2) 
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1366
	 && (index1 > 0)) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1367
	    if (index2 <= len) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1368
		count = index2 - index1 + 1;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1369
#ifdef FAST_MEMSET
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1370
		memset(dstp, count, value);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1371
#else
422
claus
parents: 395
diff changeset
  1372
# ifdef UNROLL_LOOPS
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1373
		while (count >= 8) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1374
		    dstp[0] = dstp[1] = dstp[2] = dstp[3] =
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1375
		    dstp[4] = dstp[5] = dstp[6] = dstp[7] = value;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1376
		    dstp += 8;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1377
		    count -= 8;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1378
		}
422
claus
parents: 395
diff changeset
  1379
# endif
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1380
		while (count--) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1381
		    *dstp++ = value;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1382
		}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1383
#endif
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1384
		RETURN (self);
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1385
	    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1386
	}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1387
    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1388
%}.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1389
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1390
     fall back in case of non-integer index or out-of-bound index/value;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1391
     will eventually lead to an out-of-bound signal raise
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1392
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1393
    ^ super from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1394
!
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1395
249
claus
parents: 221
diff changeset
  1396
replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
claus
parents: 221
diff changeset
  1397
    "replace elements from another collection, which must be a ByteArray
claus
parents: 221
diff changeset
  1398
     or String."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1399
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1400
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1401
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1402
    int nIndex, repNIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1403
    int startIndex, stopIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1404
    REGISTER unsigned char *src;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1405
    REGISTER int repStartIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1406
    int repStopIndex, count;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1407
    REGISTER unsigned char *dst;
249
claus
parents: 221
diff changeset
  1408
    OBJ cls;
claus
parents: 221
diff changeset
  1409
    int nInst;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1410
249
claus
parents: 221
diff changeset
  1411
    if (__isBytes(aCollection)
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  1412
     && __isBytes(self)
249
claus
parents: 221
diff changeset
  1413
     && __bothSmallInteger(start, stop)
claus
parents: 221
diff changeset
  1414
     && __isSmallInteger(repStart)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1415
	startIndex = __intVal(start) - 1;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1416
	if (startIndex >= 0) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1417
	  dst = (__ByteArrayInstPtr(self)->ba_element) + startIndex;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1418
	  nIndex = __byteArraySize(self);
249
claus
parents: 221
diff changeset
  1419
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1420
	  if ((cls = __qClass(self)) != ByteArray) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1421
	    nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1422
	    dst += nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1423
	    nIndex -= nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1424
	  }
249
claus
parents: 221
diff changeset
  1425
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1426
	  stopIndex = __intVal(stop) - 1;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1427
	  count = stopIndex - startIndex + 1;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1428
	  if (count == 0) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1429
	      RETURN ( self );
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1430
	  }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1431
	  if ((count > 0) && (stopIndex < nIndex)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1432
	    repStartIndex = __intVal(repStart) - 1;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1433
	    if (repStartIndex >= 0) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1434
	      repNIndex = __qSize(aCollection) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1435
	      src = (__ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1436
	      if ((cls = __qClass(aCollection)) != ByteArray) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1437
		nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1438
		src += nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1439
		repNIndex -= nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1440
	      }
249
claus
parents: 221
diff changeset
  1441
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1442
	      repStopIndex = repStartIndex + (stopIndex - startIndex);
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1443
	      if (repStopIndex < repNIndex) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1444
		if (aCollection == self) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1445
		    /* take care of overlapping copy */
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1446
		    if (src < dst) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1447
			/* must do a reverse copy */
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1448
			src += count;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1449
			dst += count;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1450
			while (count-- > 0) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1451
			    *--dst = *--src;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1452
			}
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1453
			RETURN ( self );
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1454
		    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1455
		}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1456
#ifdef FAST_MEMCPY
166
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1457
# ifdef bcopy4
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1458
		if (((src & 3) == 0)
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1459
		 && ((dst & 3) == 0)) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1460
		    /* copy aligned part */
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1461
		    bcopy4(src, dst, count//4);
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1462
		    /* copy rest */
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1463
		    if (count & 3) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1464
			src += (count & ~3);
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1465
			dst += (count & ~3);
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1466
			count = count & 3;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1467
			while (count--) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1468
			    *dst++ = *src++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1469
			}
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1470
		    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1471
		} else
166
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1472
# endif /* bcopy4 */
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1473
		    bcopy(src, dst, count);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1474
#else
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1475
		while (count-- > 0) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1476
		    *dst++ = *src++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1477
		}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1478
#endif
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1479
		RETURN ( self );
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1480
	      }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1481
	    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1482
	  }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  1483
	}
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1484
    }
437
claus
parents: 422
diff changeset
  1485
%}.
claus
parents: 422
diff changeset
  1486
    "
claus
parents: 422
diff changeset
  1487
     fall back in case of non-ByteArray argument,
claus
parents: 422
diff changeset
  1488
     or for the error report if any index is invalid
claus
parents: 422
diff changeset
  1489
    "
claus
parents: 422
diff changeset
  1490
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1491
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1492
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1493
replaceFrom:start to:stop with:aCollection startingAt:repStart
1169
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1494
    "replace elements in the receiver between index start and stop,
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1495
     with elements  taken from replacementCollection starting at repStart."
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1496
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1497
    (aCollection class == self class) ifTrue:[
1169
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1498
        ^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1499
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1500
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
1169
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1501
6b6e228d22e0 commentary
Claus Gittinger <cg@exept.de>
parents: 1147
diff changeset
  1502
    "Modified: 13.4.1996 / 12:16:46 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1503
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1504
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1505
!ByteArray methodsFor:'image manipulation support'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1506
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1507
compressPixels:nBitsPerPixel width:width height:height into:aByteArray
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1508
                         mapping:aMapByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1509
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1510
    "given the receiver with 8-bit pixels, compress them into aByteArray
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1511
     with nBitsPerPixel-depth pixels. The width/height-arguments are needed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1512
     to allow for any padding. On the fly, the source bytes are translated
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1513
     using aMapByteArray (if non-nil).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1514
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1515
     value of n is found in map at:(n + 1).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1516
     Output bits are filled left-to right, i.e. the first byte in the input
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1517
     corresponds to the high bit(s) if the first byte in the input.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1518
     This method can be used to convert 8-bit image data to mono, 2-bit and 4-bit 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1519
     bitmaps.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1520
     It can also be used to compress byte-arrays into bitArrays."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1521
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1522
%{  /* NOCONTEXT */
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1523
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1524
    REGISTER unsigned char *src, *dst;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1525
    REGISTER int wrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1526
    unsigned char *dstNext;
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1527
    unsigned char *dstEnd;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1528
    int bytesPerRow, mask, shift0, shift;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1529
    int w, h, hrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1530
    int srcBytes, dstBytes;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1531
    int bitsPerPixel;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1532
    int bits;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1533
    int ncells;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1534
    unsigned char *map;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1535
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1536
    if ((__qClass(self) == @global(ByteArray)) 
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1537
     && (__qClass(aByteArray) == @global(ByteArray))
249
claus
parents: 221
diff changeset
  1538
     && __isSmallInteger(nBitsPerPixel)
claus
parents: 221
diff changeset
  1539
     && __bothSmallInteger(height, width)) {
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1540
        if ((aMapByteArray != nil)
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1541
         && (__Class(aMapByteArray) == @global(ByteArray))) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1542
            map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1543
        } else {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1544
            map = (unsigned char *)0;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1545
        }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1546
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1547
        bitsPerPixel = __intVal(nBitsPerPixel);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1548
        w = __intVal(width);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1549
        h = __intVal(height);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1550
        src = __ByteArrayInstPtr(self)->ba_element;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1551
        dst = __ByteArrayInstPtr(aByteArray)->ba_element;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1552
        dstEnd = dst + __byteArraySize(aByteArray);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1553
        switch (bitsPerPixel) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1554
            case 1:
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1555
                mask = 0x01;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1556
                break;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1557
            case 2:
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1558
                mask = 0x03;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1559
                break;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1560
            case 4:
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1561
                mask = 0x0F;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1562
                break;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1563
            case 8:
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1564
                mask = 0xFF;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1565
                break;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1566
            default:
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1567
                goto fail;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1568
        }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1569
        if (map) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1570
            /*
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1571
             * if a map is present, it must have entries for
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1572
             * all possible byte-values (i.e. its size must be >= 256)
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1573
             */
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1574
            if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256)
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1575
                goto fail;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1576
        }
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1577
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1578
        bytesPerRow = (w * bitsPerPixel + 7) / 8;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1579
        dstBytes = bytesPerRow * h;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1580
        srcBytes = w * h;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1581
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1582
        if ((__byteArraySize(self) >= srcBytes)
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1583
         && (__byteArraySize(aByteArray) >= dstBytes)) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1584
            for (hrun=h; hrun; hrun--) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1585
                dstNext = dst + bytesPerRow;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1586
                bits = 0; shift = 8;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1587
                if (map) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1588
                    for (wrun=w; wrun; wrun--) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1589
                        bits = (bits << bitsPerPixel) | (map[*src++] & mask);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1590
                        shift -= bitsPerPixel;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1591
                        if (shift == 0) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1592
                            if (dst == dstEnd) goto fail;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1593
                            *dst++ = bits;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1594
                            bits = 0; shift = 8;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1595
                        }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1596
                    }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1597
                } else {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1598
                    for (wrun=w; wrun; wrun--) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1599
                        bits = (bits << bitsPerPixel) | (*src++ & mask);
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1600
                        shift -= bitsPerPixel;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1601
                        if (shift == 0) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1602
                            if (dst == dstEnd) goto fail;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1603
                            *dst++ = bits;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1604
                            bits = 0; shift = 8;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1605
                        }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1606
                    }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1607
                }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1608
                if (shift != 8) {
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1609
                    if (dst == dstEnd) goto fail;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1610
                    *dst = bits;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1611
                }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1612
                dst = dstNext;
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1613
            }
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1614
            RETURN ( self );
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1615
        }
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1616
    }
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1617
fail: ;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1618
%}
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1619
.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1620
    self primitiveFailed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1621
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1622
    "Example1:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1623
     compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1624
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1625
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1626
     |inBits outBits|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1627
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1628
     inBits := #[0 0 0 0 1 1 1 1
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1629
                 0 0 1 1 0 0 1 1
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1630
                 0 1 0 1 0 1 0 1
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1631
                 1 1 1 1 0 0 0 0].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1632
     outBits := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1633
     inBits compressPixels:1 width:8 height:4
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1634
                    into:outBits mapping:nil.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1635
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1636
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1637
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1638
    "Example2:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1639
     compress byte-array into a bitArray, translating 99 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1640
     and 176 to 1-bits. (just a stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1641
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1642
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1643
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1644
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1645
     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1646
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1647
     map at:176+1 put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1648
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1649
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1650
     inBits compressPixels:1 width:16 height:1 
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1651
                    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1652
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1653
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1654
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1655
    "Example3:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1656
     compress byte-array into a bitArray, translating everything below 128 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1657
     and 128 to 255 to 1-bits.99 to 0-bits (another stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1658
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1659
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1660
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1661
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1662
     inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1663
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1664
     map atAll:(128+1 to:255+1) put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1665
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1666
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1667
     inBits compressPixels:1 width:16 height:1 
1472
abaa73dc0e9a check for destination overrun
Claus Gittinger <cg@exept.de>
parents: 1459
diff changeset
  1668
                    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1669
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1670
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1671
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1672
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1673
expandPixels:nBitsPerPixel width:width height:height into:aByteArray
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1674
                         mapping:aMapByteArray
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1675
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1676
    "given the receiver with nBitsPerPixel-depth pixels, expand them into
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1677
     aByteArray with 8-bit pixels. The width/height-arguments are needed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1678
     to skip any padded src-bits. On the fly, the destination pixels
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1679
     are translated using aMapByteArray (if non-nil).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1680
     Input bits are read left-to right, i.e. the first byte in the output
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1681
     corresponds to the high bit(s) in the inputs first byte.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1682
     This is used to display mono, 2-bit and 4-bit bitmaps on grey-scale/color
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1683
     machines. With nBitsPerPixel==8, this is a translate operation.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1684
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1685
     value of n is found in map at:(n + 1).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1686
     It can also be used to expand bit-arrays into byteArrays.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1687
     This method is specialized for ByteArray arguments - it will not handle
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1688
     anything else."
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1689
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1690
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1691
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1692
    REGISTER unsigned char *src, *dst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1693
    REGISTER int wrun;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1694
    unsigned char *srcNext;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1695
    int bytesPerRow, mask, shift0, shift;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1696
    int w, h, hrun;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1697
    int srcBytes, dstBytes;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1698
    int bitsPerPixel;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1699
    int bits;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1700
    int ncells;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1701
    unsigned char *map;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1702
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1703
    if ((__qClass(self) == @global(ByteArray)) 
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1704
     && (__qClass(aByteArray) == @global(ByteArray))
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1705
     && __isSmallInteger(nBitsPerPixel)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1706
     && __bothSmallInteger(height, width)) {
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1707
        if ((aMapByteArray != nil)
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1708
         && (__Class(aMapByteArray) == @global(ByteArray))) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1709
            map = __ByteArrayInstPtr(aMapByteArray)->ba_element;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1710
        } else {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1711
            map = (unsigned char *)0;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1712
        }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1713
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1714
        bitsPerPixel = __intVal(nBitsPerPixel);
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1715
        w = __intVal(width);
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1716
        h = __intVal(height);
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1717
        src = __ByteArrayInstPtr(self)->ba_element;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1718
        dst = __ByteArrayInstPtr(aByteArray)->ba_element;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1719
        switch (bitsPerPixel) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1720
            case 1:
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1721
                mask = 0x01;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1722
                break;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1723
            case 2:
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1724
                mask = 0x03;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1725
                break;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1726
            case 4:
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1727
                mask = 0x0F;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1728
                break;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1729
            case 8:
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1730
                mask = 0xFF;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1731
                break;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1732
            default:
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1733
printf("invalid depth\n");
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1734
                goto fail;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1735
        }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1736
        ncells = mask + 1;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1737
        if (map) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1738
            /*
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1739
             * if a map is present, it must have the correct size
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1740
             * (i.e. 2 raisedTo:nBitsPerPixel)
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1741
             */
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1742
            if ((__qSize(aMapByteArray) - OHDR_SIZE) < ncells) {
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1743
printf("invalid map\n");
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1744
                goto fail;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1745
            }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1746
        }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1747
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1748
        bytesPerRow = (w * bitsPerPixel + 7) / 8;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1749
        shift0 = 8 - bitsPerPixel;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1750
        srcBytes = bytesPerRow * h;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1751
        dstBytes = w * h;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1752
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1753
        if ((__byteArraySize(self) >= srcBytes)
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1754
         && (__byteArraySize(aByteArray) >= dstBytes)) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1755
            for (hrun=h; hrun; hrun--) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1756
                srcNext = src + bytesPerRow;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1757
                shift = shift0;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1758
                if (map) {
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1759
                    if (shift0 == 0) {
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1760
                        /* translate only */
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1761
                        for (wrun=w; wrun; wrun--) {
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1762
                            bits = *src++;
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1763
                            *dst++ = map[bits];
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1764
                        }
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1765
                    } else {
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1766
                        for (wrun=w; wrun; wrun--) {
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1767
                            if (shift == shift0) {
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1768
                                bits = *src++;
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1769
                            }
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1770
                            *dst++ = map[(bits >> shift) & mask];
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1771
                            shift -= bitsPerPixel;
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1772
                            if (shift < 0) {
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1773
                                shift = shift0;
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1774
                            }
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1775
                        }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1776
                    }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1777
                } else {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1778
                    for (wrun=w; wrun; wrun--) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1779
                        if (shift == shift0) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1780
                            bits = *src++;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1781
                        }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1782
                        *dst++ = (bits >> shift) & mask;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1783
                        shift -= bitsPerPixel;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1784
                        if (shift < 0) {
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1785
                            shift = shift0;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1786
                        }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1787
                    }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1788
                }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1789
                src = srcNext;
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1790
            }
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1791
            RETURN ( self );
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1792
        }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1793
    }
1527
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1794
printf("invalid args\n");
af119b16aa16 better handle the translate-only case in #expandPixels:
ca
parents: 1505
diff changeset
  1795
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1796
fail: ;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1797
%}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1798
.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1799
    self primitiveFailed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1800
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1801
    "Example1:
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1802
     expand 1-bit-per-pixel bitmap into a 1byte-per-pixel byteArray
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1803
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1804
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1805
     |inBits outBits|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1806
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1807
     inBits := #[2r11110000 
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1808
                 2r11001100 
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1809
                 2r01010101 
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1810
                 2r00001111].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1811
     outBits := ByteArray new:(8*4).
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1812
     inBits expandPixels:1 width:8 height:4
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1813
                    into:outBits mapping:nil.
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1814
     outBits inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1815
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1816
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1817
    "Example2:
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1818
     expand bit-array into a byteArray, translating 0-bits to 99,
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1819
     1-bits to 176. (just a stupid example)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1820
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1821
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1822
     |inBits outBits|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1823
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1824
     inBits := #[2r11110000 2r11001100].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1825
     outBits := ByteArray new:16.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1826
     inBits expandPixels:1 width:16 height:1 
1456
a544a722ec32 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1384
diff changeset
  1827
                    into:outBits mapping:#[99 176].
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1828
     outBits inspect
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1829
    "
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1830
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1831
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1832
invert
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1833
    "invert all bytes - used with image manipulations
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1834
     written as a primitive for speed.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1835
     Q: is this really needed ?"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1836
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1837
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1838
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1839
    REGISTER unsigned char *dst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1840
    REGISTER unsigned long *ldst;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1841
    REGISTER int cnt;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1842
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1843
    if (__qClass(self) == @global(ByteArray)) {
1458
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1844
        cnt = __byteArraySize(self);
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1845
        dst = __ByteArrayInstPtr(self)->ba_element;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1846
        if (! ((int)dst & (sizeof(long)-1))) {
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1847
            ldst = (unsigned long *)dst;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1848
            while (cnt > 16) {
1459
Claus Gittinger <cg@exept.de>
parents: 1458
diff changeset
  1849
                ldst[0] = ~(ldst[0]);
Claus Gittinger <cg@exept.de>
parents: 1458
diff changeset
  1850
                ldst[1] = ~(ldst[1]);
Claus Gittinger <cg@exept.de>
parents: 1458
diff changeset
  1851
                ldst[2] = ~(ldst[2]);
Claus Gittinger <cg@exept.de>
parents: 1458
diff changeset
  1852
                ldst[3] = ~(ldst[3]);
1458
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1853
                ldst += 4;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1854
                cnt -= 16;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1855
            }
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1856
            while (cnt >= sizeof(long)) {
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1857
                *ldst = ~(*ldst);
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1858
                ldst++;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1859
                cnt -= sizeof(long);
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1860
            }
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1861
            dst = (unsigned char *)ldst;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1862
        }
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1863
        while (cnt--) {
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1864
            *dst = ~(*dst);
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1865
            dst++;
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1866
        }
81db6f019905 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1457
diff changeset
  1867
        RETURN ( self );
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1868
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1869
%}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1870
.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1871
    self primitiveFailed
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1872
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1873
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1874
reverse
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1875
    "reverse order of elements inplace - 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1876
     written as a primitive for speed on image manipulations (mirror)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1877
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1878
%{  /* NOCONTEXT */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1879
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1880
    REGISTER unsigned char *p1, *p2;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1881
    REGISTER int cnt;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1882
    REGISTER unsigned t;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1883
    OBJ cls;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1884
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1885
    if (__qClass(self) == @global(ByteArray)) {
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1886
	cnt = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1887
	p1 = __ByteArrayInstPtr(self)->ba_element;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1888
	p2 = p1 + cnt - 1;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1889
	while (cnt > 0) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1890
	    t = *p1;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1891
	    *p1++ = *p2;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1892
	    *p2-- = t;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1893
	    cnt-=2;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1894
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1895
	RETURN ( self );
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1896
    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1897
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  1898
    ^ super reverse
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1899
!
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1900
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1901
swapBytes
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1902
    "swap bytes inplace - 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1903
     written as a primitive for speed on image grabbing (if display order is different)"
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1904
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1905
%{  /* NOCONTEXT */
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1906
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1907
    REGISTER unsigned char *p;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1908
    REGISTER int cnt;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1909
    REGISTER unsigned t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1910
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1911
    if (__qClass(self) == @global(ByteArray)) {
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1912
	cnt = __byteArraySize(self);
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1913
	cnt = cnt & ~1; /* make it even */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1914
	p = __ByteArrayInstPtr(self)->ba_element;
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1915
	while (cnt > 0) {
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1916
	    t = p[0];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1917
	    p[0] = p[1];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1918
	    p[1] = t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1919
	    p += 2;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1920
	    cnt -= 2;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1921
	}
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1922
	RETURN ( self );
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1923
    }
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1924
%}.
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1925
    ^ super swapBytes "/ rubbish - there is no one currenly
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1926
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1927
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1928
     #[1 2 3 4 5 6 7 8 9 10] copy swapBytes 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1929
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapBytes  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1930
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1931
!
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1932
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1933
swapLongs
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1934
    "swap long bytes inplace - 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1935
     written as a primitive for speed on image grabbing (if display order is different)"
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1936
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1937
%{  /* NOCONTEXT */
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1938
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1939
    REGISTER unsigned char *p;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1940
    REGISTER int cnt;
931
Claus Gittinger <cg@exept.de>
parents: 930
diff changeset
  1941
    REGISTER unsigned t;
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1942
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1943
    if (__qClass(self) == @global(ByteArray)) {
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1944
	cnt = __byteArraySize(self);
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1945
	cnt = cnt & ~3; /* make it even */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  1946
	p = __ByteArrayInstPtr(self)->ba_element;
930
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1947
	while (cnt > 0) {
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1948
	    t = p[0];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1949
	    p[0] = p[3];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1950
	    p[3] = t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1951
	    t = p[1];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1952
	    p[1] = p[2];
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1953
	    p[2] = t;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1954
	    p += 4;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1955
	    cnt -= 4;
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1956
	}
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1957
	RETURN ( self );
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1958
    }
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1959
%}.
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1960
    ^ super swapLongs "/ rubbish - there is no one currenly
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1961
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1962
    "
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1963
     #[1 2 3 4 5 6 7 8 9] copy swapLongs 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1964
     #[1 2 3 4 5 6 7 8 9 10] copy swapLongs 
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1965
     #[1 2 3 4 5 6 7 8 9 10 11] copy swapLongs  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1966
     #[1 2 3 4 5 6 7 8 9 10 11 12] copy swapLongs  
dd2ba4051d6a added swapBytes & swapLongs (needed when grabbing depth8/depth16 image from screen)
Claus Gittinger <cg@exept.de>
parents: 835
diff changeset
  1967
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1968
! !
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1969
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1970
!ByteArray methodsFor:'printing & storing'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1971
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1972
asPackedString
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1973
    "ST-80 compatibility: encode the receiver into an ascii String
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1974
     with 6bits encoded per character. Each group of 6 bits is encoded
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1975
     as a corresponding character (32+value) and the resulting string
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1976
     is returned. The resulting string is always a multiple of 4 (since
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1977
     24 is the lcm of 6 and 8) and the number of remaining characters is
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1978
     encoded in the last character.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1979
     ST-80 uses this encoding for Images ...
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1980
     PS: I dont like it ;-)"
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1981
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1982
    |outStream 
1974
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1983
     index     "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1984
     nextIndex "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1985
     stop      "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1986
     n         "{ Class:SmallInteger}"
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1987
     mod       "{ Class:SmallInteger}"|
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1988
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1989
    outStream := WriteStream on:String new.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1990
    index := 1. 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1991
    stop := self size.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  1992
    [index <= stop] whileTrue:[
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1993
        "take 3 source bytes"
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1994
        n := (self at:index) bitShift:16.
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1995
        (index < stop) ifTrue:[
1974
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1996
            nextIndex := index + 1.
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1997
            n := n bitOr:((self at:nextIndex) bitShift:8).
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  1998
            (nextIndex < stop) ifTrue:[
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  1999
                n := n bitOr:(self at:(index + 2)).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2000
            ].
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2001
        ].
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2002
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2003
        "took me a while to find that one out ..."
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2004
        n := n bitXor:16r820820.
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2005
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2006
        outStream nextPut:(Character value:(n bitShift:-18) + 32).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2007
        outStream nextPut:(Character value:((n bitShift:-12) bitAnd:16r3F) + 32).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2008
        outStream nextPut:(Character value:((n bitShift:-6) bitAnd:16r3F) + 32).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2009
        outStream nextPut:(Character value:(n bitAnd:16r3F) + 32).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2010
        index := index + 3.
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2011
    ].
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2012
    (mod := stop \\ 3) ~~ 0 ifTrue:[
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2013
        outStream position:(outStream position - 1).
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2014
        outStream nextPut:(Character value:(mod + 96)).
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2015
    ].
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2016
    ^ outStream contents
1973
305b5cbe927e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1883
diff changeset
  2017
1974
38e1505dfb94 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1973
diff changeset
  2018
    "Modified: 12.11.1996 / 15:45:02 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2019
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2020
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2021
displayString
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2022
    "return a printed representation of the receiver for displaying"
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2023
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2024
    ^ self storeString
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2025
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2026
    "Created: 25.10.1995 / 13:33:26 / cg"
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2027
    "Modified: 22.4.1996 / 12:54:06 / cg"
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2028
!
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2029
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2030
storeOn:aStream
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2031
    "append a printed representation from which the receiver can be
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2032
     reconstructed to aStream. (reimplemented to make it look better)"
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2033
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2034
    |first|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2035
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2036
    self class == ByteArray ifTrue:[    "/ care for subclasses
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2037
        aStream nextPutAll:'#['.
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2038
        first := true.
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2039
        self do:[:byte | 
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2040
            first ifFalse:[aStream space]
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2041
                  ifTrue:[first := false].
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2042
            byte storeOn:aStream.
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2043
        ].
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2044
        aStream nextPutAll:']'.
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2045
        ^ self
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2046
    ].
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2047
    ^ super storeOn:aStream
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2048
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2049
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2050
     #[1 2 3 4 5] storeOn:Transcript   
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2051
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2052
     #[1 2 3 4 5] storeString            
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2053
     #[1 2 3 4 5] displayString         
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2054
     #[1 2 3 4 5] printString         
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2055
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2056
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2057
    "Modified: 7.3.1996 / 15:11:44 / cg"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2058
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2059
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2060
!ByteArray methodsFor:'queries'!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2061
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2062
indexOf:aByte startingAt:start
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2063
    "return the index of the first occurrence of the argument, aByte
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2064
     in the receiver starting at start, anInteger; return 0 if not found.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2065
     - reimplemented here for speed"
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2066
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2067
%{  /* NOCONTEXT */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2068
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2069
    REGISTER unsigned char *cp;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2070
    REGISTER int index, byteValue;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2071
    REGISTER int len;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2072
    OBJ cls;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2073
1002
c44e50c09986 care for 16bit subclass instances (in tuned methods)
Claus Gittinger <cg@exept.de>
parents: 931
diff changeset
  2074
    if (__isSmallInteger(aByte) &&__isBytes(self)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2075
	byteValue = __intVal(aByte);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2076
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2077
	if (byteValue & ~0xFF /* i.e. (byteValue < 0) || (byteValue > 255) */) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2078
	    /*
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2079
	     * searching for something which cannot be found
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2080
	     */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2081
	    RETURN ( __MKSMALLINT(0) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2082
	}
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2083
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2084
	if (__isSmallInteger(start)) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2085
	    index = __intVal(start);
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2086
	    len = __byteArraySize(self);
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2087
	    cp = __ByteArrayInstPtr(self)->ba_element;
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2088
	    if ((cls = __qClass(self)) != @global(ByteArray)) {
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2089
		int nInst;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2090
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2091
		nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2092
		cp += nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2093
		len -= nInst;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2094
	    }
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2095
	    cp += index - 1;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2096
	    while (index <= len) {
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2097
		if (*cp == byteValue) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2098
		    RETURN ( __MKSMALLINT(index) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2099
		}
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2100
		index++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2101
		cp++;
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2102
	    }
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2103
	    RETURN ( __MKSMALLINT(0) );
1019
db8afc103e37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
  2104
	}
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2105
    }
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2106
%}.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2107
    ^ super indexOf:aByte startingAt:start
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2108
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2109
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2110
     #[1 2 3 4 5 6 7 8 9 0 1 2 3 4 5] indexOf:0 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2111
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2112
!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2113
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2114
isLiteral
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2115
    "return true, if the receiver can be used as a literal
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2116
     (i.e. can be used in constant arrays)"
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2117
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2118
    "/ no, simply returning true here is a mistake:
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2119
    "/ it could be a subclass of ByteArray 
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2120
    "/ (of which the compiler does not know at all ...)
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2121
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2122
    ^ self class == ByteArray
1244
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2123
dc9dd731258c commentary
Claus Gittinger <cg@exept.de>
parents: 1230
diff changeset
  2124
    "Modified: 22.4.1996 / 12:55:30 / cg"
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2125
!
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2126
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2127
max
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2128
    "return the maximum value in the receiver -
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2129
     redefined to speedup image processing and sound-player 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2130
     (which need a fast method for this on byteArrays)"
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2131
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2132
%{  /* NOCONTEXT */
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2133
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2134
    REGISTER unsigned char *cp;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2135
    REGISTER int index, max;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2136
    int len;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2137
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2138
    if (__qClass(self) == @global(ByteArray)) {
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2139
	max = 0;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2140
	index = 0;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2141
	len = __qSize(self) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2142
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2143
	while (++index <= len) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2144
	    if (*cp > max) max = *cp;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2145
	    cp++;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2146
	}
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2147
	RETURN ( __MKSMALLINT(max) );
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2148
    }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2149
%}.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2150
    ^ super max
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2151
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2152
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2153
     #[1 2 3 1 2 3 1 2 19] max 
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2154
    "
1082
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2155
! !
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2156
b186a68fff0e category change
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  2157
!ByteArray methodsFor:'special queries'!
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2158
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2159
usageCounts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2160
    "return an array filled with value-counts -
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2161
     This is needed in the bitmap/image classes to get info on color usage.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2162
     (i.e. to build up a histogram of color usage within an image)."
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2163
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2164
    |counts|
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2165
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2166
    counts := Array basicNew:256.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2167
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2168
%{  /* STACK: 2000 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2169
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2170
    REGISTER unsigned char *cp;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2171
    REGISTER int nByte;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2172
    REGISTER int index;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2173
    int icounts[256];
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2174
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2175
    if ((__qClass(self) == @global(ByteArray)) && __isArray(counts)) {
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2176
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2177
	 * zero counts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2178
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2179
	for (index=0; index<256; index++) {
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2180
	    icounts[index] = 0;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2181
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2182
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2183
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2184
	 * count
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2185
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2186
	nByte = __qSize(self) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2187
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2188
	while (nByte--) {
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2189
	    icounts[*cp++]++;
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2190
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2191
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2192
	/*
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2193
	 * make it real counts
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2194
	 */
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2195
	for (index=0; index<256; index++) {
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2196
	    __ArrayInstPtr(counts)->a_element[index] = __MKSMALLINT(icounts[index]);
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2197
	}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2198
	RETURN ( counts );
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2199
    }
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2200
%}
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2201
.
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2202
    self primitiveFailed
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2203
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2204
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2205
     #[1 2 3 1 2 3 1 2 250 251 250 251 255] usageCounts 
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2206
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2207
!
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2208
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2209
usedValues
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2210
    "return a new ByteArray with all used values (actually a kind of Set);
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2211
     This is needed specially in the bitmap/Imageclasses to find used colors 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2212
     in an image."
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2213
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2214
    |result l|
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2215
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2216
%{  /* STACK: 400 */
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2217
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2218
    REGISTER unsigned char *cp;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2219
    REGISTER int len;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2220
    unsigned char flags[256];
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2221
    static struct inlineCache nw = _ILC1;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2222
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2223
    if (__qClass(self) == @global(ByteArray)) {
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2224
	memset(flags, 0, sizeof(flags));
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2225
	len = __qSize(self) - OHDR_SIZE;
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2226
	cp = &(__ByteArrayInstPtr(self)->ba_element[0]);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2227
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2228
	/* for each used byte, set flag */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2229
	while (len > 0) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2230
	    flags[*cp] = 1;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2231
	    cp++;
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2232
	    len--;
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2233
	}
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2234
	/* count 1's */
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2235
	len = 0;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2236
	for (cp=flags+255; cp >= flags; cp--)
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2237
	    if (*cp) len++;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2238
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2239
	/* create ByteArray of used values */
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2240
	result = (*nw.ilc_func)(@global(ByteArray),
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2241
				@symbol(new:), 
1688
8a42db1eea60 removed all COMMA_CON / CON_COMMA uses
Claus Gittinger <cg@exept.de>
parents: 1649
diff changeset
  2242
				nil, &nw, 
1133
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2243
				__MKSMALLINT(len));
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2244
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2245
	if (__Class(result) == @global(ByteArray)) {
961f2b095c22 underline cleanup
Claus Gittinger <cg@exept.de>
parents: 1082
diff changeset
  2246
	    cp = &(__ByteArrayInstPtr(result)->ba_element[0]);
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2247
	    for (len=0; len < 256; len++) {
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2248
		if (flags[len]) 
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2249
		    *cp++ = len;
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2250
	    }
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2251
	}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2252
	RETURN ( result );
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2253
    }
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2254
%}
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2255
.
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2256
    ^ self asSet
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2257
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2258
    "
563
593f73e7c52c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 550
diff changeset
  2259
     #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues 
550
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2260
    "
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2261
! !
b40ca6a280c1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 528
diff changeset
  2262
1883
d3fbf4b36be7 renamed #normalize to #compressed (ST_80 compat)
Claus Gittinger <cg@exept.de>
parents: 1695
diff changeset
  2263
!ByteArray class methodsFor:'documentation'!
628
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2264
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2265
version
2447
e83cf6acfdcf fixed #fromPackedString:
Claus Gittinger <cg@exept.de>
parents: 2145
diff changeset
  2266
    ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.76 1997-03-06 14:29:25 cg Exp $'
628
7aa563e4c64a version at the end
Claus Gittinger <cg@exept.de>
parents: 563
diff changeset
  2267
! !