( uxncli tgachr.rom img.tga
| output img20x10.chr )

|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|a0 @File/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0 @File2/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|000

	@src/buf $40
	@dst/buf $40
	@size $2

|100

@on-reset ( -> )
	.Console/type DEI ?{
		;dict/usage str/<print>
		#010f DEO
		BRK }
	;src/on-console .Console/vector DEO2
	BRK

@src/on-console ( -> )
	[ LIT2 02 -Console/type ] DEI LTH ?{ /<push>
		BRK }
	;&buf tga/<parse>
	#800f DEO
	BRK

@src/<push> ( c -- )
	.Console/read DEI [ LIT &ptr -&buf ] INCk ,&ptr STR
	STZ
	JMP2r

@dst/<set-size> ( w h -- )
	[ LIT2 fc _&ptr ] LDR ADD ,&ptr STR
	SWP /<push-byte>
	LIT "x /<push>
	/<push-byte>
	;dict/chr-ext
	( >> )

@dst/<push-str> ( str* -- )
	&>w
		LDAk DUP ?{ POP POP2 JMP2r }
		/<push>
		INC2 !&>w

@dst/<push-byte> ( b -- )
	DUP #04 SFT /<push-nibble>
	( >> )

@dst/<push-nibble> ( n -- )
	#00 SWP #0f AND ;&lut ADD2 LDA
	( >> )

@dst/<push> ( c -- )
	[ LIT &ptr -&buf ] INCk ,&ptr STR
	STZ
	JMP2r

	&lut "0123456789abcdef

(
@|Core )

@tga/<parse> ( path* -- )
	DUP2 dst/<push-str>
	.File/name DEO2
	#0012 .File/length DEO2
	;&head .File/read DEO2
	( | flip endianness )
	;&w LDA2k SWP SWP2 STA2
	;&h LDA2k SWP SWP2 STA2
	/get-size dst/<set-size>
	( | set buffer length )
	;dst/buf .File2/name DEO2
	;&w LDA2 #43 SFT2 .File2/length DEO2
	( | get parser )
	;&image-type LDA
	( | handlers )
	DUP #02 NEQ ?{ POP ;filter/raw-true #0003 !/<apply> }
	DUP #03 NEQ ?{ POP ;filter/raw-bw #0001 !/<apply> }
	( error ) ;&error-txt !str/<print>

	&error-txt "Unsupported 20 "tga-type: 20 00

@tga/<apply> ( filter* length* -- )
	.File/length DEO2
	,&filter STR2
	#0000 ,&x STR2
	#0000 ,&y STR2
	&>stream
		;&pixel STH2k .File/read DEO2
		[ LIT2 &x $2 ] [ LIT2 &y $1 &y-lb $1 ] STH2r [ LIT2 &filter $2 ] JSR2
		( chr ) #ff SWP SUB pixel/<set>
		( | on linebreak )
		,&x LDR2 INC2 DUP2 ,&x STR2
		;&w LDA2 NEQ2 ?{
			#0000 ,&x STR2
			[ LIT2 07 _&y-lb ] LDR INC AND DUP ,&y-lb STR
			?{
				;&buffer .File2/write DEO2
				.size LDZ2k .File2/length DEI2 ADD2 ROT STZ2 } }
		.File/success DEI2 ORA ?&>stream
	JMP2r
	&pixel $4

@pixel/assoc-color ( color -- color )
	DUP #10 LTH ?{
		DUP #80 LTH ?{
			#e0 LTH ?{ #03 JMP2r }
			#01 JMP2r }
		POP #02 JMP2r }
	POP #00 JMP2r

@pixel/<set> ( x* y* color -- )
	/assoc-color STH
	OVR2 SWP2
	( get addr ) DUP2 #0007 AND2 SWP2 #83 SFT2 ADD2 SWP2 #43 SFT2 ADD2 ;tga/buffer ADD2
	( ch1 ) OVR2 OVR2 STHkr #01 /<toggle>
	( ch2 ) #0008 ADD2 STHr #00
	( >> )

@pixel/<toggle> ( x* addr* color ch -- )
	STH2
	LDAk STH
	SWP2 NIP STHr SWP SFTr STHr #01 AND ?{
		( mask ) #0107 ROT #07 AND SUB #40 SFT SFT #ff EOR AND
		( save ) ROT ROT STA
		JMP2r }
	#0107 ROT #07 AND SUB #40 SFT SFT ORA
	( save ) ROT ROT STA
	JMP2r

@filter/raw-true ( pixel* -- color )
	STH2
	( b ) #00 LDAkr STHr INC2r
	( g ) #00 LDAkr STHr INC2r
	( r ) #00 LDAr STHr
	( res ) ADD2 ADD2 #0003 DIV2 NIP JMP2r

@filter/raw-bw ( pixel* -- color )
	LDA JMP2r

@tga/get-size ( -- w h )
	( w ) ;&w LDA2 #03 SFT2 NIP
	( h ) ;&h LDA2 #03 SFT2 NIP JMP2r

(
@|Stdlib )

@str/<print> ( str* -- )
	LDAk DUP ?{ POP POP2 JMP2r }
	#18 DEO
	INC2 !/<print>

@dict/usage "usage: 20 "tgachr.rom 20 "input.tga 0a00
	&chr-ext ".chr 00

(
@|Buffers )

@tga/head [
	&id-length $1 &color-map $1
	&image-type $1 &map $5
	&_x $2 &_y $2
	&w $2 &h $2
	&depth $1 &descriptor $1 ]

@tga/buffer