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