40 It allows the definition of subclasses of ByteArray, which transparently fetch |
52 It allows the definition of subclasses of ByteArray, which transparently fetch |
41 and store C-structure fields. |
53 and store C-structure fields. |
42 " |
54 " |
43 ! |
55 ! |
44 |
56 |
45 copyright |
|
46 " |
|
47 COPYRIGHT (c) 1989 by Claus Gittinger |
|
48 All Rights Reserved |
|
49 |
|
50 This software is furnished under a license and may be used |
|
51 only in accordance with the terms of that license and with the |
|
52 inclusion of the above copyright notice. This software may not |
|
53 be provided or otherwise made available to, or used by, any |
|
54 other person. No title to or ownership of the software is |
|
55 hereby transferred. |
|
56 " |
|
57 ! |
|
58 |
|
59 version |
57 version |
60 ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.37 1995-11-15 03:06:32 cg Exp $' |
58 ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.38 1995-11-15 17:08:15 cg Exp $' |
61 ! ! |
59 ! ! |
62 |
60 |
63 !ByteArray class methodsFor:'instance creation'! |
61 !ByteArray class methodsFor:'instance creation'! |
|
62 |
|
63 fromPackedString:aString |
|
64 "ST-80 compatibility: decode a byteArray from a packed string in which |
|
65 6bits are encoded per character. The argument, aString must be a multiple |
|
66 of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like |
|
67 the radix-encoding used in good old PDP11 times ;-) |
|
68 ST-80 uses this encoding for Images ... |
|
69 PS: It took a while to figure that one out ... I dont like it ;-)" |
|
70 |
|
71 |index "{ Class: SmallInteger }" |
|
72 dstIndex "{ Class: SmallInteger }" |
|
73 stop "{ Class: SmallInteger }" |
|
74 n "{ Class: SmallInteger }" |
|
75 sz "{ Class: SmallInteger }" |
|
76 lastCharacter bytes| |
|
77 |
|
78 sz := aString size. |
|
79 sz == 0 ifTrue:[^ self new]. |
|
80 stop := sz // 4 * 3. |
|
81 "the size modulu 3 is encoded in the last character, if its in the |
|
82 range 97 .. otherwise, its exact." |
|
83 |
|
84 lastCharacter := aString last. |
|
85 lastCharacter asciiValue > 96 ifTrue:[ |
|
86 stop := stop - 3 + lastCharacter asciiValue - 96 |
|
87 ]. |
|
88 bytes := self new:stop. |
|
89 index := 1. dstIndex := 1. |
|
90 [dstIndex <= stop] whileTrue:[ |
|
91 "take 4 characters ..." |
|
92 n := (aString at:index) asciiValue - 32. |
|
93 n := (n bitShift:6) + ((aString at:index+1) asciiValue - 32). |
|
94 n := (n bitShift:6) + ((aString at:index+2) asciiValue - 32). |
|
95 n := (n bitShift:6) + ((aString at:index+3) asciiValue - 32). |
|
96 n := n bitXor:16r820820. |
|
97 index := index + 4. |
|
98 bytes at:dstIndex put:(n bitShift:-16). |
|
99 dstIndex < stop ifTrue:[ |
|
100 bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF). |
|
101 dstIndex+2 <= stop ifTrue:[ |
|
102 bytes at:dstIndex+2 put:(n bitAnd:16rFF). |
|
103 ] |
|
104 ]. |
|
105 dstIndex := dstIndex + 3. |
|
106 ]. |
|
107 ^ bytes |
|
108 |
|
109 " |
|
110 ByteArray fromPackedString:(#[1 1 1 1] asPackedString) |
|
111 ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString) |
|
112 ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString) |
|
113 ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString) |
|
114 ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString) |
|
115 |
|
116 " |
|
117 ! |
64 |
118 |
65 uninitializedNew:anInteger |
119 uninitializedNew:anInteger |
66 "return a new instance of the receiver with uninitialized |
120 "return a new instance of the receiver with uninitialized |
67 (i.e. undefined) contents. The indexed elements have any random |
121 (i.e. undefined) contents. The indexed elements have any random |
68 value. However, any named instance variables are still nilled. |
122 value. However, any named instance variables are still nilled. |
139 was not kind enough to give some. |
193 was not kind enough to give some. |
140 " |
194 " |
141 ^ ObjectMemory allocationFailureSignal raise. |
195 ^ ObjectMemory allocationFailureSignal raise. |
142 ]. |
196 ]. |
143 ^ self basicNew:anInteger |
197 ^ self basicNew:anInteger |
144 ! |
|
145 |
|
146 fromPackedString:aString |
|
147 "ST-80 compatibility: decode a byteArray from a packed string in which |
|
148 6bits are encoded per character. The argument, aString must be a multiple |
|
149 of 4 in size (since 24 is the lcm of 6 and 8). This is somewhat like |
|
150 the radix-encoding used in good old PDP11 times ;-) |
|
151 ST-80 uses this encoding for Images ... |
|
152 PS: It took a while to figure that one out ... I dont like it ;-)" |
|
153 |
|
154 |index "{ Class: SmallInteger }" |
|
155 dstIndex "{ Class: SmallInteger }" |
|
156 stop "{ Class: SmallInteger }" |
|
157 n "{ Class: SmallInteger }" |
|
158 sz "{ Class: SmallInteger }" |
|
159 lastCharacter bytes| |
|
160 |
|
161 sz := aString size. |
|
162 sz == 0 ifTrue:[^ self new]. |
|
163 stop := sz // 4 * 3. |
|
164 "the size modulu 3 is encoded in the last character, if its in the |
|
165 range 97 .. otherwise, its exact." |
|
166 |
|
167 lastCharacter := aString last. |
|
168 lastCharacter asciiValue > 96 ifTrue:[ |
|
169 stop := stop - 3 + lastCharacter asciiValue - 96 |
|
170 ]. |
|
171 bytes := self new:stop. |
|
172 index := 1. dstIndex := 1. |
|
173 [dstIndex <= stop] whileTrue:[ |
|
174 "take 4 characters ..." |
|
175 n := (aString at:index) asciiValue - 32. |
|
176 n := (n bitShift:6) + ((aString at:index+1) asciiValue - 32). |
|
177 n := (n bitShift:6) + ((aString at:index+2) asciiValue - 32). |
|
178 n := (n bitShift:6) + ((aString at:index+3) asciiValue - 32). |
|
179 n := n bitXor:16r820820. |
|
180 index := index + 4. |
|
181 bytes at:dstIndex put:(n bitShift:-16). |
|
182 dstIndex < stop ifTrue:[ |
|
183 bytes at:dstIndex+1 put:((n bitShift:-8) bitAnd:16rFF). |
|
184 dstIndex+2 <= stop ifTrue:[ |
|
185 bytes at:dstIndex+2 put:(n bitAnd:16rFF). |
|
186 ] |
|
187 ]. |
|
188 dstIndex := dstIndex + 3. |
|
189 ]. |
|
190 ^ bytes |
|
191 |
|
192 " |
|
193 ByteArray fromPackedString:(#[1 1 1 1] asPackedString) |
|
194 ByteArray fromPackedString:(#[1 1 1 1 1] asPackedString) |
|
195 ByteArray fromPackedString:(#[1 1 1 1 1 1] asPackedString) |
|
196 ByteArray fromPackedString:(#[1 1 1 1 1 1 1] asPackedString) |
|
197 ByteArray fromPackedString:(#[1 1 1 1 1 1 1 1] asPackedString) |
|
198 |
|
199 " |
|
200 ! ! |
198 ! ! |
201 |
199 |
202 !ByteArray class methodsFor:'binary storage'! |
200 !ByteArray class methodsFor:'binary storage'! |
203 |
201 |
204 binaryDefinitionFrom: stream manager: manager |
202 binaryDefinitionFrom: stream manager: manager |
336 %} |
334 %} |
337 . |
335 . |
338 ^ super basicAt:index put:value |
336 ^ super basicAt:index put:value |
339 ! |
337 ! |
340 |
338 |
341 wordAt:index |
339 doubleAt:index |
342 "return the 2-bytes starting at index as an (unsigned) Integer. |
340 "return the 8-bytes starting at index as a Float. |
343 The value is retrieved in the machines natural byte order |
341 Notice, that (currently) ST/X Floats are what Doubles are in ST-80. |
344 Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)" |
342 Notice also, that the bytes are expected to be in this machines |
345 |
343 float representation - if the bytearray originated from another |
346 %{ /* NOCONTEXT */ |
344 machine, some conversion is usually needed." |
347 |
345 |
348 REGISTER int indx; |
346 |newFloat| |
349 int nIndex; |
347 |
350 union { |
348 newFloat := Float basicNew. |
351 char u_char[2]; |
349 1 to:8 do:[:destIndex| |
352 unsigned short u_ushort; |
350 newFloat basicAt:destIndex put:(self at:index - 1 + destIndex) |
353 } val; |
351 ]. |
354 OBJ cls; |
352 ^ newFloat. |
355 |
353 ! |
356 if (__isSmallInteger(index)) { |
354 |
357 indx = _intVal(index); |
355 doubleAt:index put:aFloat |
358 if (indx > 0) { |
356 "store the value of the argument, aFloat into the receiver |
359 if ((cls = __qClass(self)) != ByteArray) |
357 starting at index. |
360 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
358 Notice, that (currently) ST/X Floats are what Doubles are in ST-80. |
361 nIndex = __byteArraySize(self); |
359 Notice also, that the bytes are expected to be in this machines |
362 if ((indx+1) <= nIndex) { |
360 float representation - if the bytearray originated from another |
363 val.u_char[0] = _ByteArrayInstPtr(self)->ba_element[indx-1]; |
361 machine, some conversion is usually needed." |
364 val.u_char[1] = _ByteArrayInstPtr(self)->ba_element[indx-1+1]; |
362 |
365 RETURN ( _MKSMALLINT(val.u_ushort) ); |
363 1 to:8 do:[:srcIndex| |
366 } |
364 self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) |
367 } |
365 ]. |
368 } |
366 ^ aFloat |
369 %}. |
|
370 ^ SubscriptOutOfBoundsSignal raise. |
|
371 ! |
|
372 |
|
373 wordAt:index MSB:msb |
|
374 "return the 2-bytes starting at index as an (unsigned) Integer. |
|
375 The value is retrieved MSB (high 8 bits at lower index) if msb is true; |
|
376 LSB-first (i.e. low 8-bits at lower byte index) if its false. |
|
377 Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)" |
|
378 |
|
379 %{ /* NOCONTEXT */ |
|
380 |
|
381 REGISTER int indx; |
|
382 int nIndex; |
|
383 int val; |
|
384 OBJ cls; |
|
385 |
|
386 if (__isSmallInteger(index)) { |
|
387 indx = _intVal(index); |
|
388 if (indx > 0) { |
|
389 if ((cls = __qClass(self)) != ByteArray) |
|
390 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
391 nIndex = __byteArraySize(self); |
|
392 if ((indx+1) <= nIndex) { |
|
393 if (msb == true) { |
|
394 val = _ByteArrayInstPtr(self)->ba_element[indx-1]; |
|
395 val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1+1]; |
|
396 } else { |
|
397 val = _ByteArrayInstPtr(self)->ba_element[indx+1-1]; |
|
398 val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1]; |
|
399 } |
|
400 RETURN ( _MKSMALLINT(val) ); |
|
401 } |
|
402 } |
|
403 } |
|
404 %}. |
|
405 ^ SubscriptOutOfBoundsSignal raise. |
|
406 ! |
|
407 |
|
408 wordAt:index put:value |
|
409 "set the 2-bytes starting at index from the (unsigned) Integer value. |
|
410 The stored value must be in the range 0 .. 16rFFFF. |
|
411 The value is stored in the machines natural byteorder. |
|
412 Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)" |
|
413 |
|
414 %{ /* NOCONTEXT */ |
|
415 |
|
416 REGISTER int indx; |
|
417 int nIndex; |
|
418 int v; |
|
419 union { |
|
420 char u_char[2]; |
|
421 unsigned short u_ushort; |
|
422 } val; |
|
423 OBJ cls; |
|
424 |
|
425 if (__bothSmallInteger(index, value)) { |
|
426 indx = _intVal(index); |
|
427 if (indx > 0) { |
|
428 if ((cls = __qClass(self)) != ByteArray) |
|
429 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
430 nIndex = __byteArraySize(self); |
|
431 if ((indx+1) <= nIndex) { |
|
432 val.u_ushort = v = _intVal(value); |
|
433 if ((v & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) { |
|
434 _ByteArrayInstPtr(self)->ba_element[indx-1] = val.u_char[0]; |
|
435 _ByteArrayInstPtr(self)->ba_element[indx-1+1] = val.u_char[1]; |
|
436 RETURN ( value ); |
|
437 } |
|
438 } |
|
439 } |
|
440 } |
|
441 %}. |
|
442 ((value < 0) or:[value > 16rFFFF]) ifTrue:[ |
|
443 ^ self elementBoundsError |
|
444 ]. |
|
445 ^ SubscriptOutOfBoundsSignal raise. |
|
446 |
|
447 " |
|
448 |b| |
|
449 b := ByteArray new:4. |
|
450 b wordAt:1 put:16r0102. |
|
451 b wordAt:3 put:16r0304. |
|
452 b inspect |
|
453 " |
|
454 ! |
|
455 |
|
456 wordAt:index put:value MSB:msb |
|
457 "set the 2-bytes starting at index from the (unsigned) Integer value. |
|
458 The stored value must be in the range 0 .. 16rFFFF. |
|
459 The value is stored LSB-first (i.e. the low 8bits are stored at the |
|
460 lower index) if msb is false, MSB-first otherwise. |
|
461 Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)" |
|
462 |
|
463 %{ /* NOCONTEXT */ |
|
464 |
|
465 REGISTER int indx; |
|
466 int nIndex; |
|
467 int val; |
|
468 OBJ cls; |
|
469 |
|
470 if (__bothSmallInteger(index, value)) { |
|
471 indx = _intVal(index); |
|
472 if (indx > 0) { |
|
473 if ((cls = __qClass(self)) != ByteArray) |
|
474 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
475 nIndex = __byteArraySize(self); |
|
476 if ((indx+1) <= nIndex) { |
|
477 val = _intVal(value); |
|
478 if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) { |
|
479 if (msb == true) { |
|
480 _ByteArrayInstPtr(self)->ba_element[indx-1+1] = val & 0xFF; |
|
481 _ByteArrayInstPtr(self)->ba_element[indx-1] = (val>>8) & 0xFF; |
|
482 } else { |
|
483 _ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF; |
|
484 _ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF; |
|
485 } |
|
486 RETURN ( value ); |
|
487 } |
|
488 } |
|
489 } |
|
490 } |
|
491 %}. |
|
492 ((value < 0) or:[value > 16rFFFF]) ifTrue:[ |
|
493 ^ self elementBoundsError |
|
494 ]. |
|
495 ^ SubscriptOutOfBoundsSignal raise. |
|
496 |
|
497 " |
|
498 |b| |
|
499 b := ByteArray new:8. |
|
500 b wordAt:1 put:16r0102 MSB:false. |
|
501 b wordAt:3 put:16r0304 MSB:false. |
|
502 b wordAt:5 put:16r0102 MSB:true. |
|
503 b wordAt:7 put:16r0304 MSB:true. |
|
504 b inspect |
|
505 " |
|
506 ! |
|
507 |
|
508 signedWordAt:index |
|
509 "return the 2-bytes starting at index as a signed Integer. |
|
510 The value is retrieved in the machines natural byte order." |
|
511 |
|
512 |w "{ Class: SmallInteger }"| |
|
513 |
|
514 w := self wordAt:index. |
|
515 (w > 16r7FFF) ifTrue:[ |
|
516 ^ w - 16r10000 |
|
517 ]. |
|
518 ^ w |
|
519 |
|
520 " |
|
521 |b| |
|
522 b := ByteArray new:2. |
|
523 b wordAt:1 put:16rFFFF. |
|
524 b signedWordAt:1 |
|
525 " |
|
526 ! |
|
527 |
|
528 signedWordAt:index MSB:msb |
|
529 "return the 2-bytes starting at index as a signed Integer. |
|
530 The value is retrieved MSB-first if the msb-arg is true, |
|
531 LSB-first otherwise" |
|
532 |
|
533 |w "{ Class: SmallInteger }"| |
|
534 |
|
535 w := self wordAt:index MSB:msb. |
|
536 (w > 16r7FFF) ifTrue:[ |
|
537 ^ w - 16r10000 |
|
538 ]. |
|
539 ^ w |
|
540 |
|
541 " |
|
542 |b| |
|
543 b := ByteArray new:2. |
|
544 b wordAt:1 put:16rFFFF. |
|
545 b signedWordAt:1 |
|
546 " |
|
547 ! |
|
548 |
|
549 signedWordAt:index put:value |
|
550 "set the 2-bytes starting at index from the signed Integer value. |
|
551 The stored value must be in the range -32768 .. +32676. |
|
552 The value is stored in the machines natural byteorder." |
|
553 |
|
554 |v| |
|
555 |
|
556 value > 0 ifTrue:[ |
|
557 v := value |
|
558 ] ifFalse:[ |
|
559 v := 16r10000 + value |
|
560 ]. |
|
561 self wordAt:index put:v. |
|
562 ^ value |
|
563 |
|
564 " |
|
565 |b| |
|
566 b := ByteArray new:4. |
|
567 b signedWordAt:1 put:-1. |
|
568 b signedWordAt:3 put:-2. |
|
569 b inspect |
|
570 " |
|
571 ! |
|
572 |
|
573 signedWordAt:index put:value MSB:msb |
|
574 "set the 2-bytes starting at index from the signed Integer value. |
|
575 The stored value must be in the range -32768 .. +32676. |
|
576 The value is stored MSB-first, if the msb-arg is true; |
|
577 LSB-first otherwise" |
|
578 |
|
579 |v| |
|
580 |
|
581 value > 0 ifTrue:[ |
|
582 v := value |
|
583 ] ifFalse:[ |
|
584 v := 16r10000 + value |
|
585 ]. |
|
586 self wordAt:index put:v MSB:msb. |
|
587 ^ value |
|
588 |
|
589 " |
|
590 |b| |
|
591 b := ByteArray new:4. |
|
592 b signedWordAt:1 put:-1. |
|
593 b signedWordAt:3 put:-2. |
|
594 b inspect |
|
595 " |
|
596 ! |
367 ! |
597 |
368 |
598 doubleWordAt:index |
369 doubleWordAt:index |
599 "return the 4-bytes starting at index as an (unsigned) Integer. |
370 "return the 4-bytes starting at index as an (unsigned) Integer. |
600 The value is retrieved in the machines natural byte order. |
371 The value is retrieved in the machines natural byte order. |
802 b doubleWordAt:5 put:16r04030201 MSB:false. |
573 b doubleWordAt:5 put:16r04030201 MSB:false. |
803 b inspect |
574 b inspect |
804 " |
575 " |
805 ! |
576 ! |
806 |
577 |
|
578 floatAt:index |
|
579 "return the 4-bytes starting at index as a Float. |
|
580 Notice, that (currently) ST/X Floats are what Doubles are in ST-80; |
|
581 therefore this method reads a 4-byte float from the byteArray and returns |
|
582 a float object which keeps an 8-byte double internally. |
|
583 Notice also, that the bytes are expected to be in this machines |
|
584 float representation and order - if the bytearray originated from another |
|
585 machine, some conversion is usually needed." |
|
586 |
|
587 |newFloat| |
|
588 |
|
589 newFloat := Float basicNew. |
|
590 UninterpretedBytes isBigEndian ifFalse:[ |
|
591 5 to:8 do:[:destIndex| |
|
592 newFloat basicAt:destIndex put:(self at:index - 5 + destIndex) |
|
593 ]. |
|
594 ] ifTrue:[ |
|
595 1 to:4 do:[:destIndex| |
|
596 newFloat basicAt:destIndex put:(self at:index - 1 + destIndex) |
|
597 ]. |
|
598 ]. |
|
599 ^ newFloat. |
|
600 ! |
|
601 |
|
602 floatAt:index put:aFloat |
|
603 "store the 4 bytes of value of the argument, aFloat into the receiver |
|
604 starting at index. |
|
605 Notice, that (currently) ST/X Floats are what DOubles are in ST-80. |
|
606 Notice also, that the bytes are expected to be in this machines |
|
607 float representation - if the bytearray originated from another |
|
608 machine, some conversion is usually needed." |
|
609 |
|
610 UninterpretedBytes isBigEndian ifFalse:[ |
|
611 5 to:8 do:[:srcIndex| |
|
612 self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex) |
|
613 ]. |
|
614 ] ifTrue:[ |
|
615 1 to:4 do:[:srcIndex| |
|
616 self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) |
|
617 ]. |
|
618 ]. |
|
619 ^ aFloat |
|
620 ! |
|
621 |
|
622 ieeDoubleAt:index |
|
623 "retrieve the 8 bytes starting at index as a float. |
|
624 The 8 bytes are assumed to be in IEE floating point single precision |
|
625 number format." |
|
626 |
|
627 " |
|
628 currently, we assume that the machines native number format is already |
|
629 IEE format - we need some more code here whenever ST/X is ported |
|
630 to an IBM 370 or old VAX etc. |
|
631 To date, all supported systems use IEE float numbers, so there should be |
|
632 no problem. |
|
633 " |
|
634 ^ self doubleAt:index |
|
635 ! |
|
636 |
|
637 ieeDoubleAt:index put:aFloat |
|
638 "store the value of the argument, aFloat into the receiver |
|
639 starting at index. Storage is in IEE floating point double precision format. |
|
640 (i.e. 8 bytes are stored)." |
|
641 |
|
642 " |
|
643 currently, we assume that the machines native number format is already |
|
644 IEE format - we need some more code here whenever ST/X is ported |
|
645 to an IBM 370 or old VAX etc. |
|
646 To date, all supported systems use IEE float numbers, so there should be |
|
647 no problem. |
|
648 " |
|
649 ^ self doubleAt:index put:aFloat |
|
650 ! |
|
651 |
|
652 ieeFloatAt:index |
|
653 "retrieve the 4 bytes starting at index as a float. |
|
654 The 4 bytes are assumed to be in IEE floating point single precision |
|
655 number format." |
|
656 |
|
657 " |
|
658 currently, we assume that the machines native number format is already |
|
659 IEE format - we need some more code here whenever ST/X is ported |
|
660 to an IBM 370 or old VAX etc. |
|
661 To date, all supported systems use IEE float numbers, so there should be |
|
662 no problem. |
|
663 " |
|
664 ^ self floatAt:index |
|
665 ! |
|
666 |
|
667 ieeFloatAt:index put:aFloat |
|
668 "store the value of the argument, aFloat into the receiver |
|
669 starting at index. Storage is in IEE floating point single precision format. |
|
670 (i.e. 4 bytes are stored). Since ST/X floats are really doubles, the low- |
|
671 order 4 bytes of the precision is lost." |
|
672 |
|
673 " |
|
674 currently, we assume that the machines native number format is already |
|
675 IEE format - we need some more code here whenever ST/X is ported |
|
676 to an IBM 370 or old VAX etc. |
|
677 To date, all supported systems use IEE float numbers, so there should be |
|
678 no problem. |
|
679 " |
|
680 ^ self floatAt:index put:aFloat |
|
681 ! |
|
682 |
|
683 quadWordAt:index MSB:msb |
|
684 "return the 8-bytes starting at index as an (unsigned) Integer. |
|
685 Depending on msb, the value is retrieved MSB or LSB-first." |
|
686 |
|
687 |l |
|
688 bIdx "{ Class: SmallInteger }" |
|
689 delta "{ Class: SmallInteger }"| |
|
690 |
|
691 l := LargeInteger basicNew numberOfDigits:8. |
|
692 msb ifTrue:[ |
|
693 bIdx := index + 7. |
|
694 delta := -1 |
|
695 ] ifFalse:[ |
|
696 bIdx := index. |
|
697 delta := 1 |
|
698 ]. |
|
699 1 to:8 do:[:i | |
|
700 l digitAt:i put:(self basicAt:bIdx). |
|
701 bIdx := bIdx + delta |
|
702 ]. |
|
703 ^ l normalize |
|
704 |
|
705 " |
|
706 |b| |
|
707 |
|
708 b := ByteArray withAll:#(1 2 3 4 5 6 7 8). |
|
709 (b quadWordAt:1 MSB:false) printStringRadix:16 |
|
710 " |
|
711 ! |
|
712 |
|
713 quadWordAt:index put:anInteger MSB:msb |
|
714 "set the 8-bytes starting at index from the (unsigned) Integer value. |
|
715 The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF. |
|
716 Depending on msb, the value is stored MSB-first or LSB-first." |
|
717 |
|
718 |bIdx "{ Class: SmallInteger }" |
|
719 delta "{ Class: SmallInteger }"| |
|
720 |
|
721 msb ifTrue:[ |
|
722 bIdx := index + 7. |
|
723 delta := -1 |
|
724 ] ifFalse:[ |
|
725 bIdx := index. |
|
726 delta := 1 |
|
727 ]. |
|
728 1 to:8 do:[:i | |
|
729 self basicAt:bIdx put:(anInteger digitAt:i). |
|
730 bIdx := bIdx + delta. |
|
731 ]. |
|
732 ^ anInteger |
|
733 |
|
734 " |
|
735 |b| |
|
736 b := ByteArray new:8. |
|
737 b quadWordAtIndex:1 put:16r0807060504030201 MSB:false. |
|
738 b inspect |
|
739 " |
|
740 ! |
|
741 |
807 signedDoubleWordAt:index |
742 signedDoubleWordAt:index |
808 "return the 4-bytes starting at index as a signed Integer. |
743 "return the 4-bytes starting at index as a signed Integer. |
809 The value is retrieved in the machines natural byte order." |
744 The value is retrieved in the machines natural byte order." |
810 |
745 |
811 |w| |
746 |w| |
918 b signedDoubleWordAt:1 put:-1. |
853 b signedDoubleWordAt:1 put:-1. |
919 (b doubleWordAt:1) printStringRadix:16 |
854 (b doubleWordAt:1) printStringRadix:16 |
920 " |
855 " |
921 ! |
856 ! |
922 |
857 |
923 quadWordAt:index MSB:msb |
858 signedWordAt:index |
924 "return the 8-bytes starting at index as an (unsigned) Integer. |
859 "return the 2-bytes starting at index as a signed Integer. |
925 Depending on msb, the value is retrieved MSB or LSB-first." |
860 The value is retrieved in the machines natural byte order." |
926 |
861 |
927 |l |
862 |w "{ Class: SmallInteger }"| |
928 bIdx "{ Class: SmallInteger }" |
863 |
929 delta "{ Class: SmallInteger }"| |
864 w := self wordAt:index. |
930 |
865 (w > 16r7FFF) ifTrue:[ |
931 l := LargeInteger basicNew numberOfDigits:8. |
866 ^ w - 16r10000 |
932 msb ifTrue:[ |
867 ]. |
933 bIdx := index + 7. |
868 ^ w |
934 delta := -1 |
869 |
|
870 " |
|
871 |b| |
|
872 b := ByteArray new:2. |
|
873 b wordAt:1 put:16rFFFF. |
|
874 b signedWordAt:1 |
|
875 " |
|
876 ! |
|
877 |
|
878 signedWordAt:index MSB:msb |
|
879 "return the 2-bytes starting at index as a signed Integer. |
|
880 The value is retrieved MSB-first if the msb-arg is true, |
|
881 LSB-first otherwise" |
|
882 |
|
883 |w "{ Class: SmallInteger }"| |
|
884 |
|
885 w := self wordAt:index MSB:msb. |
|
886 (w > 16r7FFF) ifTrue:[ |
|
887 ^ w - 16r10000 |
|
888 ]. |
|
889 ^ w |
|
890 |
|
891 " |
|
892 |b| |
|
893 b := ByteArray new:2. |
|
894 b wordAt:1 put:16rFFFF. |
|
895 b signedWordAt:1 |
|
896 " |
|
897 ! |
|
898 |
|
899 signedWordAt:index put:value |
|
900 "set the 2-bytes starting at index from the signed Integer value. |
|
901 The stored value must be in the range -32768 .. +32676. |
|
902 The value is stored in the machines natural byteorder." |
|
903 |
|
904 |v| |
|
905 |
|
906 value > 0 ifTrue:[ |
|
907 v := value |
935 ] ifFalse:[ |
908 ] ifFalse:[ |
936 bIdx := index. |
909 v := 16r10000 + value |
937 delta := 1 |
910 ]. |
938 ]. |
911 self wordAt:index put:v. |
939 1 to:8 do:[:i | |
912 ^ value |
940 l digitAt:i put:(self basicAt:bIdx). |
|
941 bIdx := bIdx + delta |
|
942 ]. |
|
943 ^ l normalize |
|
944 |
913 |
945 " |
914 " |
946 |b| |
915 |b| |
947 |
916 b := ByteArray new:4. |
948 b := ByteArray withAll:#(1 2 3 4 5 6 7 8). |
917 b signedWordAt:1 put:-1. |
949 (b quadWordAt:1 MSB:false) printStringRadix:16 |
918 b signedWordAt:3 put:-2. |
950 " |
919 b inspect |
951 ! |
920 " |
952 |
921 ! |
953 quadWordAt:index put:anInteger MSB:msb |
922 |
954 "set the 8-bytes starting at index from the (unsigned) Integer value. |
923 signedWordAt:index put:value MSB:msb |
955 The value must be in the range 0 to 16rFFFFFFFFFFFFFFFF. |
924 "set the 2-bytes starting at index from the signed Integer value. |
956 Depending on msb, the value is stored MSB-first or LSB-first." |
925 The stored value must be in the range -32768 .. +32676. |
957 |
926 The value is stored MSB-first, if the msb-arg is true; |
958 |bIdx "{ Class: SmallInteger }" |
927 LSB-first otherwise" |
959 delta "{ Class: SmallInteger }"| |
928 |
960 |
929 |v| |
961 msb ifTrue:[ |
930 |
962 bIdx := index + 7. |
931 value > 0 ifTrue:[ |
963 delta := -1 |
932 v := value |
964 ] ifFalse:[ |
933 ] ifFalse:[ |
965 bIdx := index. |
934 v := 16r10000 + value |
966 delta := 1 |
935 ]. |
967 ]. |
936 self wordAt:index put:v MSB:msb. |
968 1 to:8 do:[:i | |
937 ^ value |
969 self basicAt:bIdx put:(anInteger digitAt:i). |
938 |
970 bIdx := bIdx + delta. |
939 " |
971 ]. |
940 |b| |
972 ^ anInteger |
941 b := ByteArray new:4. |
|
942 b signedWordAt:1 put:-1. |
|
943 b signedWordAt:3 put:-2. |
|
944 b inspect |
|
945 " |
|
946 ! |
|
947 |
|
948 wordAt:index |
|
949 "return the 2-bytes starting at index as an (unsigned) Integer. |
|
950 The value is retrieved in the machines natural byte order |
|
951 Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)" |
|
952 |
|
953 %{ /* NOCONTEXT */ |
|
954 |
|
955 REGISTER int indx; |
|
956 int nIndex; |
|
957 union { |
|
958 char u_char[2]; |
|
959 unsigned short u_ushort; |
|
960 } val; |
|
961 OBJ cls; |
|
962 |
|
963 if (__isSmallInteger(index)) { |
|
964 indx = _intVal(index); |
|
965 if (indx > 0) { |
|
966 if ((cls = __qClass(self)) != ByteArray) |
|
967 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
968 nIndex = __byteArraySize(self); |
|
969 if ((indx+1) <= nIndex) { |
|
970 val.u_char[0] = _ByteArrayInstPtr(self)->ba_element[indx-1]; |
|
971 val.u_char[1] = _ByteArrayInstPtr(self)->ba_element[indx-1+1]; |
|
972 RETURN ( _MKSMALLINT(val.u_ushort) ); |
|
973 } |
|
974 } |
|
975 } |
|
976 %}. |
|
977 ^ SubscriptOutOfBoundsSignal raise. |
|
978 ! |
|
979 |
|
980 wordAt:index MSB:msb |
|
981 "return the 2-bytes starting at index as an (unsigned) Integer. |
|
982 The value is retrieved MSB (high 8 bits at lower index) if msb is true; |
|
983 LSB-first (i.e. low 8-bits at lower byte index) if its false. |
|
984 Question: should it be retrieve signed values ? (see ByteArray>>signedWordAt:)" |
|
985 |
|
986 %{ /* NOCONTEXT */ |
|
987 |
|
988 REGISTER int indx; |
|
989 int nIndex; |
|
990 int val; |
|
991 OBJ cls; |
|
992 |
|
993 if (__isSmallInteger(index)) { |
|
994 indx = _intVal(index); |
|
995 if (indx > 0) { |
|
996 if ((cls = __qClass(self)) != ByteArray) |
|
997 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
998 nIndex = __byteArraySize(self); |
|
999 if ((indx+1) <= nIndex) { |
|
1000 if (msb == true) { |
|
1001 val = _ByteArrayInstPtr(self)->ba_element[indx-1]; |
|
1002 val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1+1]; |
|
1003 } else { |
|
1004 val = _ByteArrayInstPtr(self)->ba_element[indx+1-1]; |
|
1005 val = (val << 8) + _ByteArrayInstPtr(self)->ba_element[indx-1]; |
|
1006 } |
|
1007 RETURN ( _MKSMALLINT(val) ); |
|
1008 } |
|
1009 } |
|
1010 } |
|
1011 %}. |
|
1012 ^ SubscriptOutOfBoundsSignal raise. |
|
1013 ! |
|
1014 |
|
1015 wordAt:index put:value |
|
1016 "set the 2-bytes starting at index from the (unsigned) Integer value. |
|
1017 The stored value must be in the range 0 .. 16rFFFF. |
|
1018 The value is stored in the machines natural byteorder. |
|
1019 Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)" |
|
1020 |
|
1021 %{ /* NOCONTEXT */ |
|
1022 |
|
1023 REGISTER int indx; |
|
1024 int nIndex; |
|
1025 int v; |
|
1026 union { |
|
1027 char u_char[2]; |
|
1028 unsigned short u_ushort; |
|
1029 } val; |
|
1030 OBJ cls; |
|
1031 |
|
1032 if (__bothSmallInteger(index, value)) { |
|
1033 indx = _intVal(index); |
|
1034 if (indx > 0) { |
|
1035 if ((cls = __qClass(self)) != ByteArray) |
|
1036 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
1037 nIndex = __byteArraySize(self); |
|
1038 if ((indx+1) <= nIndex) { |
|
1039 val.u_ushort = v = _intVal(value); |
|
1040 if ((v & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) { |
|
1041 _ByteArrayInstPtr(self)->ba_element[indx-1] = val.u_char[0]; |
|
1042 _ByteArrayInstPtr(self)->ba_element[indx-1+1] = val.u_char[1]; |
|
1043 RETURN ( value ); |
|
1044 } |
|
1045 } |
|
1046 } |
|
1047 } |
|
1048 %}. |
|
1049 ((value < 0) or:[value > 16rFFFF]) ifTrue:[ |
|
1050 ^ self elementBoundsError |
|
1051 ]. |
|
1052 ^ SubscriptOutOfBoundsSignal raise. |
|
1053 |
|
1054 " |
|
1055 |b| |
|
1056 b := ByteArray new:4. |
|
1057 b wordAt:1 put:16r0102. |
|
1058 b wordAt:3 put:16r0304. |
|
1059 b inspect |
|
1060 " |
|
1061 ! |
|
1062 |
|
1063 wordAt:index put:value MSB:msb |
|
1064 "set the 2-bytes starting at index from the (unsigned) Integer value. |
|
1065 The stored value must be in the range 0 .. 16rFFFF. |
|
1066 The value is stored LSB-first (i.e. the low 8bits are stored at the |
|
1067 lower index) if msb is false, MSB-first otherwise. |
|
1068 Question: should it accept signed values ? (see ByteArray>>signedWordAt:put:)" |
|
1069 |
|
1070 %{ /* NOCONTEXT */ |
|
1071 |
|
1072 REGISTER int indx; |
|
1073 int nIndex; |
|
1074 int val; |
|
1075 OBJ cls; |
|
1076 |
|
1077 if (__bothSmallInteger(index, value)) { |
|
1078 indx = _intVal(index); |
|
1079 if (indx > 0) { |
|
1080 if ((cls = __qClass(self)) != ByteArray) |
|
1081 indx += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars)); |
|
1082 nIndex = __byteArraySize(self); |
|
1083 if ((indx+1) <= nIndex) { |
|
1084 val = _intVal(value); |
|
1085 if ((val & ~0xFFFF) == 0 /* i.e. (val >= 0) && (val <= 0xFFFF) */) { |
|
1086 if (msb == true) { |
|
1087 _ByteArrayInstPtr(self)->ba_element[indx-1+1] = val & 0xFF; |
|
1088 _ByteArrayInstPtr(self)->ba_element[indx-1] = (val>>8) & 0xFF; |
|
1089 } else { |
|
1090 _ByteArrayInstPtr(self)->ba_element[indx-1] = val & 0xFF; |
|
1091 _ByteArrayInstPtr(self)->ba_element[indx+1-1] = (val>>8) & 0xFF; |
|
1092 } |
|
1093 RETURN ( value ); |
|
1094 } |
|
1095 } |
|
1096 } |
|
1097 } |
|
1098 %}. |
|
1099 ((value < 0) or:[value > 16rFFFF]) ifTrue:[ |
|
1100 ^ self elementBoundsError |
|
1101 ]. |
|
1102 ^ SubscriptOutOfBoundsSignal raise. |
973 |
1103 |
974 " |
1104 " |
975 |b| |
1105 |b| |
976 b := ByteArray new:8. |
1106 b := ByteArray new:8. |
977 b quadWordAtIndex:1 put:16r0807060504030201 MSB:false. |
1107 b wordAt:1 put:16r0102 MSB:false. |
978 b inspect |
1108 b wordAt:3 put:16r0304 MSB:false. |
979 " |
1109 b wordAt:5 put:16r0102 MSB:true. |
980 ! |
1110 b wordAt:7 put:16r0304 MSB:true. |
981 |
1111 b inspect |
982 floatAt:index |
1112 " |
983 "return the 4-bytes starting at index as a Float. |
|
984 Notice, that (currently) ST/X Floats are what Doubles are in ST-80; |
|
985 therefore this method reads a 4-byte float from the byteArray and returns |
|
986 a float object which keeps an 8-byte double internally. |
|
987 Notice also, that the bytes are expected to be in this machines |
|
988 float representation and order - if the bytearray originated from another |
|
989 machine, some conversion is usually needed." |
|
990 |
|
991 |newFloat| |
|
992 |
|
993 newFloat := Float basicNew. |
|
994 UninterpretedBytes isBigEndian ifFalse:[ |
|
995 5 to:8 do:[:destIndex| |
|
996 newFloat basicAt:destIndex put:(self at:index - 5 + destIndex) |
|
997 ]. |
|
998 ] ifTrue:[ |
|
999 1 to:4 do:[:destIndex| |
|
1000 newFloat basicAt:destIndex put:(self at:index - 1 + destIndex) |
|
1001 ]. |
|
1002 ]. |
|
1003 ^ newFloat. |
|
1004 ! |
|
1005 |
|
1006 floatAt:index put:aFloat |
|
1007 "store the 4 bytes of value of the argument, aFloat into the receiver |
|
1008 starting at index. |
|
1009 Notice, that (currently) ST/X Floats are what DOubles are in ST-80. |
|
1010 Notice also, that the bytes are expected to be in this machines |
|
1011 float representation - if the bytearray originated from another |
|
1012 machine, some conversion is usually needed." |
|
1013 |
|
1014 UninterpretedBytes isBigEndian ifFalse:[ |
|
1015 5 to:8 do:[:srcIndex| |
|
1016 self at:index - 5 + srcIndex put:(aFloat basicAt:srcIndex) |
|
1017 ]. |
|
1018 ] ifTrue:[ |
|
1019 1 to:4 do:[:srcIndex| |
|
1020 self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) |
|
1021 ]. |
|
1022 ]. |
|
1023 ^ aFloat |
|
1024 ! |
|
1025 |
|
1026 doubleAt:index |
|
1027 "return the 8-bytes starting at index as a Float. |
|
1028 Notice, that (currently) ST/X Floats are what Doubles are in ST-80. |
|
1029 Notice also, that the bytes are expected to be in this machines |
|
1030 float representation - if the bytearray originated from another |
|
1031 machine, some conversion is usually needed." |
|
1032 |
|
1033 |newFloat| |
|
1034 |
|
1035 newFloat := Float basicNew. |
|
1036 1 to:8 do:[:destIndex| |
|
1037 newFloat basicAt:destIndex put:(self at:index - 1 + destIndex) |
|
1038 ]. |
|
1039 ^ newFloat. |
|
1040 ! |
|
1041 |
|
1042 doubleAt:index put:aFloat |
|
1043 "store the value of the argument, aFloat into the receiver |
|
1044 starting at index. |
|
1045 Notice, that (currently) ST/X Floats are what Doubles are in ST-80. |
|
1046 Notice also, that the bytes are expected to be in this machines |
|
1047 float representation - if the bytearray originated from another |
|
1048 machine, some conversion is usually needed." |
|
1049 |
|
1050 1 to:8 do:[:srcIndex| |
|
1051 self at:index - 1 + srcIndex put:(aFloat basicAt:srcIndex) |
|
1052 ]. |
|
1053 ^ aFloat |
|
1054 ! |
|
1055 |
|
1056 ieeFloatAt:index |
|
1057 "retrieve the 4 bytes starting at index as a float. |
|
1058 The 4 bytes are assumed to be in IEE floating point single precision |
|
1059 number format." |
|
1060 |
|
1061 " |
|
1062 currently, we assume that the machines native number format is already |
|
1063 IEE format - we need some more code here whenever ST/X is ported |
|
1064 to an IBM 370 or old VAX etc. |
|
1065 To date, all supported systems use IEE float numbers, so there should be |
|
1066 no problem. |
|
1067 " |
|
1068 ^ self floatAt:index |
|
1069 ! |
|
1070 |
|
1071 ieeFloatAt:index put:aFloat |
|
1072 "store the value of the argument, aFloat into the receiver |
|
1073 starting at index. Storage is in IEE floating point single precision format. |
|
1074 (i.e. 4 bytes are stored). Since ST/X floats are really doubles, the low- |
|
1075 order 4 bytes of the precision is lost." |
|
1076 |
|
1077 " |
|
1078 currently, we assume that the machines native number format is already |
|
1079 IEE format - we need some more code here whenever ST/X is ported |
|
1080 to an IBM 370 or old VAX etc. |
|
1081 To date, all supported systems use IEE float numbers, so there should be |
|
1082 no problem. |
|
1083 " |
|
1084 ^ self floatAt:index put:aFloat |
|
1085 ! |
|
1086 |
|
1087 ieeDoubleAt:index |
|
1088 "retrieve the 8 bytes starting at index as a float. |
|
1089 The 8 bytes are assumed to be in IEE floating point single precision |
|
1090 number format." |
|
1091 |
|
1092 " |
|
1093 currently, we assume that the machines native number format is already |
|
1094 IEE format - we need some more code here whenever ST/X is ported |
|
1095 to an IBM 370 or old VAX etc. |
|
1096 To date, all supported systems use IEE float numbers, so there should be |
|
1097 no problem. |
|
1098 " |
|
1099 ^ self doubleAt:index |
|
1100 ! |
|
1101 |
|
1102 ieeDoubleAt:index put:aFloat |
|
1103 "store the value of the argument, aFloat into the receiver |
|
1104 starting at index. Storage is in IEE floating point double precision format. |
|
1105 (i.e. 8 bytes are stored)." |
|
1106 |
|
1107 " |
|
1108 currently, we assume that the machines native number format is already |
|
1109 IEE format - we need some more code here whenever ST/X is ported |
|
1110 to an IBM 370 or old VAX etc. |
|
1111 To date, all supported systems use IEE float numbers, so there should be |
|
1112 no problem. |
|
1113 " |
|
1114 ^ self doubleAt:index put:aFloat |
|
1115 ! ! |
1113 ! ! |
1116 |
1114 |
1117 !ByteArray methodsFor:'binary storage'! |
1115 !ByteArray methodsFor:'binary storage'! |
1118 |
1116 |
1119 storeBinaryDefinitionOn:stream manager:manager |
1117 storeBinaryDefinitionOn:stream manager:manager |
1363 " |
1352 " |
1364 fall back in case of non-ByteArray argument, |
1353 fall back in case of non-ByteArray argument, |
1365 or for the error report if any index is invalid |
1354 or for the error report if any index is invalid |
1366 " |
1355 " |
1367 ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart |
1356 ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart |
|
1357 ! |
|
1358 |
|
1359 replaceFrom:start to:stop with:aCollection startingAt:repStart |
|
1360 "replace elements from another collection" |
|
1361 |
|
1362 (aCollection class == self class) ifTrue:[ |
|
1363 ^ self replaceBytesFrom:start to:stop with:aCollection startingAt:repStart |
|
1364 ]. |
|
1365 ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart |
1368 ! ! |
1366 ! ! |
1369 |
1367 |
1370 !ByteArray methodsFor:'image manipulation support'! |
1368 !ByteArray methodsFor:'image manipulation support'! |
1371 |
1369 |
1372 invert |
1370 compressPixels:nBitsPerPixel width:width height:height into:aByteArray |
1373 "invert all bytes - used with image manipulations |
1371 mapping:aMapByteArray |
1374 written as a primitive for speed. |
1372 |
1375 Q: is this really needed ?" |
1373 "given the receiver with 8-bit pixels, compress them into aByteArray |
1376 |
1374 with nBitsPerPixel-depth pixels. The width/height-arguments are needed |
1377 %{ /* NOCONTEXT */ |
1375 to allow for any padding. On the fly, the source bytes are translated |
1378 |
1376 using aMapByteArray (if non-nil). |
1379 REGISTER unsigned char *dst; |
1377 Notice that smalltalk indexing begins at 1; thus the map-index for a byte |
1380 REGISTER unsigned long *ldst; |
1378 value of n is found in map at:(n + 1). |
1381 REGISTER int cnt; |
1379 Output bits are filled left-to right, i.e. the first byte in the input |
1382 |
1380 corresponds to the high bit(s) if the first byte in the input. |
1383 if (__qClass(self) == ByteArray) { |
1381 This method can be used to convert 8-bit image data to mono, 2-bit and 4-bit |
1384 cnt = __byteArraySize(self); |
1382 bitmaps. |
1385 dst = _ByteArrayInstPtr(self)->ba_element; |
1383 It can also be used to compress byte-arrays into bitArrays." |
1386 if (! ((int)dst & (sizeof(long)-1))) { |
1384 |
1387 ldst = (unsigned long *)dst; |
1385 %{ /* NOCONTEXT */ |
1388 while (cnt >= sizeof(long)) { |
1386 |
1389 *ldst = ~(*ldst); |
1387 REGISTER unsigned char *src, *dst; |
1390 ldst++; |
1388 REGISTER int wrun; |
1391 cnt -= sizeof(long); |
1389 unsigned char *dstNext; |
1392 } |
1390 int bytesPerRow, mask, shift0, shift; |
1393 dst = (unsigned char *)ldst; |
1391 int w, h, hrun; |
1394 } |
1392 int srcBytes, dstBytes; |
1395 while (cnt--) { |
1393 int bitsPerPixel; |
1396 *dst = ~(*dst); |
1394 int bits; |
1397 dst++; |
1395 int ncells; |
1398 } |
1396 unsigned char *map; |
1399 RETURN ( self ); |
1397 |
1400 } |
1398 if ((__qClass(self) == ByteArray) |
|
1399 && (__qClass(aByteArray) == ByteArray) |
|
1400 && __isSmallInteger(nBitsPerPixel) |
|
1401 && __bothSmallInteger(height, width)) { |
|
1402 if ((aMapByteArray != nil) |
|
1403 && (__Class(aMapByteArray) == ByteArray)) { |
|
1404 map = _ByteArrayInstPtr(aMapByteArray)->ba_element; |
|
1405 } else { |
|
1406 map = (unsigned char *)0; |
|
1407 } |
|
1408 |
|
1409 bitsPerPixel = _intVal(nBitsPerPixel); |
|
1410 w = _intVal(width); |
|
1411 h = _intVal(height); |
|
1412 src = _ByteArrayInstPtr(self)->ba_element; |
|
1413 dst = _ByteArrayInstPtr(aByteArray)->ba_element; |
|
1414 switch (bitsPerPixel) { |
|
1415 case 1: |
|
1416 mask = 0x01; |
|
1417 break; |
|
1418 case 2: |
|
1419 mask = 0x03; |
|
1420 break; |
|
1421 case 4: |
|
1422 mask = 0x0F; |
|
1423 break; |
|
1424 case 8: |
|
1425 mask = 0xFF; |
|
1426 break; |
|
1427 default: |
|
1428 goto fail; |
|
1429 } |
|
1430 if (map) { |
|
1431 /* |
|
1432 * if a map is present, it must have entries for |
|
1433 * all possible byte-values (i.e. its size must be >= 256) |
|
1434 */ |
|
1435 if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256) |
|
1436 goto fail; |
|
1437 } |
|
1438 |
|
1439 bytesPerRow = (w * bitsPerPixel + 7) / 8; |
|
1440 dstBytes = bytesPerRow * h; |
|
1441 srcBytes = w * h; |
|
1442 |
|
1443 if ((__byteArraySize(self) >= srcBytes) |
|
1444 && (__byteArraySize(aByteArray) >= dstBytes)) { |
|
1445 for (hrun=h; hrun; hrun--) { |
|
1446 dstNext = dst + bytesPerRow; |
|
1447 bits = 0; shift = 8; |
|
1448 if (map) { |
|
1449 for (wrun=w; wrun; wrun--) { |
|
1450 bits = (bits << bitsPerPixel) | (map[*src++] & mask); |
|
1451 shift -= bitsPerPixel; |
|
1452 if (shift == 0) { |
|
1453 *dst++ = bits; |
|
1454 bits = 0; shift = 8; |
|
1455 } |
|
1456 } |
|
1457 } else { |
|
1458 for (wrun=w; wrun; wrun--) { |
|
1459 bits = (bits << bitsPerPixel) | (*src++ & mask); |
|
1460 shift -= bitsPerPixel; |
|
1461 if (shift == 0) { |
|
1462 *dst++ = bits; |
|
1463 bits = 0; shift = 8; |
|
1464 } |
|
1465 } |
|
1466 } |
|
1467 if (shift != 8) { |
|
1468 *dst = bits; |
|
1469 } |
|
1470 dst = dstNext; |
|
1471 } |
|
1472 RETURN ( self ); |
|
1473 } |
|
1474 } |
|
1475 fail: ; |
1401 %} |
1476 %} |
1402 . |
1477 . |
1403 self primitiveFailed |
1478 self primitiveFailed |
1404 ! |
1479 |
1405 |
1480 "Example1: |
1406 reverse |
1481 compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap |
1407 "reverse order of elements inplace - |
1482 " |
1408 written as a primitive for speed on image manipulations (mirror)" |
1483 " |
1409 |
1484 |inBits outBits| |
1410 %{ /* NOCONTEXT */ |
1485 |
1411 |
1486 inBits := #[0 0 0 0 1 1 1 1 |
1412 REGISTER unsigned char *p1, *p2; |
1487 0 0 1 1 0 0 1 1 |
1413 REGISTER int cnt; |
1488 0 1 0 1 0 1 0 1 |
1414 REGISTER unsigned t; |
1489 1 1 1 1 0 0 0 0]. |
1415 OBJ cls; |
1490 outBits := ByteArray new:4. |
1416 |
1491 inBits compressPixels:1 width:8 height:4 |
1417 if (__qClass(self) == ByteArray) { |
1492 into:outBits mapping:nil. |
1418 cnt = __byteArraySize(self); |
1493 outBits inspect |
1419 p1 = _ByteArrayInstPtr(self)->ba_element; |
1494 " |
1420 p2 = p1 + cnt - 1; |
1495 |
1421 while (cnt > 0) { |
1496 "Example2: |
1422 t = *p1; |
1497 compress byte-array into a bitArray, translating 99 to 0-bits, |
1423 *p1++ = *p2; |
1498 and 176 to 1-bits. (just a stupid example) |
1424 *p2-- = t; |
1499 " |
1425 cnt-=2; |
1500 " |
1426 } |
1501 |inBits outBits map| |
1427 RETURN ( self ); |
1502 |
1428 } |
1503 inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99]. |
1429 %}. |
1504 map := ByteArray new:256. |
1430 ^ super reverse |
1505 map at:176+1 put:1. |
|
1506 |
|
1507 outBits := ByteArray new:2. |
|
1508 inBits compressPixels:1 width:16 height:1 |
|
1509 into:outBits mapping:map. |
|
1510 outBits inspect |
|
1511 " |
|
1512 |
|
1513 "Example3: |
|
1514 compress byte-array into a bitArray, translating everything below 128 to 0-bits, |
|
1515 and 128 to 255 to 1-bits.99 to 0-bits (another stupid example) |
|
1516 " |
|
1517 " |
|
1518 |inBits outBits map| |
|
1519 |
|
1520 inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99]. |
|
1521 map := ByteArray new:256. |
|
1522 map atAll:(128+1 to:255+1) put:1. |
|
1523 |
|
1524 outBits := ByteArray new:2. |
|
1525 inBits compressPixels:1 width:16 height:1 |
|
1526 into:outBits mapping:map. |
|
1527 outBits inspect |
|
1528 " |
1431 ! |
1529 ! |
1432 |
1530 |
1433 expandPixels:nBitsPerPixel width:width height:height into:aByteArray |
1531 expandPixels:nBitsPerPixel width:width height:height into:aByteArray |
1434 mapping:aMapByteArray |
1532 mapping:aMapByteArray |
1435 |
1533 |
1574 into:outBits mapping:#[99 176]. |
1672 into:outBits mapping:#[99 176]. |
1575 outBits inspect |
1673 outBits inspect |
1576 " |
1674 " |
1577 ! |
1675 ! |
1578 |
1676 |
1579 compressPixels:nBitsPerPixel width:width height:height into:aByteArray |
1677 invert |
1580 mapping:aMapByteArray |
1678 "invert all bytes - used with image manipulations |
1581 |
1679 written as a primitive for speed. |
1582 "given the receiver with 8-bit pixels, compress them into aByteArray |
1680 Q: is this really needed ?" |
1583 with nBitsPerPixel-depth pixels. The width/height-arguments are needed |
1681 |
1584 to allow for any padding. On the fly, the source bytes are translated |
1682 %{ /* NOCONTEXT */ |
1585 using aMapByteArray (if non-nil). |
1683 |
1586 Notice that smalltalk indexing begins at 1; thus the map-index for a byte |
1684 REGISTER unsigned char *dst; |
1587 value of n is found in map at:(n + 1). |
1685 REGISTER unsigned long *ldst; |
1588 Output bits are filled left-to right, i.e. the first byte in the input |
1686 REGISTER int cnt; |
1589 corresponds to the high bit(s) if the first byte in the input. |
1687 |
1590 This method can be used to convert 8-bit image data to mono, 2-bit and 4-bit |
1688 if (__qClass(self) == ByteArray) { |
1591 bitmaps. |
1689 cnt = __byteArraySize(self); |
1592 It can also be used to compress byte-arrays into bitArrays." |
1690 dst = _ByteArrayInstPtr(self)->ba_element; |
1593 |
1691 if (! ((int)dst & (sizeof(long)-1))) { |
1594 %{ /* NOCONTEXT */ |
1692 ldst = (unsigned long *)dst; |
1595 |
1693 while (cnt >= sizeof(long)) { |
1596 REGISTER unsigned char *src, *dst; |
1694 *ldst = ~(*ldst); |
1597 REGISTER int wrun; |
1695 ldst++; |
1598 unsigned char *dstNext; |
1696 cnt -= sizeof(long); |
1599 int bytesPerRow, mask, shift0, shift; |
1697 } |
1600 int w, h, hrun; |
1698 dst = (unsigned char *)ldst; |
1601 int srcBytes, dstBytes; |
1699 } |
1602 int bitsPerPixel; |
1700 while (cnt--) { |
1603 int bits; |
1701 *dst = ~(*dst); |
1604 int ncells; |
1702 dst++; |
1605 unsigned char *map; |
1703 } |
1606 |
1704 RETURN ( self ); |
1607 if ((__qClass(self) == ByteArray) |
1705 } |
1608 && (__qClass(aByteArray) == ByteArray) |
|
1609 && __isSmallInteger(nBitsPerPixel) |
|
1610 && __bothSmallInteger(height, width)) { |
|
1611 if ((aMapByteArray != nil) |
|
1612 && (__Class(aMapByteArray) == ByteArray)) { |
|
1613 map = _ByteArrayInstPtr(aMapByteArray)->ba_element; |
|
1614 } else { |
|
1615 map = (unsigned char *)0; |
|
1616 } |
|
1617 |
|
1618 bitsPerPixel = _intVal(nBitsPerPixel); |
|
1619 w = _intVal(width); |
|
1620 h = _intVal(height); |
|
1621 src = _ByteArrayInstPtr(self)->ba_element; |
|
1622 dst = _ByteArrayInstPtr(aByteArray)->ba_element; |
|
1623 switch (bitsPerPixel) { |
|
1624 case 1: |
|
1625 mask = 0x01; |
|
1626 break; |
|
1627 case 2: |
|
1628 mask = 0x03; |
|
1629 break; |
|
1630 case 4: |
|
1631 mask = 0x0F; |
|
1632 break; |
|
1633 case 8: |
|
1634 mask = 0xFF; |
|
1635 break; |
|
1636 default: |
|
1637 goto fail; |
|
1638 } |
|
1639 if (map) { |
|
1640 /* |
|
1641 * if a map is present, it must have entries for |
|
1642 * all possible byte-values (i.e. its size must be >= 256) |
|
1643 */ |
|
1644 if ((__qSize(aMapByteArray) - OHDR_SIZE) < 256) |
|
1645 goto fail; |
|
1646 } |
|
1647 |
|
1648 bytesPerRow = (w * bitsPerPixel + 7) / 8; |
|
1649 dstBytes = bytesPerRow * h; |
|
1650 srcBytes = w * h; |
|
1651 |
|
1652 if ((__byteArraySize(self) >= srcBytes) |
|
1653 && (__byteArraySize(aByteArray) >= dstBytes)) { |
|
1654 for (hrun=h; hrun; hrun--) { |
|
1655 dstNext = dst + bytesPerRow; |
|
1656 bits = 0; shift = 8; |
|
1657 if (map) { |
|
1658 for (wrun=w; wrun; wrun--) { |
|
1659 bits = (bits << bitsPerPixel) | (map[*src++] & mask); |
|
1660 shift -= bitsPerPixel; |
|
1661 if (shift == 0) { |
|
1662 *dst++ = bits; |
|
1663 bits = 0; shift = 8; |
|
1664 } |
|
1665 } |
|
1666 } else { |
|
1667 for (wrun=w; wrun; wrun--) { |
|
1668 bits = (bits << bitsPerPixel) | (*src++ & mask); |
|
1669 shift -= bitsPerPixel; |
|
1670 if (shift == 0) { |
|
1671 *dst++ = bits; |
|
1672 bits = 0; shift = 8; |
|
1673 } |
|
1674 } |
|
1675 } |
|
1676 if (shift != 8) { |
|
1677 *dst = bits; |
|
1678 } |
|
1679 dst = dstNext; |
|
1680 } |
|
1681 RETURN ( self ); |
|
1682 } |
|
1683 } |
|
1684 fail: ; |
|
1685 %} |
1706 %} |
1686 . |
1707 . |
1687 self primitiveFailed |
1708 self primitiveFailed |
1688 |
1709 ! |
1689 "Example1: |
1710 |
1690 compress 1 byte-per-pixel bitmap to 1-bit-per-pixel bitmap |
1711 reverse |
1691 " |
1712 "reverse order of elements inplace - |
1692 " |
1713 written as a primitive for speed on image manipulations (mirror)" |
1693 |inBits outBits| |
1714 |
1694 |
1715 %{ /* NOCONTEXT */ |
1695 inBits := #[0 0 0 0 1 1 1 1 |
1716 |
1696 0 0 1 1 0 0 1 1 |
1717 REGISTER unsigned char *p1, *p2; |
1697 0 1 0 1 0 1 0 1 |
1718 REGISTER int cnt; |
1698 1 1 1 1 0 0 0 0]. |
1719 REGISTER unsigned t; |
1699 outBits := ByteArray new:4. |
1720 OBJ cls; |
1700 inBits compressPixels:1 width:8 height:4 |
1721 |
1701 into:outBits mapping:nil. |
1722 if (__qClass(self) == ByteArray) { |
1702 outBits inspect |
1723 cnt = __byteArraySize(self); |
1703 " |
1724 p1 = _ByteArrayInstPtr(self)->ba_element; |
1704 |
1725 p2 = p1 + cnt - 1; |
1705 "Example2: |
1726 while (cnt > 0) { |
1706 compress byte-array into a bitArray, translating 99 to 0-bits, |
1727 t = *p1; |
1707 and 176 to 1-bits. (just a stupid example) |
1728 *p1++ = *p2; |
1708 " |
1729 *p2-- = t; |
1709 " |
1730 cnt-=2; |
1710 |inBits outBits map| |
1731 } |
1711 |
1732 RETURN ( self ); |
1712 inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99]. |
1733 } |
1713 map := ByteArray new:256. |
1734 %}. |
1714 map at:176+1 put:1. |
1735 ^ super reverse |
1715 |
|
1716 outBits := ByteArray new:2. |
|
1717 inBits compressPixels:1 width:16 height:1 |
|
1718 into:outBits mapping:map. |
|
1719 outBits inspect |
|
1720 " |
|
1721 |
|
1722 "Example3: |
|
1723 compress byte-array into a bitArray, translating everything below 128 to 0-bits, |
|
1724 and 128 to 255 to 1-bits.99 to 0-bits (another stupid example) |
|
1725 " |
|
1726 " |
|
1727 |inBits outBits map| |
|
1728 |
|
1729 inBits := #[176 176 176 176 99 99 99 99 176 176 99 99 176 99 176 99]. |
|
1730 map := ByteArray new:256. |
|
1731 map atAll:(128+1 to:255+1) put:1. |
|
1732 |
|
1733 outBits := ByteArray new:2. |
|
1734 inBits compressPixels:1 width:16 height:1 |
|
1735 into:outBits mapping:map. |
|
1736 outBits inspect |
|
1737 " |
|
1738 ! ! |
1736 ! ! |
1739 |
1737 |
1740 !ByteArray methodsFor:'printing & storing'! |
1738 !ByteArray methodsFor:'printing & storing'! |
1741 |
|
1742 isLiteral |
|
1743 "return true, if the receiver can be used as a literal |
|
1744 (i.e. can be used in constant arrays)" |
|
1745 |
|
1746 "no, simply returning true here is a mistake: |
|
1747 it could be a subclass of ByteArray |
|
1748 (of which the compiler does not know at all ...)" |
|
1749 |
|
1750 ^ self class == ByteArray |
|
1751 ! |
|
1752 |
|
1753 storeOn:aStream |
|
1754 "append a printed representation from which the receiver can be |
|
1755 reconstructed to aStream. (reimplemented to make it look better)" |
|
1756 |
|
1757 |first| |
|
1758 |
|
1759 self class == ByteArray ifTrue:[ |
|
1760 aStream nextPutAll:'#['. |
|
1761 first := true. |
|
1762 self do:[:byte | |
|
1763 first ifFalse:[aStream space] |
|
1764 ifTrue:[first := false]. |
|
1765 byte storeOn:aStream. |
|
1766 ]. |
|
1767 aStream nextPutAll:']'. |
|
1768 ^ self |
|
1769 ]. |
|
1770 ^ super storeOn:aStream |
|
1771 |
|
1772 " |
|
1773 #[1 2 3 4 5] storeOn:Transcript |
|
1774 " |
|
1775 ! |
|
1776 |
|
1777 displayString |
|
1778 ^ self storeString |
|
1779 |
|
1780 "Created: 25.10.1995 / 13:33:26 / cg" |
|
1781 ! |
|
1782 |
1739 |
1783 asPackedString |
1740 asPackedString |
1784 "ST-80 compatibility: encode the receiver into an ascii String |
1741 "ST-80 compatibility: encode the receiver into an ascii String |
1785 with 6bits encoded per character. Each group of 6 bits is encoded |
1742 with 6bits encoded per character. Each group of 6 bits is encoded |
1786 as a corresponding character (32+value) and the resulting string |
1743 as a corresponding character (32+value) and the resulting string |