nxu/icn_to_bmp.tal

( icn_to_bmp.tal )
( )
( converts ICN to BMP )
( limited to 255x255 tiles, i.e. 2040x2040 pixels )
( for now uses black and white for colors 0 and 1. )
( )
( 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
    @in-file $2
    @out-file $2
    @row-size-bytes $2
    @adj-row-size-bytes $2

|0100
    ;after-args #0000 ( stdin: nop ) 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
    &read-error "Failed 20 "to 20 "read 20 "enough 20 "data 00
    &write-error "Failed 20 "to 20 "write 20 "data 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 "icn/bmp 20 "should 20 "be 20 "paths 20 "(that 20 "are 20 "readable/writable) 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 NEQ ?&bad
      #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 #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
    &bad
    validate
    write-header
    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

@start-read ( -> ok^ )
    .in-file LDZ2 .File1/name DEO2
    JMP2r

@read-tile-row ( -> ok^ )
    .row-size-bytes LDZ2 STH2k .File1/len DEO2
    ;icn-buf .File1/r DEO2
    .File1/ok DEI2 STH2r EQU2 JMP2r

@convert-tile-row ( -> )
    ;icn-buf .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 #fff8 ( src* -8* [w* dst*] )
    &loop                         ( src* i* [w* dst*] )
        SWP2 LDAk STH2kr #010e DEO STA      ( i* src* [w* dst*] ; dst<-src )
        OVR2r ADD2r               ( i* src* [w* dst+w*] )
        INC2 SWP2 INC2            ( src+1* i+1* [w* dst+w*] )
        ORAk ?&loop               ( src+1* i+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
    JMP2r

@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    ( )
    .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 ( -> )
    start-read #0000 .tile-h LDZ2 SUB2
    &loop
        read-tile-row ?&ok1 ;msg/read-error !usage &ok1
        convert-tile-row
        write-tile-row ?&ok2 ;msg/write-error !usage &ok2
        INC2 ORAk ?&loop
    JMP2r

@bmp-header
    "BM                     ( 0: identify bitmap )
    &total-size 00 00 00 00 ( 2: total file size in bytes, includes header, TODO )
    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, TODO )
    &pixel-h 00 00          ( 20: height in pixels, TODO )
    01 00                   ( 22: color planes, 1 )
    01 00                   ( 24: bits per pixel, 1 )
    &color0 ff ff ff        ( 26: color 0, rgb, TODO )
    &color1 00 00 00        ( 29: color 1, rgb, TODO )
                            ( 32: start of data, TODO )

@bmp-buf $7f8
@icn-buf $7f8