ByteArray.st
author claus
Wed, 15 Feb 1995 11:22:05 +0100
changeset 249 810798c5c2e5
parent 221 28d5ebaa2a18
child 281 d63a7d2c31a6
permissions -rw-r--r--
.
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
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
       classVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    16
       poolDictionaries:''
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
    17
       category:'Collections-Arrayed'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
ByteArray comment:'
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    21
COPYRIGHT (c) 1989 by Claus Gittinger
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
    22
	      All Rights Reserved
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
    23
249
claus
parents: 221
diff changeset
    24
$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.22 1995-02-15 10:21:21 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    25
'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    27
!ByteArray class methodsFor:'documentation'!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    28
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    31
 COPYRIGHT (c) 1989 by Claus Gittinger
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
    32
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    33
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    41
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    42
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
version
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
"
249
claus
parents: 221
diff changeset
    45
$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.22 1995-02-15 10:21:21 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    48
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
documentation
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
    ByteArrays store integers in the range 0..255.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    52
    In contrast to normal arrays (which store pointers to their elements),
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    53
    byteArrays store the values in a dens & compact way. ByteArrays can
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    54
    be used to hold the data for bitmaps, images and other bulk data.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    55
    ByteArrays are also used to store the bytecode-instructions of an
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    56
    interpreted method and are used as superclass for Strings.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    57
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    58
    ByteArrays can be used as literals i.e. you can enter ByteArray-constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    59
    as #[ element1 element2 .... elementN] and also use byteArray constants
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    60
    as elements in a constant array.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    61
    As in: #( #[1 1 1] #[2 2 2] #[3 3 3])
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    62
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    63
    If you have to communicate structure-data (in the C-sense) with external
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    64
    programs/data-bases, see a companion class (Structure) in the goodies directory.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    65
    It allows the definition of subclasses of ByteArray, which transparently fetch
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
    66
    and store C-structure fields.
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    67
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    68
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    70
!ByteArray class methodsFor:'queries'!
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    71
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    72
isBuiltInClass
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    73
    "this class is known by the run-time-system"
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    74
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    75
    ^ self == ByteArray
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    76
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
    77
2
claus
parents: 1
diff changeset
    78
!ByteArray class methodsFor: 'binary storage'!
claus
parents: 1
diff changeset
    79
claus
parents: 1
diff changeset
    80
binaryDefinitionFrom: stream manager: manager
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    81
    "get a ByteArray from the binary stream.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    82
     ByteArrays are stored as 4-byte size, followed by the bytes"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    83
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    84
    "take care of subclasses ..."
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    85
    self == ByteArray ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
    86
	^ (stream next: (stream nextNumber: 4))
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    87
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
    88
    ^ super binaryDefinitionFrom: stream manager: manager
2
claus
parents: 1
diff changeset
    89
! !
claus
parents: 1
diff changeset
    90
claus
parents: 1
diff changeset
    91
!ByteArray methodsFor: 'binary storage'!
claus
parents: 1
diff changeset
    92
claus
parents: 1
diff changeset
    93
storeBinaryDefinitionOn: stream manager: manager
37
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    94
    "append a binary representation of the receiver onto stream.
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    95
     Redefined since ByteArrays are stored with a special type code and
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    96
     in a more compact way."
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    97
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    98
    "not, if I have named instance variables"
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
    99
    self class instSize ~~ 0 ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   100
	^ super storeBinaryDefinitionOn: stream manager: manager
37
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
   101
    ].
2
claus
parents: 1
diff changeset
   102
    manager putIdOf: self class on: stream.
claus
parents: 1
diff changeset
   103
    stream nextNumber: 4 put: self basicSize.
37
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
   104
    stream nextPutAll: self asByteArray
2
claus
parents: 1
diff changeset
   105
! !
claus
parents: 1
diff changeset
   106
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
!ByteArray class methodsFor:'instance creation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
a27a279701f8 Initial revision
claus
parents:
diff changeset
   109
uninitializedNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   110
    "return a new instance of the receiver with uninitialized
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
     (i.e. undefined) contents. The indexed elements have any random
75
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   112
     value. However, any named instance variables are still nilled. 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   113
     For use, when contents will be set anyway shortly after - this
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   114
     is a bit faster than the regular basicNew:, which clears the bytes.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   115
     Of course, it only makes a difference for very big ByteArrays, such
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   116
     as used for images/bitmaps.
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   117
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   118
     Notice: if you want to port code using uninitializedNew: to another
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   119
     smalltalk, you have to add an 'uninitializedNew: -> basicNew:'-calling 
2c61e28412de *** empty log message ***
claus
parents: 68
diff changeset
   120
     method to the ByteArray class of the other smalltalk."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
    OBJ newobj;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
    INT instsize, nInstVars, nindexedinstvars;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
    REGISTER OBJ *op;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
    extern OBJ new();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
249
claus
parents: 221
diff changeset
   128
    if (__isSmallInteger(anInteger)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   129
	nindexedinstvars = _intVal(anInteger);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   130
	if (nindexedinstvars >= 0) {
249
claus
parents: 221
diff changeset
   131
	    if (self == ByteArray) {
claus
parents: 221
diff changeset
   132
		/*
claus
parents: 221
diff changeset
   133
		 * the most common case
claus
parents: 221
diff changeset
   134
		 */
claus
parents: 221
diff changeset
   135
		instsize = OHDR_SIZE + nindexedinstvars;
claus
parents: 221
diff changeset
   136
		if (_CanDoQuickNew(instsize)) {
claus
parents: 221
diff changeset
   137
		    _qCheckedNew(newobj, instsize);
claus
parents: 221
diff changeset
   138
		    _InstPtr(newobj)->o_class = self;
claus
parents: 221
diff changeset
   139
		    RETURN (newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   140
		}
249
claus
parents: 221
diff changeset
   141
	    }
claus
parents: 221
diff changeset
   142
	    nInstVars = _intVal(_ClassInstPtr(self)->c_ninstvars);
claus
parents: 221
diff changeset
   143
	    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars) + nindexedinstvars;
claus
parents: 221
diff changeset
   144
	    PROTECT_CONTEXT
claus
parents: 221
diff changeset
   145
	    _qNew(newobj, instsize, SENDER);
claus
parents: 221
diff changeset
   146
	    UNPROTECT_CONTEXT
claus
parents: 221
diff changeset
   147
	    if (newobj) {
claus
parents: 221
diff changeset
   148
		_InstPtr(newobj)->o_class = self;
claus
parents: 221
diff changeset
   149
		if (nInstVars) {
claus
parents: 221
diff changeset
   150
		    /*
claus
parents: 221
diff changeset
   151
		     * still have to nil out named instvars ...
claus
parents: 221
diff changeset
   152
		     */
claus
parents: 221
diff changeset
   153
#if defined(FAST_OBJECT_MEMSET4)
claus
parents: 221
diff changeset
   154
		    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   155
#else
249
claus
parents: 221
diff changeset
   156
# if defined(FAST_MEMSET) && !defined(NEGATIVE_ADDRESSES)
claus
parents: 221
diff changeset
   157
		    /*
claus
parents: 221
diff changeset
   158
		     * knowing that nil is 0
claus
parents: 221
diff changeset
   159
		     */
claus
parents: 221
diff changeset
   160
		    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
claus
parents: 221
diff changeset
   161
# else
claus
parents: 221
diff changeset
   162
		    op = _InstPtr(newobj)->i_instvars;
claus
parents: 221
diff changeset
   163
		    while (nInstVars--)
claus
parents: 221
diff changeset
   164
			*op++ = nil;
claus
parents: 221
diff changeset
   165
# endif
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   167
		}
249
claus
parents: 221
diff changeset
   168
		RETURN ( newobj );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   169
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   170
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   174
    (anInteger isMemberOf:SmallInteger) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   175
	(anInteger < 0) ifTrue:[
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   176
	    ^ self error:'bad (negative) argument to new'
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   177
	].
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   178
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   179
	 memory allocation failed.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   180
	 When we arrive here, there was no memory, even after
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   181
	 a garbage collect. This means, that the VM wanted to
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   182
	 get some more memory from the Operatingsystem, which
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   183
	 was not kind enough to give some.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   184
	"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   185
	^ ObjectMemory allocationFailureSignal raise.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   186
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   187
    ^ self basicNew:anInteger
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   189
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
!ByteArray methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   191
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   193
    "return the indexed instance variable with index, anInteger
2
claus
parents: 1
diff changeset
   194
     - redefined here to be slighly faster than the default in Object"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
a27a279701f8 Initial revision
claus
parents:
diff changeset
   196
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
    REGISTER int indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
    int nIndex;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   200
    OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
249
claus
parents: 221
diff changeset
   202
    if (__isSmallInteger(index)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   203
	indx = _intVal(index);
249
claus
parents: 221
diff changeset
   204
	if (indx > 0) {
claus
parents: 221
diff changeset
   205
	    if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   206
		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   207
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   208
	    if (indx <= nIndex) {
claus
parents: 221
diff changeset
   209
		RETURN ( _MKSMALLINT(_ByteArrayInstPtr(self)->ba_element[indx - 1]) );
claus
parents: 221
diff changeset
   210
	    }
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   211
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   212
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   213
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   214
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
    ^ super basicAt:index
a27a279701f8 Initial revision
claus
parents:
diff changeset
   216
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   217
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
basicAt:index put:value
a27a279701f8 Initial revision
claus
parents:
diff changeset
   219
    "set the indexed instance variable with index, anInteger to value
2
claus
parents: 1
diff changeset
   220
     - redefined here to be slighly faster than the default in Object"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
    REGISTER int indx;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
    int nIndex;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
    int val;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   227
    OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
249
claus
parents: 221
diff changeset
   229
    if (__bothSmallInteger(index, value)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   230
	val = _intVal(value);
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   231
	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   232
	    indx = _intVal(index);
249
claus
parents: 221
diff changeset
   233
	    if (indx > 0) {
claus
parents: 221
diff changeset
   234
		if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   235
		    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   236
		nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   237
		if (indx <= nIndex) {
claus
parents: 221
diff changeset
   238
		    _ByteArrayInstPtr(self)->ba_element[indx - 1] = val;
claus
parents: 221
diff changeset
   239
		    RETURN ( value );
claus
parents: 221
diff changeset
   240
		}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   241
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   242
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   243
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   244
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
    ^ super basicAt:index put:value
2
claus
parents: 1
diff changeset
   247
!
claus
parents: 1
diff changeset
   248
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   249
byteAt:index
249
claus
parents: 221
diff changeset
   250
    "return the byte at index. 
claus
parents: 221
diff changeset
   251
     For ByteArray, this is the same as basicAt:; 
claus
parents: 221
diff changeset
   252
     however, for strings or symbols, this returns a numeric byteValue
claus
parents: 221
diff changeset
   253
     instead of a character."
claus
parents: 221
diff changeset
   254
claus
parents: 221
diff changeset
   255
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   256
claus
parents: 221
diff changeset
   257
    REGISTER int indx;
claus
parents: 221
diff changeset
   258
    int nIndex;
claus
parents: 221
diff changeset
   259
    OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   260
249
claus
parents: 221
diff changeset
   261
    if (__isSmallInteger(index)) {
claus
parents: 221
diff changeset
   262
	indx = _intVal(index);
claus
parents: 221
diff changeset
   263
	if (indx > 0) {
claus
parents: 221
diff changeset
   264
	    if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   265
		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   266
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   267
	    if (indx <= nIndex) {
claus
parents: 221
diff changeset
   268
		RETURN ( _MKSMALLINT(_ByteArrayInstPtr(self)->ba_element[indx - 1]) );
claus
parents: 221
diff changeset
   269
	    }
claus
parents: 221
diff changeset
   270
	}
claus
parents: 221
diff changeset
   271
    }
claus
parents: 221
diff changeset
   272
%}
claus
parents: 221
diff changeset
   273
.
claus
parents: 221
diff changeset
   274
    ^ (super basicAt:index) asInteger
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   275
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   276
249
claus
parents: 221
diff changeset
   277
byteAt:index put:value
claus
parents: 221
diff changeset
   278
    "set the byte at index. For ByteArray, this is the same as basicAt:put:.
claus
parents: 221
diff changeset
   279
     However, for Strings, this expects a byteValue to be stored."
claus
parents: 221
diff changeset
   280
claus
parents: 221
diff changeset
   281
%{  /* NOCONTEXT */
claus
parents: 221
diff changeset
   282
claus
parents: 221
diff changeset
   283
    REGISTER int indx;
claus
parents: 221
diff changeset
   284
    int nIndex;
claus
parents: 221
diff changeset
   285
    int val;
claus
parents: 221
diff changeset
   286
    OBJ cls;
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   287
249
claus
parents: 221
diff changeset
   288
    if (__bothSmallInteger(index, value)) {
claus
parents: 221
diff changeset
   289
	val = _intVal(value);
claus
parents: 221
diff changeset
   290
	if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
claus
parents: 221
diff changeset
   291
	    indx = _intVal(index);
claus
parents: 221
diff changeset
   292
	    if (indx > 0) {
claus
parents: 221
diff changeset
   293
		if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   294
		    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   295
		nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   296
		if (indx <= nIndex) {
claus
parents: 221
diff changeset
   297
		    _ByteArrayInstPtr(self)->ba_element[indx - 1] = val;
claus
parents: 221
diff changeset
   298
		    RETURN ( value );
claus
parents: 221
diff changeset
   299
		}
claus
parents: 221
diff changeset
   300
	    }
claus
parents: 221
diff changeset
   301
	}
claus
parents: 221
diff changeset
   302
    }
claus
parents: 221
diff changeset
   303
%}
claus
parents: 221
diff changeset
   304
.
claus
parents: 221
diff changeset
   305
    ^ super basicAt:index put:value
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   306
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   307
2
claus
parents: 1
diff changeset
   308
wordAt:index
claus
parents: 1
diff changeset
   309
    "return the 2-bytes starting at index as an (unsigned) Integer.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   310
     The value is retrieved LSB-first (i.e. low 8-bits at lower byte index).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   311
     Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)"
2
claus
parents: 1
diff changeset
   312
claus
parents: 1
diff changeset
   313
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   314
claus
parents: 1
diff changeset
   315
    REGISTER int indx;
claus
parents: 1
diff changeset
   316
    int nIndex;
claus
parents: 1
diff changeset
   317
    int val;
249
claus
parents: 221
diff changeset
   318
    OBJ cls;
2
claus
parents: 1
diff changeset
   319
249
claus
parents: 221
diff changeset
   320
    if (__isSmallInteger(index)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   321
	indx = _intVal(index);
249
claus
parents: 221
diff changeset
   322
	if (indx > 0) {
claus
parents: 221
diff changeset
   323
	    if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   324
		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   325
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   326
	    if ((indx+1) <= nIndex) {
claus
parents: 221
diff changeset
   327
		val = _ByteArrayInstPtr(self)->ba_element[indx+1-1];
claus
parents: 221
diff changeset
   328
		val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1];
claus
parents: 221
diff changeset
   329
		RETURN ( _MKSMALLINT(val) );
claus
parents: 221
diff changeset
   330
	    }
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   331
	}
2
claus
parents: 1
diff changeset
   332
    }
claus
parents: 1
diff changeset
   333
%}
claus
parents: 1
diff changeset
   334
.
claus
parents: 1
diff changeset
   335
    ^ ((self at:index+1) * 256) + (self at:index)
claus
parents: 1
diff changeset
   336
!
claus
parents: 1
diff changeset
   337
claus
parents: 1
diff changeset
   338
wordAt:index put:value
claus
parents: 1
diff changeset
   339
    "set the 2-bytes starting at index from the (unsigned) Integer value.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   340
     The stored value must be in the range 0 .. 16rFFFF. 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   341
     The value is stored LSB-first - i.e. the low 8bits are stored at the
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   342
     lower address.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   343
     Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)"
2
claus
parents: 1
diff changeset
   344
claus
parents: 1
diff changeset
   345
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   346
claus
parents: 1
diff changeset
   347
    REGISTER int indx;
claus
parents: 1
diff changeset
   348
    int nIndex;
claus
parents: 1
diff changeset
   349
    int val;
249
claus
parents: 221
diff changeset
   350
    OBJ cls;
2
claus
parents: 1
diff changeset
   351
249
claus
parents: 221
diff changeset
   352
    if (__bothSmallInteger(index, value)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   353
	indx = _intVal(index);
249
claus
parents: 221
diff changeset
   354
	if (indx > 0) {
claus
parents: 221
diff changeset
   355
	    if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   356
		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   357
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   358
	    if ((indx+1) <= nIndex) {
claus
parents: 221
diff changeset
   359
		val = _intVal(value);
claus
parents: 221
diff changeset
   360
		if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) {
claus
parents: 221
diff changeset
   361
		    _ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
claus
parents: 221
diff changeset
   362
		    _ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF;
claus
parents: 221
diff changeset
   363
		    RETURN ( value );
claus
parents: 221
diff changeset
   364
		}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   365
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   366
	}
2
claus
parents: 1
diff changeset
   367
    }
claus
parents: 1
diff changeset
   368
%}
claus
parents: 1
diff changeset
   369
.
claus
parents: 1
diff changeset
   370
    (value < 0) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   371
	^ self elementBoundsError
2
claus
parents: 1
diff changeset
   372
    ].
claus
parents: 1
diff changeset
   373
    self at:index put:(value \\ 256).
claus
parents: 1
diff changeset
   374
    self at:index + 1 put:(value // 256).
claus
parents: 1
diff changeset
   375
    ^ value
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   376
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   377
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   378
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   379
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   380
     b wordAt:1 put:16r0102.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   381
     b wordAt:3 put:16r0304.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   382
     b inspect  
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   383
    "
2
claus
parents: 1
diff changeset
   384
!
claus
parents: 1
diff changeset
   385
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   386
signedWordAt:index
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   387
    "return the 2-bytes starting at index as a signed Integer.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   388
     The value is retrieved LSB-first (i.e. low 8-bits at lower byte index)"
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   389
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   390
    |w|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   391
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   392
    w := self wordAt:index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   393
    (w > 16r7FFF) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   394
	^ w - 16r10000
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   395
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   396
    ^ w
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   397
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   398
    "
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   399
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   400
     b := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   401
     b wordAt:1 put:16rFFFF.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   402
     b signedWordAt:1
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   403
    "
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   404
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   405
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   406
signedWordAt:index put:value
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   407
    "set the 2-bytes starting at index from the signed Integer value.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   408
     The stored value must be in the range -32768 .. +32676.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   409
     The value is stored LSB-first (i.e. low 8-bits at lower byte index)"
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   410
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   411
    value > 0 ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   412
	^ self wordAt:index put:value
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   413
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   414
    ^ self wordAt:index put:(16r10000 + value)
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   415
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   416
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   417
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   418
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   419
     b signedWordAt:1 put:-1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   420
     b signedWordAt:3 put:-2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   421
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   422
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   423
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   424
2
claus
parents: 1
diff changeset
   425
doubleWordAt:index
claus
parents: 1
diff changeset
   426
    "return the 4-bytes starting at index as an (unsigned) Integer.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   427
     The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   428
     question: should it return a signed value ? (see ByteArray>>signedDoubleWordAt:)"
2
claus
parents: 1
diff changeset
   429
claus
parents: 1
diff changeset
   430
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   431
claus
parents: 1
diff changeset
   432
    REGISTER int indx;
claus
parents: 1
diff changeset
   433
    int nIndex;
claus
parents: 1
diff changeset
   434
    int val;
249
claus
parents: 221
diff changeset
   435
    OBJ cls;
2
claus
parents: 1
diff changeset
   436
249
claus
parents: 221
diff changeset
   437
    if (__isSmallInteger(index)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   438
	indx = _intVal(index);
249
claus
parents: 221
diff changeset
   439
	if (indx > 0) {
claus
parents: 221
diff changeset
   440
	    if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   441
		indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   442
	    nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
   443
	    if ((indx+3) <= nIndex) {
claus
parents: 221
diff changeset
   444
		val = _ByteArrayInstPtr(self)->ba_element[indx+3-1];
claus
parents: 221
diff changeset
   445
		val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+2-1];
claus
parents: 221
diff changeset
   446
		val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx+1-1];
claus
parents: 221
diff changeset
   447
		val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1];
claus
parents: 221
diff changeset
   448
		if ((val >= 0) && (val <= _MAX_INT)) {
claus
parents: 221
diff changeset
   449
		    RETURN ( _MKSMALLINT(val) );
claus
parents: 221
diff changeset
   450
		}
claus
parents: 221
diff changeset
   451
		RETURN ( _MKULARGEINT(val) );
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   452
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   453
	}
2
claus
parents: 1
diff changeset
   454
    }
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   455
    /*
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   456
     * fall through in case of any error
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   457
     * it will be handled in wordAt: finally
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   458
     */
2
claus
parents: 1
diff changeset
   459
%}
claus
parents: 1
diff changeset
   460
.
85
claus
parents: 77
diff changeset
   461
    ^ ((256 * 256) * (self wordAt:index+2)) + (self wordAt:index)
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   462
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   463
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   464
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   465
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   466
     b := ByteArray withAll:#(1 2 3 4).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   467
     (b doubleWordAt:1) printStringRadix:16   
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   468
    "
2
claus
parents: 1
diff changeset
   469
!
claus
parents: 1
diff changeset
   470
claus
parents: 1
diff changeset
   471
doubleWordAt:index put:value
claus
parents: 1
diff changeset
   472
    "set the 4-bytes starting at index from the (unsigned) Integer value.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   473
     The value must be in the range 0 to 16rFFFFFFFF.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   474
     The value is stored LSB-first (i.e. low 8-bits at lowest byte-index).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   475
     question: should it store signed values ? (see ByteArray signedDoubleWordAt:put:)"
2
claus
parents: 1
diff changeset
   476
claus
parents: 1
diff changeset
   477
    |t|
claus
parents: 1
diff changeset
   478
claus
parents: 1
diff changeset
   479
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   480
claus
parents: 1
diff changeset
   481
    REGISTER int indx;
claus
parents: 1
diff changeset
   482
    int nIndex;
claus
parents: 1
diff changeset
   483
    int val;
249
claus
parents: 221
diff changeset
   484
    OBJ cls;
2
claus
parents: 1
diff changeset
   485
249
claus
parents: 221
diff changeset
   486
    if (__bothSmallInteger(index, value)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   487
	val = _intVal(value);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   488
	if (val >= 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   489
	    indx = _intVal(index);
249
claus
parents: 221
diff changeset
   490
	    if (indx > 0) {
claus
parents: 221
diff changeset
   491
		if ((cls = _qClass(self)) != ByteArray)
claus
parents: 221
diff changeset
   492
		    indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
   493
		nIndex = _qSize(self) - OHDR_SIZE;
claus
parents: 221
diff changeset
   494
		if ((indx+3) <= nIndex) {
claus
parents: 221
diff changeset
   495
		    _ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF;
claus
parents: 221
diff changeset
   496
		    val >>= 8;
claus
parents: 221
diff changeset
   497
		    _ByteArrayInstPtr(self)->ba_element[indx+1-1] = val & 0xFF;
claus
parents: 221
diff changeset
   498
		    val >>= 8;
claus
parents: 221
diff changeset
   499
		    _ByteArrayInstPtr(self)->ba_element[indx+2-1] = val & 0xFF;
claus
parents: 221
diff changeset
   500
		    val >>= 8;
claus
parents: 221
diff changeset
   501
		    _ByteArrayInstPtr(self)->ba_element[indx+3-1] = val & 0xFF;
claus
parents: 221
diff changeset
   502
		    RETURN ( value );
claus
parents: 221
diff changeset
   503
		}
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   504
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   505
	}
2
claus
parents: 1
diff changeset
   506
    }
claus
parents: 1
diff changeset
   507
%}
claus
parents: 1
diff changeset
   508
.
claus
parents: 1
diff changeset
   509
    (value < 0) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   510
	^ self elementBoundsError
2
claus
parents: 1
diff changeset
   511
    ].
claus
parents: 1
diff changeset
   512
    t := value // (256 * 256).
claus
parents: 1
diff changeset
   513
    self wordAt:(index+2) put:t.
85
claus
parents: 77
diff changeset
   514
    self wordAt:(index) put:(value - (256 * 256 * t)).
2
claus
parents: 1
diff changeset
   515
    ^ value
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   516
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   517
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   518
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   519
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   520
     b doubleWordAt:1 put:16r04030201.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   521
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   522
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   523
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   524
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   525
signedDoubleWordAt:index
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   526
    "return the 4-bytes starting at index as a signed Integer.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   527
     The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index)."
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   528
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   529
    |w|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   530
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   531
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   532
     stupid: due to an STC bug, cannot currently have LargeInteger
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   533
     constants - change to code below when fixed ...
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   534
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   535
    w := self doubleWordAt:index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   536
    (w > (16r7FFFFFF * 16r10 + 16rF)) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   537
	^ w - (16r10000000 * 16r10)
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   538
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   539
    ^ w
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   540
"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   541
    w := self doubleWordAt:index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   542
    (w > 16r7FFFFFFF) ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   543
	^ w - 16r100000000
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   544
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   545
    ^ w
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   546
"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   547
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   548
    "
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   549
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   550
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   551
     b doubleWordAt:1 put:16rFFFFFFFF.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   552
     (b signedDoubleWordAt:1)    
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   553
    "
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   554
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   555
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   556
signedDoubleWordAt:index put:value
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   557
    "set the 4-bytes starting at index from the signed Integer value.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   558
     The value is stored LSB-first (i.e. low 8-bits at lowest byte-index)."
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   559
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   560
    value > 0 ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   561
	^ self doubleWordAt:index put:value
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   562
    ].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   563
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   564
     stupid: due to an STC bug, cannot currently have LargeInteger
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   565
     constants - change to code below when fixed ...
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   566
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   567
    ^ self doubleWordAt:index put:((16r10000000 * 16r10) + value)
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   568
"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   569
    ^ self doubleWordAt:index put:(16r100000000 + value)
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   570
"
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   571
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   572
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   573
     b := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   574
     b signedDoubleWordAt:1 put:-1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   575
     (b doubleWordAt:1) printStringRadix:16   
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   576
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   577
!
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   578
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   579
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   580
quadWordAt:index
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   581
    "return the 8-bytes starting at index as an (unsigned) Integer.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   582
     The value is retrieved LSB-first (i.e. low 8-bits at lowest byte-index)."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   583
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   584
    |l bIdx "{ Class: SmallInteger }"|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   585
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   586
    l := LargeInteger basicNew numberOfDigits:8.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   587
    bIdx := index.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   588
    1 to:8 do:[:i |
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   589
	l digitAt:i put:(self basicAt:bIdx).
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   590
	bIdx := bIdx + 1
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   591
    ].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   592
    ^ l normalize
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   593
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   594
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   595
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   596
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   597
     b := ByteArray withAll:#(1 2 3 4 5 6 7 8).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   598
     (b quadWordAt:1) printStringRadix:16  
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   599
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   600
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   601
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   602
quadWordAt:index put:anInteger
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   603
    "set the 8-bytes starting at index from the (unsigned) Integer value.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   604
     The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   605
     The value is stored LSB-first (i.e. low 8-bits at lowest byte-index)."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   606
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   607
    |bIdx "{ Class: SmallInteger }"|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   608
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   609
    bIdx := index.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   610
    1 to:8 do:[:i |
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   611
	self basicAt:bIdx put:(anInteger digitAt:i).
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   612
	bIdx := bIdx + 1.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   613
    ]
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   614
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   615
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   616
     |b|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   617
     b := ByteArray new:8.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   618
     b quadWordAtIndex:1 put:16r0807060504030201.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   619
     b inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   620
    "
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   621
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   622
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   623
floatAt:index
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   624
    "return the 4-bytes starting at index as a Float.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   625
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   626
     therefore this method reads a 4-byte float from the byteArray and returns
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   627
     a float object which keeps an 8-byte double internally.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   628
     Notice also, that the bytes are expected to be in this machines
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   629
     float representation and order - if the bytearray originated from another
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   630
     machine, some conversion is usually needed."
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   631
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   632
    |newFloat|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   633
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   634
    newFloat := Float basicNew.
77
6c38ca59927f *** empty log message ***
claus
parents: 75
diff changeset
   635
    UninterpretedBytes isBigEndian ifFalse:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   636
	5 to:8 do:[:destIndex|
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   637
	    newFloat basicAt:destIndex put:(self at:index - 5 + destIndex)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   638
	].
77
6c38ca59927f *** empty log message ***
claus
parents: 75
diff changeset
   639
    ] ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   640
	1 to:4 do:[:destIndex|
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   641
	    newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   642
	].
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   643
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   644
    ^ newFloat.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   645
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   646
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   647
floatAt:index put:aFloat
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   648
    "store the 4 bytes of value of the argument, aFloat into the receiver
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   649
     starting at index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   650
     Notice, that (currently) ST/X Floats are what DOubles are in ST-80.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   651
     Notice also, that the bytes are expected to be in this machines
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   652
     float representation - if the bytearray originated from another
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   653
     machine, some conversion is usually needed."
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   654
77
6c38ca59927f *** empty log message ***
claus
parents: 75
diff changeset
   655
    UninterpretedBytes isBigEndian ifFalse:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   656
	5 to:8 do:[:srcIndex|
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   657
	    self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   658
	].
77
6c38ca59927f *** empty log message ***
claus
parents: 75
diff changeset
   659
    ] ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   660
	1 to:4 do:[:srcIndex|
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   661
	    self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   662
	].
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   663
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   664
    ^ aFloat
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   665
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   666
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   667
doubleAt:index
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   668
    "return the 8-bytes starting at index as a Float.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   669
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   670
     Notice also, that the bytes are expected to be in this machines
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   671
     float representation - if the bytearray originated from another
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   672
     machine, some conversion is usually needed."
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   673
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   674
    |newFloat|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   675
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   676
    newFloat := Float basicNew.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   677
    1 to:8 do:[:destIndex|
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   678
	newFloat basicAt:destIndex put:(self at:index - 1 + destIndex)
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   679
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   680
    ^ newFloat.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   681
!
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   682
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   683
doubleAt:index put:aFloat
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   684
    "store the value of the argument, aFloat into the receiver
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   685
     starting at index.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   686
     Notice, that (currently) ST/X Floats are what Doubles are in ST-80.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   687
     Notice also, that the bytes are expected to be in this machines
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   688
     float representation - if the bytearray originated from another
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   689
     machine, some conversion is usually needed."
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   690
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   691
    1 to:8 do:[:srcIndex|
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   692
	self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex)
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   693
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   694
    ^ aFloat
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   695
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   696
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   697
ieeFloatAt:index
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   698
    "retrieve the 4 bytes starting at index as a float.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   699
     The 4 bytes are assumed to be in IEE floating point single precision
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   700
     number format."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   701
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   702
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   703
     currently, we assume that the machines native number format is already
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   704
     IEE format - we need some more code here whenever ST/X is ported
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   705
     to an IBM 370 or old VAX etc.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   706
     To date, all supported systems use IEE float numbers, so there should be
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   707
     no problem.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   708
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   709
    ^ self floatAt:index
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   710
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   711
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   712
ieeFloatAt:index put:aFloat
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   713
    "store the value of the argument, aFloat into the receiver
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   714
     starting at index. Storage is in IEE floating point single precision format.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   715
     (i.e. 4 bytes are stored). Since ST/X floats are really doubles, the low-
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   716
     order 4 bytes of the precision is lost."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   717
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   718
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   719
     currently, we assume that the machines native number format is already
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   720
     IEE format - we need some more code here whenever ST/X is ported
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   721
     to an IBM 370 or old VAX etc.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   722
     To date, all supported systems use IEE float numbers, so there should be
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   723
     no problem.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   724
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   725
    ^ self floatAt:index put:aFloat
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   726
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   727
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   728
ieeDoubleAt:index
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   729
    "retrieve the 8 bytes starting at index as a float.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   730
     The 8 bytes are assumed to be in IEE floating point single precision
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   731
     number format."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   732
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   733
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   734
     currently, we assume that the machines native number format is already
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   735
     IEE format - we need some more code here whenever ST/X is ported
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   736
     to an IBM 370 or old VAX etc.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   737
     To date, all supported systems use IEE float numbers, so there should be
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   738
     no problem.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   739
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   740
    ^ self doubleAt:index
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   741
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   742
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   743
ieeDoubleAt:index put:aFloat
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   744
    "store the value of the argument, aFloat into the receiver
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   745
     starting at index. Storage is in IEE floating point double precision format.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   746
     (i.e. 8 bytes are stored)."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   747
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   748
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   749
     currently, we assume that the machines native number format is already
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   750
     IEE format - we need some more code here whenever ST/X is ported
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   751
     to an IBM 370 or old VAX etc.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   752
     To date, all supported systems use IEE float numbers, so there should be
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   753
     no problem.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   754
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   755
    ^ self doubleAt:index put:aFloat
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   756
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   757
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   758
!ByteArray methodsFor:'converting'!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   759
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   760
asByteArray
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   761
    "return the receiver as a byteArray"
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   762
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   763
    "could be an instance of a subclass..."
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   764
    self class == ByteArray ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   765
	^ self
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   766
    ].
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   767
    ^ super asByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   768
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   769
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   770
     'hello world' asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   771
     #(1 2 3 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   772
     #(1 2 256 4 5 6 7) asByteArray 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   773
    "
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   774
! !
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   775
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   776
!ByteArray methodsFor:'printing & storing'!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   777
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   778
isLiteral
37
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
   779
    "return true, if the receiver can be used as a literal
d9a302eaa3ef *** empty log message ***
claus
parents: 12
diff changeset
   780
     (i.e. can be used in constant arrays)"
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   781
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   782
    ^ true
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   783
!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   784
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   785
storeOn:aStream
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   786
    "append a printed representation from which the receiver can be
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   787
     reconstructed to aStream. (reimplemented to make it look better)"
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   788
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   789
    |first|
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   790
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   791
    self class == ByteArray ifTrue:[
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   792
	aStream nextPutAll:'#['.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   793
	first := true.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   794
	self do:[:byte | 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   795
	    first ifFalse:[aStream space]
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   796
		  ifTrue:[first := false].
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   797
	    byte storeOn:aStream.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   798
	].
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   799
	aStream nextPutAll:']'.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   800
	^ self
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   801
    ].
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   802
    ^ super storeOn:aStream
68
59faa75185ba *** empty log message ***
claus
parents: 54
diff changeset
   803
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   804
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   805
     #[1 2 3 4 5] storeOn:Transcript
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   806
    "
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   807
! !
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   808
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   809
!ByteArray methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   810
a27a279701f8 Initial revision
claus
parents:
diff changeset
   811
indexOf:aByte startingAt:start
a27a279701f8 Initial revision
claus
parents:
diff changeset
   812
    "return the index of the first occurrence of the argument, aByte
a27a279701f8 Initial revision
claus
parents:
diff changeset
   813
     in the receiver starting at start, anInteger; return 0 if not found.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   814
     - reimplemented here for speed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   815
a27a279701f8 Initial revision
claus
parents:
diff changeset
   816
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   817
a27a279701f8 Initial revision
claus
parents:
diff changeset
   818
    REGISTER unsigned char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   819
    REGISTER int index, byteValue;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   820
    REGISTER int len;
249
claus
parents: 221
diff changeset
   821
    OBJ cls;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   822
249
claus
parents: 221
diff changeset
   823
    if (! __isSmallInteger(aByte)) {
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   824
	/*
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   825
	 * searching for something which cannot be found
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   826
	 */
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   827
	RETURN ( _MKSMALLINT(0) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   828
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
a27a279701f8 Initial revision
claus
parents:
diff changeset
   830
    byteValue = _intVal(aByte);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   831
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   832
    if (byteValue & ~0xFF /* i.e. (byteValue < 0) || (byteValue > 255) */) {
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   833
	/*
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   834
	 * searching for something which cannot be found
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   835
	 */
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   836
	RETURN ( _MKSMALLINT(0) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   837
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   838
249
claus
parents: 221
diff changeset
   839
    if (__isSmallInteger(start)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   840
	index = _intVal(start);
249
claus
parents: 221
diff changeset
   841
	len = __byteArraySize(self);
claus
parents: 221
diff changeset
   842
	cp = _ByteArrayInstPtr(self)->ba_element;
claus
parents: 221
diff changeset
   843
	if ((cls = _qClass(self)) != ByteArray) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   844
	    int nInst;
2
claus
parents: 1
diff changeset
   845
249
claus
parents: 221
diff changeset
   846
	    nInst = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   847
	    cp += nInst;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   848
	    len -= nInst;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   849
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   850
	cp += index - 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   851
	while (index <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   852
	    if (*cp == byteValue) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   853
		RETURN ( _MKSMALLINT(index) );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   854
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   855
	    index++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   856
	    cp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   857
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   858
	RETURN ( _MKSMALLINT(0) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   859
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   860
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   861
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   862
    ^ super indexOf:aByte startingAt:start
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   863
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   864
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   865
     #[1 2 3 4 5 6 7 8 9 0 1 2 3 4 5] indexOf:0 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   866
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   867
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   868
a27a279701f8 Initial revision
claus
parents:
diff changeset
   869
usedValues
a27a279701f8 Initial revision
claus
parents:
diff changeset
   870
    "return a new ByteArray with all used values (actually a kind of Set);
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   871
     This is needed specially in the bitmap/Imageclasses to find used colors 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   872
     in an image."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   873
a27a279701f8 Initial revision
claus
parents:
diff changeset
   874
    |result l|
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   875
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   876
%{  /* STACK: 400 */
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   877
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   878
    REGISTER unsigned char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   879
    REGISTER int len;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   880
    unsigned char flags[256];
a27a279701f8 Initial revision
claus
parents:
diff changeset
   881
    static struct inlineCache nw = _ILC1;
213
3b56a17534fd *** empty log message ***
claus
parents: 166
diff changeset
   882
    extern OBJ ByteArray;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   883
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
    if (_qClass(self) == ByteArray) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   885
	memset(flags, 0, sizeof(flags));
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   886
	len = _qSize(self) - OHDR_SIZE;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   887
	cp = &(_ByteArrayInstPtr(self)->ba_element[0]);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   888
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   889
	/* for each used byte, set flag */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   890
	while (len > 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   891
	    flags[*cp] = 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   892
	    cp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   893
	    len--;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   894
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   895
	/* count 1's */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   896
	len = 0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   897
	for (cp=flags+255; cp >= flags; cp--)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   898
	    if (*cp) len++;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   899
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   900
	/* create ByteArray of used values */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   901
	result = (*nw.ilc_func)(ByteArray, 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   902
				@symbol(new:), 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   903
				CON_COMMA nil, &nw, 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   904
				_MKSMALLINT(len));
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   905
	if (_Class(result) == ByteArray) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   906
	    cp = &(_ByteArrayInstPtr(result)->ba_element[0]);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   907
	    for (len=0; len < 256; len++) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   908
		if (flags[len]) 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   909
		    *cp++ = len;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   910
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   911
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   912
	RETURN ( result );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   913
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   915
.
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   916
    ^ self asSet
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   917
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   918
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   919
     #[1 2 3 1 2 3 1 2 3 1 2 3 4 5 6 4 5 6] usedValues 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   920
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   921
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   922
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   923
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   924
usageCounts
a27a279701f8 Initial revision
claus
parents:
diff changeset
   925
    "return an array filled with value-counts -
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   926
     This is needed in the bitmap/image classes to get info on color usage.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   927
     (i.e. to build up a histogram of color usage within an image)."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   928
a27a279701f8 Initial revision
claus
parents:
diff changeset
   929
    |counts|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   930
a27a279701f8 Initial revision
claus
parents:
diff changeset
   931
    counts := Array new:256.
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   932
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   933
%{  /* STACK: 2000 */
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
   934
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   935
    REGISTER unsigned char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   936
    REGISTER int nByte;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   937
    REGISTER int index;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   938
    int icounts[256];
a27a279701f8 Initial revision
claus
parents:
diff changeset
   939
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
   940
    if ((_qClass(self) == ByteArray) && __isArray(counts)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   941
	/*
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   942
	 * zero counts
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   943
	 */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   944
	for (index=0; index<256; index++) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   945
	    icounts[index] = 0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   946
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   947
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   948
	/*
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   949
	 * count
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   950
	 */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   951
	nByte = _qSize(self) - OHDR_SIZE;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   952
	cp = &(_ByteArrayInstPtr(self)->ba_element[0]);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   953
	while (nByte--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   954
	    icounts[*cp++]++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   955
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   956
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   957
	/*
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   958
	 * make it real counts
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   959
	 */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   960
	for (index=0; index<256; index++) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   961
	    _ArrayInstPtr(counts)->a_element[index] = _MKSMALLINT(icounts[index]);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   962
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   963
	RETURN ( counts );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   964
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
   965
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   966
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   967
    self primitiveFailed
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   968
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   969
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   970
     #[1 2 3 1 2 3 1 2 250 251 250 251 255] usageCounts 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   971
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   972
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   973
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   974
max
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   975
    "return the maximum value in the receiver -
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   976
     redefined to speedup image processing and sound-player 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   977
     (which need a fast method for this on byteArrays)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   978
a27a279701f8 Initial revision
claus
parents:
diff changeset
   979
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   980
a27a279701f8 Initial revision
claus
parents:
diff changeset
   981
    REGISTER unsigned char *cp;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   982
    REGISTER int index, max;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   983
    int len;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   984
a27a279701f8 Initial revision
claus
parents:
diff changeset
   985
    if (_qClass(self) == ByteArray) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   986
	max = 0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   987
	index = 0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   988
	len = _qSize(self) - OHDR_SIZE;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   989
	cp = &(_ByteArrayInstPtr(self)->ba_element[0]);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   990
	while (++index <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   991
	    if (*cp > max) max = *cp;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   992
	    cp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   993
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   994
	RETURN ( _MKSMALLINT(max) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   995
    }
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   996
%}.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
   997
    ^ super max
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   998
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
   999
    "
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1000
     #[1 2 3 1 2 3 1 2 19] max 
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1001
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1002
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1003
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1004
!ByteArray methodsFor:'copying'!
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1005
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1006
copyFrom:start to:stop
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1007
    "return the subcollection starting at index start, anInteger and ending
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1008
     at stop, anInteger.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1009
     - reimplemented here for speed"
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1010
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1011
%{  /* NOCONTEXT */
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1012
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1013
#if !defined(FAST_MEMCPY)
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1014
    REGISTER unsigned char *srcp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1015
#endif
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1016
    REGISTER unsigned char *dstp;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1017
    REGISTER int count;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1018
    int len, index1, index2, sz;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1019
    OBJ newByteArray;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1020
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1021
    if (__isByteArray(self)
249
claus
parents: 221
diff changeset
  1022
     && __bothSmallInteger(start, stop)) {
claus
parents: 221
diff changeset
  1023
	len = __byteArraySize(self);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1024
	index1 = _intVal(start);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1025
	index2 = _intVal(stop);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1026
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1027
	if ((index1 <= index2) && (index1 > 0)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1028
	    if (index2 <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1029
		count = index2 - index1 + 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1030
		PROTECT_CONTEXT
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1031
		sz = OHDR_SIZE + count;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1032
		_qNew(newByteArray, sz, SENDER);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1033
		UNPROTECT_CONTEXT
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1034
		if (newByteArray != nil) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1035
		    _InstPtr(newByteArray)->o_class = ByteArray;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1036
		    dstp = _ByteArrayInstPtr(newByteArray)->ba_element;
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1037
#ifdef FAST_MEMCPY
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1038
		    bcopy(_ByteArrayInstPtr(self)->ba_element + index1 - 1, dstp, count);
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1039
#else
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1040
		    srcp = _ByteArrayInstPtr(self)->ba_element + index1 - 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1041
		    while (count--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1042
			*dstp++ = *srcp++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1043
		    }
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1044
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1045
		    RETURN ( newByteArray );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1046
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1047
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1048
	}
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1049
    }
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1050
%}.
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1051
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1052
     fall back in case of non-integer index or out-of-bound index;
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1053
     will eventually lead to an out-of-bound signal raise
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1054
    "
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1055
    ^ super copyFrom:start to:stop
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1056
! !
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
  1057
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1058
!ByteArray methodsFor:'filling and replacing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1059
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1060
from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1061
    "fill part of the receiver with aNumber.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1062
     - reimplemented here for speed"
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1063
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1064
%{  /* NOCONTEXT */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1065
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1066
    REGISTER unsigned char *dstp;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1067
    REGISTER int count, value;
249
claus
parents: 221
diff changeset
  1068
    int len, index1, index2;
claus
parents: 221
diff changeset
  1069
    int nInst;
claus
parents: 221
diff changeset
  1070
    OBJ cls;
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1071
249
claus
parents: 221
diff changeset
  1072
    if (__isSmallInteger(aNumber)
claus
parents: 221
diff changeset
  1073
     && __bothSmallInteger(start, stop)) {
claus
parents: 221
diff changeset
  1074
	len = __byteArraySize(self);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1075
	index1 = _intVal(start);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1076
	index2 = _intVal(stop);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1077
249
claus
parents: 221
diff changeset
  1078
	dstp = _ByteArrayInstPtr(self)->ba_element + index1 - 1;
claus
parents: 221
diff changeset
  1079
	if ((cls = _qClass(self)) != ByteArray) {
claus
parents: 221
diff changeset
  1080
	    nInst = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
  1081
	    dstp += nInst;
claus
parents: 221
diff changeset
  1082
	    len -= nInst;
claus
parents: 221
diff changeset
  1083
	}
claus
parents: 221
diff changeset
  1084
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1085
	value = _intVal(aNumber);
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1086
	if ((value >= 0) && (value <= 255)
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1087
	 && (index1 <= index2) 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1088
	 && (index1 > 0)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1089
	    if (index2 <= len) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1090
		count = index2 - index1 + 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1091
#ifdef FAST_MEMSET
249
claus
parents: 221
diff changeset
  1092
		memset(dstp, count, value);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1093
#else
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1094
		while (count--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1095
		    *dstp++ = value;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1096
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1097
#endif
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1098
		RETURN (self);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1099
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1100
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1101
    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1102
%}.
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1103
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1104
     fall back in case of non-integer index or out-of-bound index/value;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1105
     will eventually lead to an out-of-bound signal raise
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1106
    "
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1107
    ^ super from:start to:stop put:aNumber
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1108
!
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1109
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1110
replaceFrom:start to:stop with:aCollection startingAt:repStart
249
claus
parents: 221
diff changeset
  1111
    "replace elements from another collection"
claus
parents: 221
diff changeset
  1112
claus
parents: 221
diff changeset
  1113
    (aCollection class == self class) ifTrue:[
claus
parents: 221
diff changeset
  1114
	^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
claus
parents: 221
diff changeset
  1115
    ].
claus
parents: 221
diff changeset
  1116
    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
claus
parents: 221
diff changeset
  1117
!
claus
parents: 221
diff changeset
  1118
claus
parents: 221
diff changeset
  1119
replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
claus
parents: 221
diff changeset
  1120
    "replace elements from another collection, which must be a ByteArray
claus
parents: 221
diff changeset
  1121
     or String."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1122
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1123
%{  /* NOCONTEXT */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1124
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1125
    int nIndex, repNIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1126
    int startIndex, stopIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1127
    REGISTER unsigned char *src;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1128
    REGISTER int repStartIndex;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1129
    int repStopIndex, count;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1130
    REGISTER unsigned char *dst;
249
claus
parents: 221
diff changeset
  1131
    OBJ cls;
claus
parents: 221
diff changeset
  1132
    int nInst;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1133
249
claus
parents: 221
diff changeset
  1134
    if (__isBytes(aCollection)
claus
parents: 221
diff changeset
  1135
     && __bothSmallInteger(start, stop)
claus
parents: 221
diff changeset
  1136
     && __isSmallInteger(repStart)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1137
	startIndex = _intVal(start) - 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1138
	if (startIndex >= 0) {
249
claus
parents: 221
diff changeset
  1139
	  dst = (_ByteArrayInstPtr(self)->ba_element) + startIndex;
claus
parents: 221
diff changeset
  1140
	  nIndex = __byteArraySize(self);
claus
parents: 221
diff changeset
  1141
claus
parents: 221
diff changeset
  1142
	  if ((cls = _qClass(self)) != ByteArray) {
claus
parents: 221
diff changeset
  1143
	    nInst = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
  1144
	    dst += nInst;
claus
parents: 221
diff changeset
  1145
	    nIndex -= nInst;
claus
parents: 221
diff changeset
  1146
	  }
claus
parents: 221
diff changeset
  1147
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1148
	  stopIndex = _intVal(stop) - 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1149
	  count = stopIndex - startIndex + 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1150
	  if (count == 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1151
	      RETURN ( self );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1152
	  }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1153
	  if ((count > 0) && (stopIndex < nIndex)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1154
	    repStartIndex = _intVal(repStart) - 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1155
	    if (repStartIndex >= 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1156
	      repNIndex = _qSize(aCollection) - OHDR_SIZE;
249
claus
parents: 221
diff changeset
  1157
	      src = (_ByteArrayInstPtr(aCollection)->ba_element) + repStartIndex;
claus
parents: 221
diff changeset
  1158
	      if ((cls = _qClass(aCollection)) != ByteArray) {
claus
parents: 221
diff changeset
  1159
		nInst = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
  1160
		src += nInst;
claus
parents: 221
diff changeset
  1161
		repNIndex -= nInst;
claus
parents: 221
diff changeset
  1162
	      }
claus
parents: 221
diff changeset
  1163
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1164
	      repStopIndex = repStartIndex + (stopIndex - startIndex);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1165
	      if (repStopIndex < repNIndex) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1166
		if (aCollection == self) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1167
		    /* take care of overlapping copy */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1168
		    if (src < dst) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1169
			/* must do a reverse copy */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1170
			src += count;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1171
			dst += count;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1172
			while (count-- > 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1173
			    *--dst = *--src;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1174
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1175
			RETURN ( self );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1176
		    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1177
		}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1178
#ifdef FAST_MEMCPY
166
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1179
# ifdef bcopy4
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1180
		if (((src & 3) == 0)
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1181
		 && ((dst & 3) == 0)) {
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1182
		    /* copy aligned part */
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1183
		    bcopy4(src, dst, count//4);
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1184
		    /* copy rest */
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1185
		    if (count & 3) {
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1186
			src += (count & ~3);
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1187
			dst += (count & ~3);
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1188
			count = count & 3;
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1189
			while (count--) {
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1190
			    *dst++ = *src++;
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1191
			}
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1192
		    }
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1193
		} else
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1194
# endif /* bcopy4 */
52d5a0cba559 use bcopy4 if defined
claus
parents: 155
diff changeset
  1195
		    bcopy(src, dst, count);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1196
#else
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1197
		while (count-- > 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1198
		    *dst++ = *src++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1199
		}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1200
#endif
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1201
		RETURN ( self );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1202
	      }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1203
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1204
	  }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1205
	}
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1206
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1207
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1208
.
249
claus
parents: 221
diff changeset
  1209
    ^ super replaceBytesFrom:start to:stop with:aCollection startingAt:repStart
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1210
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1211
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1212
!ByteArray methodsFor:'image manipulation support'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1213
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1214
invert
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1215
    "invert all bytes - used with image manipulations
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1216
     written as a primitive for speed.
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1217
     Q: is this really needed ?"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1218
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1219
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1220
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1221
    REGISTER unsigned char *dst;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1222
    REGISTER unsigned long *ldst;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1223
    REGISTER int cnt;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1224
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1225
    if (_qClass(self) == ByteArray) {
249
claus
parents: 221
diff changeset
  1226
	cnt = __byteArraySize(self);
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1227
	dst = _ByteArrayInstPtr(self)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1228
	if (! ((int)dst & (sizeof(long)-1))) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1229
	    ldst = (unsigned long *)dst;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1230
	    while (cnt >= sizeof(long)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1231
		*ldst = ~(*ldst);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1232
		ldst++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1233
		cnt -= sizeof(long);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1234
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1235
	    dst = (unsigned char *)ldst;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1236
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1237
	while (cnt--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1238
	    *dst = ~(*dst);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1239
	    dst++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1240
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1241
	RETURN ( self );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1242
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1243
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1244
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1245
    self primitiveFailed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1246
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1247
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1248
reverse
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1249
    "reverse order of elements inplace - 
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1250
     written as a primitive for speed on image manipulations (mirror)"
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1251
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1252
%{  /* NOCONTEXT */
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1253
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1254
    REGISTER unsigned char *p1, *p2;
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1255
    REGISTER int cnt;
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1256
    REGISTER unsigned t;
249
claus
parents: 221
diff changeset
  1257
    OBJ cls;
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1258
249
claus
parents: 221
diff changeset
  1259
    cnt = __byteArraySize(self);
claus
parents: 221
diff changeset
  1260
    p1 = _ByteArrayInstPtr(self)->ba_element;
claus
parents: 221
diff changeset
  1261
    if ((cls = _qClass(self)) != ByteArray) {
claus
parents: 221
diff changeset
  1262
	t = __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
claus
parents: 221
diff changeset
  1263
	p1 += t;
claus
parents: 221
diff changeset
  1264
	cnt -= t;
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1265
    }
249
claus
parents: 221
diff changeset
  1266
    p2 = p1 + cnt - 1;
claus
parents: 221
diff changeset
  1267
    while (cnt > 0) {
claus
parents: 221
diff changeset
  1268
	t = *p1;
claus
parents: 221
diff changeset
  1269
	*p1++ = *p2;
claus
parents: 221
diff changeset
  1270
	*p2-- = t;
claus
parents: 221
diff changeset
  1271
	cnt-=2;
claus
parents: 221
diff changeset
  1272
    }
claus
parents: 221
diff changeset
  1273
    RETURN ( self );
12
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1274
%}
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1275
!
8e03bd717355 *** empty log message ***
claus
parents: 10
diff changeset
  1276
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
expandPixels:nBitsPerPixel width:width height:height into:aByteArray
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1278
			 mapping:aMapByteArray
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1279
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1280
    "given the receiver with nBitsPerPixel-depth pixels, expand them into
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1281
     aByteArray with 8-bit pixels. The width/height-arguments are needed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1282
     to skip any padded src-bits. On the fly, the destination pixels
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1283
     are translated using aMapByteArray (if non-nil).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1284
     Input bits are read left-to right, i.e. the first byte in the output
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1285
     corresponds to the high bit(s) in the inputs first byte.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1286
     This is used to display mono, 2-bit and 4-bit bitmaps on grey-scale/color
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1287
     machines. With nBitsPerPixel==8, this is a translate operation.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1288
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1289
     value of n is found in map at:(n + 1).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1290
     It can also be used to expand bit-arrays into byteArrays.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1291
     This method is specialized for ByteArray arguments - it will not handle
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1292
     anything else."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1293
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1294
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1295
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1296
    REGISTER unsigned char *src, *dst;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1297
    REGISTER int wrun;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1298
    unsigned char *srcNext;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1299
    int bytesPerRow, mask, shift0, shift;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1300
    int w, h, hrun;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1301
    int srcBytes, dstBytes;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1302
    int bitsPerPixel;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1303
    int bits;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1304
    int ncells;
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1305
    unsigned char *map;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1306
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1307
    if ((_qClass(self) == ByteArray) 
06dbdeeed4f9 *** empty log message ***
claus
parents: 37
diff changeset
  1308
     && (_qClass(aByteArray) == ByteArray)
249
claus
parents: 221
diff changeset
  1309
     && __isSmallInteger(nBitsPerPixel)
claus
parents: 221
diff changeset
  1310
     && __bothSmallInteger(height, width)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1311
	if ((aMapByteArray != nil)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1312
	 && (_Class(aMapByteArray) == ByteArray)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1313
	    map = _ByteArrayInstPtr(aMapByteArray)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1314
	} else {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1315
	    map = (unsigned char *)0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1316
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1317
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1318
	bitsPerPixel = _intVal(nBitsPerPixel);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1319
	w = _intVal(width);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1320
	h = _intVal(height);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1321
	src = _ByteArrayInstPtr(self)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1322
	dst = _ByteArrayInstPtr(aByteArray)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1323
	switch (bitsPerPixel) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1324
	    case 1:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1325
		mask = 0x01;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1326
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1327
	    case 2:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1328
		mask = 0x03;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1329
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1330
	    case 4:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1331
		mask = 0x0F;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1332
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1333
	    case 8:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1334
		mask = 0xFF;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1335
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1336
	    default:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1337
		goto fail;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1338
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1339
	ncells = mask + 1;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1340
	if (map) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1341
	    /*
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1342
	     * if a map is present, it must have the correct size
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1343
	     * (i.e. 2 raisedTo:nBitsPerPixel)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1344
	     */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1345
	    if ((_qSize(aMapByteArray) - OHDR_SIZE) < ncells)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1346
		goto fail;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1347
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1348
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1349
	bytesPerRow = (w * bitsPerPixel + 7) / 8;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1350
	shift0 = 8 - bitsPerPixel;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1351
	srcBytes = bytesPerRow * h;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1352
	dstBytes = w * h;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1353
249
claus
parents: 221
diff changeset
  1354
	if ((__byteArraySize(self) >= srcBytes)
claus
parents: 221
diff changeset
  1355
	 && (__byteArraySize(aByteArray) >= dstBytes)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1356
	    for (hrun=h; hrun; hrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1357
		srcNext = src + bytesPerRow;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1358
		shift = shift0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1359
		if (map) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1360
		    for (wrun=w; wrun; wrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1361
			if (shift == shift0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1362
			    bits = *src++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1363
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1364
			*dst++ = map[(bits >> shift) & mask];
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1365
			shift -= bitsPerPixel;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1366
			if (shift < 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1367
			    shift = shift0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1368
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1369
		    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1370
		} else {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1371
		    for (wrun=w; wrun; wrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1372
			if (shift == shift0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1373
			    bits = *src++;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1374
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1375
			*dst++ = (bits >> shift) & mask;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1376
			shift -= bitsPerPixel;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1377
			if (shift < 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1378
			    shift = shift0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1379
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1380
		    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1381
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1382
		src = srcNext;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1383
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1384
	    RETURN ( self );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1385
	}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1386
    }
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1387
fail: ;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1388
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1389
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1390
    self primitiveFailed
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1391
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1392
    "Example1:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1393
     expand 1-bit-per-pixel bitmap into a 1byte-per-pixel byteArray
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1394
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1395
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1396
     |inBits outBits|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1397
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1398
     inBits := #[2r11110000 
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1399
		 2r11001100 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1400
		 2r01010101 
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1401
		 2r00001111].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1402
     outBits := ByteArray new:(8*4).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1403
     inBits expandPixels:1 width:8 height:4
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1404
		    into:outBits mapping:nil.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1405
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1406
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1407
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1408
    "Example2:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1409
     expand bit-array into a byteArray, translating 0-bits to 99,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1410
     1-bits to 176. (just a stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1411
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1412
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1413
     |inBits outBits|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1414
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1415
     inBits := #[2r11110000 2r11001100].
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1416
     outBits := ByteArray new:16.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1417
     inBits expandPixels:1 width:16 height:1 
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1418
		    into:outBits mapping:#[99 176].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1419
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1420
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1421
!
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1422
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1423
compressPixels:nBitsPerPixel width:width height:height into:aByteArray
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1424
			 mapping:aMapByteArray
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1425
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1426
    "given the receiver with 8-bit pixels, compress them into aByteArray
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1427
     with nBitsPerPixel-depth pixels. The width/height-arguments are needed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1428
     to allow for any padding. On the fly, the source bytes are translated
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1429
     using aMapByteArray (if non-nil).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1430
     Notice that smalltalk indexing begins at 1; thus the map-index for a byte
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1431
     value of n is found in map at:(n + 1).
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1432
     Output bits are filled left-to right, i.e. the first byte in the input
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1433
     corresponds to the high bit(s) if the first byte in the input.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1434
     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
  1435
     bitmaps.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1436
     It can also be used to compress byte-arrays into bitArrays."
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1437
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1438
%{  /* NOCONTEXT */
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1439
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1440
    REGISTER unsigned char *src, *dst;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1441
    REGISTER int wrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1442
    unsigned char *dstNext;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1443
    int bytesPerRow, mask, shift0, shift;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1444
    int w, h, hrun;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1445
    int srcBytes, dstBytes;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1446
    int bitsPerPixel;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1447
    int bits;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1448
    int ncells;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1449
    unsigned char *map;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1450
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1451
    if ((_qClass(self) == ByteArray) 
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1452
     && (_qClass(aByteArray) == ByteArray)
249
claus
parents: 221
diff changeset
  1453
     && __isSmallInteger(nBitsPerPixel)
claus
parents: 221
diff changeset
  1454
     && __bothSmallInteger(height, width)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1455
	if ((aMapByteArray != nil)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1456
	 && (_Class(aMapByteArray) == ByteArray)) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1457
	    map = _ByteArrayInstPtr(aMapByteArray)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1458
	} else {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1459
	    map = (unsigned char *)0;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1460
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1461
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1462
	bitsPerPixel = _intVal(nBitsPerPixel);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1463
	w = _intVal(width);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1464
	h = _intVal(height);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1465
	src = _ByteArrayInstPtr(self)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1466
	dst = _ByteArrayInstPtr(aByteArray)->ba_element;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1467
	switch (bitsPerPixel) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1468
	    case 1:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1469
		mask = 0x01;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1470
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1471
	    case 2:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1472
		mask = 0x03;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1473
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1474
	    case 4:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1475
		mask = 0x0F;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1476
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1477
	    case 8:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1478
		mask = 0xFF;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1479
		break;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1480
	    default:
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1481
		goto fail;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1482
	}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1483
	if (map) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1484
	    /*
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1485
	     * if a map is present, it must have entries for
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1486
	     * all possible byte-values (i.e. its size must be >= 256)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1487
	     */
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1488
	    if ((_qSize(aMapByteArray) - OHDR_SIZE) < 256)
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1489
		goto fail;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1490
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1491
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1492
	bytesPerRow = (w * bitsPerPixel + 7) / 8;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1493
	dstBytes = bytesPerRow * h;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1494
	srcBytes = w * h;
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1495
249
claus
parents: 221
diff changeset
  1496
	if ((__byteArraySize(self) >= srcBytes)
claus
parents: 221
diff changeset
  1497
	 && (__byteArraySize(aByteArray) >= dstBytes)) {
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1498
	    for (hrun=h; hrun; hrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1499
		dstNext = dst + bytesPerRow;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1500
		bits = 0; shift = 8;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1501
		if (map) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1502
		    for (wrun=w; wrun; wrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1503
			bits = (bits << bitsPerPixel) | (map[*src++] & mask);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1504
			shift -= bitsPerPixel;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1505
			if (shift == 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1506
			    *dst++ = bits;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1507
			    bits = 0; shift = 8;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1508
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1509
		    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1510
		} else {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1511
		    for (wrun=w; wrun; wrun--) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1512
			bits = (bits << bitsPerPixel) | (*src++ & mask);
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1513
			shift -= bitsPerPixel;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1514
			if (shift == 0) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1515
			    *dst++ = bits;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1516
			    bits = 0; shift = 8;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1517
			}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1518
		    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1519
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1520
		if (shift != 8) {
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1521
		    *dst = bits;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1522
		}
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1523
		dst = dstNext;
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1524
	    }
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1525
	    RETURN ( self );
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1526
	}
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1527
    }
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1528
fail: ;
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1529
%}
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1530
.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1531
    self primitiveFailed
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1532
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1533
    "Example1:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1534
     compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1535
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1536
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1537
     |inBits outBits|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1538
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1539
     inBits := #[0 0 0 0 1 1 1 1
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1540
		 0 0 1 1 0 0 1 1
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1541
		 0 1 0 1 0 1 0 1
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1542
		 1 1 1 1 0 0 0 0].
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1543
     outBits := ByteArray new:4.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1544
     inBits compressPixels:1 width:8 height:4
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1545
		    into:outBits mapping:nil.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1546
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1547
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1548
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1549
    "Example2:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1550
     compress byte-array into a bitArray, translating 99 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1551
     and 176 to 1-bits. (just a stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1552
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1553
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1554
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1555
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1556
     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
  1557
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1558
     map at:176+1 put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1559
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1560
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1561
     inBits compressPixels:1 width:16 height:1 
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1562
		    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1563
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1564
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1565
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1566
    "Example3:
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1567
     compress byte-array into a bitArray, translating everything below 128 to 0-bits,
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1568
     and 128 to 255 to 1-bits.99 to 0-bits (another stupid example)
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1569
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1570
    "
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1571
     |inBits outBits map|
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1572
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1573
     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
  1574
     map := ByteArray new:256.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1575
     map atAll:(128+1 to:255+1) put:1.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1576
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1577
     outBits := ByteArray new:2.
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1578
     inBits compressPixels:1 width:16 height:1 
155
edd7fc34e104 *** empty log message ***
claus
parents: 148
diff changeset
  1579
		    into:outBits mapping:map.
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1580
     outBits inspect
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1581
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1582
! !
129
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1583
e451571780b7 added compressPixels;
claus
parents: 92
diff changeset
  1584