uxn-utils/cli/tgachr/tgachr.tal

( uxncli tgachr.rom file.tga )

|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|10 @Console &vector $2 &read $1 &pad $5 &write $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &chord $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 $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|0000

	@src $40
	@dst $40
	@image &id-length $1 &color-map $1 &image-type $1 &map $5 &x $2 &y $2 &w $2 &h $2 &depth $1 &descriptor $1

|0100

@on-reset ( -> )
	;meta #06 DEO2
	( | theme )
	#26ae .System/r DEO2
	#26ae .System/g DEO2
	#26ae .System/b DEO2
	( | size )
	#0080 .Screen/width DEO2
	#0100 .Screen/height DEO2
	( | wait )
	;await-src .Console/vector DEO2
	BRK

@meta $1
	( name ) "Tgachr 0a
	( desc ) "TGA 20 "to 20 "CHR 20 "Converter 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "18 20 "Dec 20 "2023 $1
	( exts ) 00

(
@|vectors )

@await-src ( -> )
	.Console/read DEI .src skey ?on-ready
	BRK

@on-ready ( -> )
	;src <file-open-tga>
	;dst <pstr>/
	#0a18 DEO
	BRK

@<write-size> ( str* -- )
	STH2
	;image/w LDA2 #03 SFT2 NIP
	( ) DUP #04 SFT hexc STH2kr STA
	INC2r hexc STH2kr STA
	INC2r LIT "x STH2kr STA
	INC2r ;image/h LDA2 #03 SFT2 NIP
	( ) DUP #04 SFT hexc STH2kr STA
	INC2r hexc STH2kr STA
	INC2r #00 STH2r STA
	JMP2r

(
@|tga )

@<file-open-tga> ( path* -- )
	( | header )
	DUP2 .File/name DEO2
	#0012 .File/length DEO2
	;image .File/read DEO2
	( | flip endianness )
	;image/w STH2k LDA2 SWP STH2r STA2
	;image/h STH2k LDA2 SWP STH2r STA2
	( | output path )
	;src ;dst scpy ;dst
	( ) DUP2 scap/ #0004 SUB2 <write-size>
	( ) { ".chr 00 }
	STH2r SWP2 scap/ scpy ;dst .File2/name DEO2
	( | resize )
	;image/w LDA2 #0040 ADD2 .Screen/width DEO2
	;image/h LDA2 #0040 ADD2 .Screen/height DEO2
	;image/w LDA2 #43 SFT2 .File2/length DEO2
	( | print details )
	;src-txt <pstr>
	<pstr>/
	[ LIT2 "( 18 ] DEO
	#00 ;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 <pstr>/
	[ LIT2 ") 18 ] DEO
	#0a18 DEO
	( | get parser )
	;image/image-type LDA #02 NEQk NIP ?{
		;pixel-raw-true #0004 <parse-tga>
		POP JMP2r }
	#03 NEQk NIP ?{
		;pixel-raw-bw #0001 <parse-tga>
		POP JMP2r }
	( | error )
	;&err <pstr>
	#0a18 DEO
	JMP2r
	&err "Unsupported 20 "tga-type: 20 $1

@<draw-row> ( -- )
	#2000
	&l ( -- )
		[ LIT2 81 -Screen/sprite ] DEO
		INC GTHk ?&l
	POP2
	( | move down )
	#0020 .Screen/x DEO2
	.Screen/y DEI2k #0008 ADD2 ROT DEO2
	JMP2r

@<parse-tga> ( filter* length* -- )
	#0020 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	[ LIT2 05 -Screen/auto ] DEO
	.File/length DEO2
	,&filter STR2
	#0000 ,&x STR2
	#0000 ,&y STR2
	&stream ( -- )
		;&pixel .File/read DEO2
		.File/success-lb DEI ?{ JMP2r }
		[ LIT2 &x $2 ] [ LIT2 &y $2 ] #0007 AND2 ;&pixel [ LIT2 &filter $2 ] JSR2 <set-pixel>
		( on linebreak ) ,&x LDR2 INC2 DUP2 ,&x STR2
		;image/w LDA2 NEQ2 ?&stream
	#0000 ,&x STR2
	,&y LDR2 INC2 ,&y STR2
	( on row ) ,&y LDR2 #0007 AND2 ORA ?&stream
	;buffer DUP2 .Screen/addr DEO2
	.File2/write DEO2
	<draw-row>
	!&stream
	&pixel $4

(
@|tools )

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

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

@pixel-raw-true ( x* y* addr* -- x* y* color )
	LDAk ,&b STR
	INC2 LDAk ,&g STR
	INC2 LDAk ,&r STR
	INC2 LDA ,&a STR
	EOR2k NIP #01 AND STH
	[ LIT2 00 &r $1 ] [ LIT2 00 &g $1 ] ADD2 [ LIT2 00 &b $1 ] ADD2
	( ) #0003 DIV2 NIP [ LIT &a $1 ] POP #05 SFT
	( dither ) STHr ADD #01 SFT
	( max ) #03 LTHk [ JMP SWP POP ]
	JMP2r

@pixel-raw-bw ( x* y* addr* -- x* y* color )
	( res ) LDA JMP2r

(
@|stdlib )

@<pstr> ( str* -- )
	&w ( -- )
		LDAk #18 DEO
		INC2 & LDAk ?&w
	POP2 JMP2r

@skey ( key buf -- proc )
	OVR #21 LTH ?{
		#00 SWP sput #00 JMP2r }
	POP2 #01 JMP2r

@scap ( str* -- end* )
	&w ( -- )
		INC2 & LDAk ?&w
	JMP2r

@sput ( chr str* -- )
	scap/ STA
	JMP2r

@slen ( str* -- len* )
	DUP2 scap/ SWP2 SUB2 JMP2r

@scpy ( src* dst* -- )
	STH2
	&w ( -- )
		LDAk STH2kr STA
		INC2r INC2 LDAk ?&w
	POP2 #00 STH2r STA
	JMP2r

@hexc ( hex -- char )
	#0f AND DUP #09 GTH #27 MUL ADD #30 ADD JMP2r

(
@|assets )

@src-txt
	"Parsing 20 $1

@image-types-txts &no-image "no-data $1
	&raw-color "RAW-color $1
	&raw-true "RAW-true $1
	&raw-bw "RAW-bw $1
	&rle-color "RLE-color $1
	&rle-true "RLE-true $1
	&rle-bw "RLE-bw $1
	&unknown "unknown $1

@image-types [
	=image-types-txts/no-image =image-types-txts/raw-color
	=image-types-txts/raw-true =image-types-txts/raw-bw
	=image-types-txts/unknown =image-types-txts/unknown
	=image-types-txts/unknown =image-types-txts/unknown
	=image-types-txts/unknown =image-types-txts/rle-color
	=image-types-txts/rle-true =image-types-txts/rle-bw ]

@buffer ( A row chr tiles for the width of the image )