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 @File1 &vector $2 &success $2 &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 ( -> )
	( | 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

(
@|vectors )

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

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

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

@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 .File1/name DEO2
	#0012 .File1/length DEO2
	;image .File1/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

@parse-tga ( filter* length* -- )
	#0020 .Screen/x DEO2
	#0020 .Screen/y DEO2
	;image/w LDA2 NIP #10 SFT #10 SUB #f0 AND #06 ORA .Screen/auto DEO
	.File1/length DEO2
	,&filter STR2
	#0000 ,&x STR2
	#0000 ,&y STR2
	&stream ( -- )
		;&pixel STH2k .File1/read DEO2
		[ LIT2 &x $2 ] [ LIT2 &y $2 ] #0007 AND2 STH2r [ LIT2 &filter $2 ] JSR2
		( chr ) set-pixel
		( on linebreak ) ,&x LDR2 INC2 DUP2 ,&x STR2
		;image/w LDA2 NEQ2 ?&no-line
		#0000 ,&x STR2
		,&y LDR2 INC2 ,&y STR2
		( on row ) ,&y LDR2 #0007 AND2 ORA ?&no-row
		;buffer DUP2 .Screen/addr DEO2
		.File2/write DEO2
		#81 .Screen/sprite DEO
		&no-row &no-line .File1/success DEI2 ORA ?&stream
	JMP2r
	&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 JMP2r

@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 ( pixel* -- color )
	LDAk ,&b STR
	INC2 LDAk ,&g STR
	INC2 LDAk ,&r STR
	INC2 LDA ,&a STR
	[ LIT2 00 &r $1 ] [ LIT2 00 &g $1 ] [ LIT2 00 &b $1 ] ADD2 ADD2
	( ) #0003 DIV2 NIP [ LIT &a $1 ] POP #06 SFT JMP2r

@pixel-raw-bw ( pixel* -- 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

(
@|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 )