version 1.7, 1999/06/20 19:56:47
|
version 1.8, 1999/08/29 21:44:46
|
Line 53 Variable bitmap-chars
|
Line 53 Variable bitmap-chars
|
: read-header ( fd -- ) |
: read-header ( fd -- ) |
image-header 4 cells rot read-file throw drop |
image-header 4 cells rot read-file throw drop |
image-header 2 cells + @ bswap tchars @ * au @ / |
image-header 2 cells + @ bswap tchars @ * au @ / |
dup cell / image-cells ! 1- 8 cells / 1+ bitmap-chars ! |
dup image-cells ! 1- 8 / tchars @ / 1+ bitmap-chars ! |
image-cells @ cells allocate throw to image |
image-cells @ cells allocate throw to image |
bitmap-chars @ allocate throw to bitmap ; |
bitmap-chars @ allocate throw to bitmap ; |
|
|
Line 61 Variable bitmap-chars
|
Line 61 Variable bitmap-chars
|
image image-cells @ cells r> read-file throw drop ; |
image image-cells @ cells r> read-file throw drop ; |
|
|
: read-bitmap ( fd -- ) >r |
: read-bitmap ( fd -- ) >r |
bitmap bitmap-chars @ r> read-file throw drop ; |
bitmap bitmap-chars @ tchars @ * r> read-file throw drop ; |
|
|
: .08x ( n -- ) 0 <# tcell @ 0 ?DO # # LOOP 'x hold '0 hold #> type ; |
: .08x ( n -- ) 0 <# tcell @ 0 ?DO # # LOOP 'x hold '0 hold #> type ; |
: .02x ( n -- ) 0 <# tchars @ 0 ?DO # # LOOP 'x hold '0 hold #> type ; |
: .02x ( n -- ) 0 <# tchars @ 0 ?DO # # LOOP 'x hold '0 hold #> type ; |
Line 72 Variable bitmap-chars
|
Line 72 Variable bitmap-chars
|
4 +LOOP ; |
4 +LOOP ; |
|
|
: .reloc ( -- ) |
: .reloc ( -- ) |
bitmap-chars @ 0 ?DO |
bitmap-chars @ tchars @ * 0 ?DO |
I $10 + I' min I ?DO space |
I $10 + I' min I ?DO space |
0 I tchars @ bounds ?DO 8 lshift bitmap I + c@ + LOOP |
0 I tchars @ bounds ?DO 8 lshift bitmap I + c@ + LOOP |
.02x ." ," tchars @ +LOOP cr |
.02x ." ," tchars @ +LOOP cr |
Line 85 Variable bitmap-chars
|
Line 85 Variable bitmap-chars
|
r@ read-dictionary r@ read-bitmap r> close-file throw ; |
r@ read-dictionary r@ read-bitmap r> close-file throw ; |
|
|
: .imagesize ( -- ) |
: .imagesize ( -- ) |
image-header 3 cells + @ bswap tcell @ / tchars @ * au @ / .08x ; |
image-header 3 cells + @ bswap .08x ; |
|
|
: .relocsize ( -- ) |
: .relocsize ( -- ) |
bitmap-chars @ 1- tchars @ / 1+ .08x ; |
bitmap-chars @ .08x ; |
|
|
: fi2c ( addr u -- ) base @ >r hex |
: fi2c ( addr u -- ) base @ >r hex |
read-image |
read-image |