Compare commits

..

3 Commits

Author SHA1 Message Date
~d6 dd368c12ec seems to be working 2023-10-28 23:58:57 -04:00
~d6 0e85bd16c0 upside-down, streamin version 2023-10-28 23:58:57 -04:00
~d6 35e1bf5b56 .gitignore 2023-10-28 23:58:57 -04:00
2 changed files with 199 additions and 0 deletions

16
.gitignore vendored Normal file
View File

@ -0,0 +1,16 @@
# use glob syntax.
syntax: glob
*.pyc
*.pyo
*~
TAGS
*.rom
img
etc
test-roms
junk
img
.theme
.snarf
*.sym
wave

183
icn_to_bmp.tal Normal file
View File

@ -0,0 +1,183 @@
( icn_to_bmp.tal )
( )
( converts ICN files to BMP files. )
( )
( USAGE: icn_to_bmp.rom $tile-w $tile-h $in-file $out-file )
( )
( EXAMPLE: icn_to_bmp.rom 8 8 icon.icn icon.bmp # convert a 64x64 pixel image )
@System [ |0f &state $1 ]
@Console [ |18 &w $1 ]
|a0 @File1 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|b0 @File2 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|0000
@tile-w $2
@adj-tile-w $2
@tile-h $2
@icn-size $2
@in-file $2
@out-file $2
@row-size-bytes $2
@adj-row-size-bytes $2
|0100
;after-args #0000 arg/init BRK
( load argument parsing )
~arg.tal
( exit immediately )
@exit ( -> BRK )
#01 .System/state DEO BRK
( write null-terminated string to stdout )
@emit ( buf* -> )
LITr -Console/w ( buf* [dev^] )
&loop LDAk ?&ok POP2 POPr JMP2r ( )
&ok LDAk STHkr DEO INC2 !&loop ( buf+1* [dev^] )
@msg
&wrote "wrote 20 00
&bytes-to 20 "bytes 20 "to 20 00
&invalid-width "Invalid 20 "tile 20 "width 00
&invalid-height "Invalid 20 "tile 20 "height 00
&invalid-size "Invalid 20 "size: 20 "ICN 20 "too 20 "large
&write-error "Failed 20 "to 20 "write 20 "data 00
&wrong-number-of-args "Wrong 20 "number 20 "of 20 "args; 20 "expected 20 "four 00
@usage ( reason* -> )
;usage/error emit emit ;usage/message emit !exit
&error "ERROR: 20 00
&message
0a 0a "USAGE: 20 "icn_to_bmp.rom 20 "WIDTH 20 "HEIGHT 20 "ICN 20 "BMP 0a
20 20 "WIDTH 20 "and 20 "HEIGHT 20 "are 20 "given 20 "in 20 "tiles 20 "(each 20 "tile 20 "is 20 "8x8 20 "pixels) 0a
20 20 "maximum 20 "WIDTH/HEIGHT 20 "is 20 "255 20 "tiles 0a
20 20 "ICN/BMP 20 "should 20 "be 20 "paths 20 "(that 20 "are 20 "readable/writable) 0a
20 20 "maximum 20 "ICN 20 "size 20 "is 20 "49152 20 "bytes 0a
0a 00
@str-to-int ( s* -> n* )
LIT2r 0000
&loop LDAk ?&non-null POP2 STH2r JMP2r
&non-null LDAk LIT "0 SUB DUP #09 GTH ?&bad
LIT2r 000a MUL2r LITr 00 STH ADD2r INC2 !&loop
&bad POP2 POP2r #0000 JMP2r
( emit a short as a decimal )
@emit-dec2 ( n* -> )
LITr 00 ( n [0] )
&read ( n [k] )
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
DUP2 ORA ,&read JCN
POP2 ( top element was 0000 )
&write ( n0 n1 ... nk [k+1] )
NIP #30 ADD #18 DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
STHkr ,&write JCN
POPr JMP2r
@after-args ( -> )
;arg/count LDA #04 EQU ?{ ;msg/wrong-number-of-args !usage }
#00 arg/read str-to-int .tile-w STZ2
#01 arg/read str-to-int .tile-h STZ2
#02 arg/read .in-file STZ2
#03 arg/read .out-file STZ2
.tile-w LDZ2 .tile-h LDZ2 MUL2 #30 SFT2 .icn-size STZ2
.tile-w LDZ2 #30 SFT2 .row-size-bytes STZ2
.tile-w LDZ2 #0008 MUL2 #001f ADD2 #0020 DIV2 #0004 MUL2 .adj-tile-w STZ2
.adj-tile-w LDZ2 #30 SFT2 .adj-row-size-bytes STZ2
validate
write-header
read-icn
write-body
;msg/wrote emit
;bmp-header/total-size LDA2 SWP emit-dec2
;msg/bytes-to emit .out-file LDZ2 emit
#0a .Console/w DEO
!exit
@read-icn ( -> ok^ )
.in-file LDZ2 .File1/name DEO2
.icn-size LDZ2 STH2k .File1/len DEO
;icn-dat .File1/r DEO2
.File1/ok DEI2 STH2r EQU2 JMP2r
@convert-tile-row ( src* -> )
.row-size-bytes LDZ2 ( src* size* )
OVR2 ADD2 SWP2 LIT2r =bmp-buf ( limit* src* [dst*] )
&loop ( limit* src* [dst*] )
DUP2 STH2kr convert-row ( limit* src* [dst*] )
#0008 ADD2 INC2r ( limit* src+8* [dst+1*] )
GTH2k ?&loop ( limit* src+8* [dst+1*] )
POP2 POP2 POP2r JMP2r ( )
@convert-row ( src* dst* -> )
LITr -adj-tile-w LDZ2r STH2 ( src* [w* dst*] )
#0001 SUB2 DUP2 #0008 ADD2 ( lim* src+7* [w* dst*] )
&loop ( lim* pos* [w* dst*] )
LDAk STH2kr STA OVR2r ADD2r ( src* pos* [w* dst+w*] ; dst<-pos )
#0001 SUB2 LTH2k ?&loop ( src* pos-1* [w* dst+w*] )
POP2 POP2 POP2r POP2r JMP2r ( )
@write-tile-row ( -> ok^ )
.adj-row-size-bytes LDZ2 STH2k .File2/len DEO2
;bmp-buf .File2/w DEO2
.File2/ok DEI2 STH2r EQU2 JMP2r
@validate ( -> )
.tile-w LDZ2 #0001 SUB2 #00ff LTH2 ?&tile-w-ok ;msg/invalid-width !usage &tile-w-ok
.tile-h LDZ2 #0001 SUB2 #00ff LTH2 ?&tile-h-ok ;msg/invalid-height !usage &tile-h-ok
.icn-size LDZ2 #c001 LTH2 ?&size-ok ;msg/invalid-size !usage &size-ok
JMP2r
( colors are provided in RGB order, written to BMP header in reverse )
@write-color ( r^ g^ b^ addr* -> )
STH2k STA INC2r ( ; addr+0<-b )
STH2kr STA INC2r ( ; addr+1<-g )
STH2r STA JMP2r ( ; addr+2<-r )
@write-header ( -> )
.adj-tile-w LDZ2 .tile-h LDZ2 MUL2 ( aw*h )
#30 SFT2 #0020 ADD2 ( 32+aw*h*8 )
SWP ;bmp-header/total-size STA2
.tile-h LDZ2 #30 SFT2 SWP ;bmp-header/pixel-h STA2 ( )
.tile-w LDZ2 #30 SFT2 SWP ;bmp-header/pixel-w STA2 ( )
( these colors are specified in RGB order )
#ff #ff #ff ;bmp-header/color0 write-color
#00 #00 #00 ;bmp-header/color1 write-color
.out-file LDZ2 .File2/name DEO2
#0020 .File2/len DEO2
;bmp-header .File2/w DEO2
.File2/ok DEI2 #0020 EQU2 ?&ok ;msg/write-error !usage
&ok JMP2r
@write-body ( -> )
;icn-dat ( dat* )
.icn-size LDZ2 OVR2 ADD2 ( dat* dat+size* )
.row-size-bytes LDZ2 STH2k SUB2 ( dat* dat+size-row* [row*] )
&loop
DUP2 convert-tile-row
write-tile-row ?&ok2 ;msg/write-error !usage &ok2
STH2kr SUB2 GTH2k ?&done !&loop
&done POP2r POP2 POP2 JMP2r
( fields marked "MOD" will be updated; others will stay the same )
@bmp-header
"BM ( 0: identify bitmap )
&total-size 00 00 00 00 ( 2: total file size in bytes, includes header, MOD )
00 00 ( 6: reserved, zero )
00 00 ( 8: reserved, zero )
20 00 00 00 ( 10: pixel data offset, 32 bytes )
0c 00 00 00 ( 14: header size, 12 bytes )
&pixel-w 00 00 ( 18: width in pixels, MOD )
&pixel-h 00 00 ( 20: height in pixels, MOD )
01 00 ( 22: color planes, 1 )
01 00 ( 24: bits per pixel, 1 )
&color0 ff ff ff ( 26: color 0, blue/green/red MOD )
&color1 00 00 00 ( 29: color 1, blue/green/red MOD )
( 32: start of pixel data MOD )
@bmp-buf $7f8
@icn-dat $c000 ( 48k )