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 ;dst scpy
	;&chr-ext ;dst scap scpy
	;dst .File2/name DEO2
	;src file-open-tga
	;dst pstr #0a18 DEO

BRK
	&chr-ext ".chr $1

(
@|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
	( | 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
	LIT "( #18 DEO #00
	;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 pstr
	LIT ") #18 DEO #0a18 DEO

	( | get parser )
	;image/image-type LDA
	#02 NEQk NIP ?&no-raw-true
		;pixel-raw-true #0004 parse-tga POP JMP2r
		&no-raw-true
	#03 NEQk NIP ?&no-raw-bw
		;pixel-raw-bw #0001 parse-tga POP JMP2r
		&no-raw-bw

	( | 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 ?&do-set
		( mask ) #0107 ROT #07 AND SUB #40 SFT SFT #ff EOR AND
		( save ) ROT ROT STA
		JMP2r
	&do-set
		( 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
@phex ( short* -- ) SWP ,&b JSR &b ( byte -- ) DUP #04 SFT ,&c JSR &c ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
@skey ( key buf -- proc ) OVR #21 LTH ?&eval #00 SWP sput #00 JMP2r &eval POP2 #01 JMP2r
@scap ( str* -- end* ) LDAk #00 NEQ [ JMP JMP2r ] &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 )