From 750a30c685cbc83eaae8095bb46cb7315fdb6506 Mon Sep 17 00:00:00 2001
From: neauoire <aliceffekt@gmail.com>
Date: Mon, 27 Nov 2023 13:43:11 -0800
Subject: [PATCH] (tgachr) Init

---
 cli/tgachr/build.sh   |  25 ++++++
 cli/tgachr/tgachr.tal | 180 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 205 insertions(+)
 create mode 100755 cli/tgachr/build.sh
 create mode 100644 cli/tgachr/tgachr.tal

diff --git a/cli/tgachr/build.sh b/cli/tgachr/build.sh
new file mode 100755
index 0000000..d301971
--- /dev/null
+++ b/cli/tgachr/build.sh
@@ -0,0 +1,25 @@
+#!/bin/sh -e
+
+ID="tgachr"
+ASM="uxncli $HOME/roms/drifblim.rom"
+EMU="uxncli"
+LIN="uxncli $HOME/roms/uxnlin.rom"
+SRC="${ID}.tal"
+DST="${ID}.rom"
+CPY="$HOME/roms"
+ARG="pict.tga"
+
+if [[ "$*" == *"--lint"* ]]
+then
+	$LIN $SRC
+fi
+
+$ASM $SRC $DST
+
+if [[ "$*" == *"--save"* ]]
+then
+	cp $DST $CPY
+fi
+
+$EMU $DST $ARG
+
diff --git a/cli/tgachr/tgachr.tal b/cli/tgachr/tgachr.tal
new file mode 100644
index 0000000..70f323a
--- /dev/null
+++ b/cli/tgachr/tgachr.tal
@@ -0,0 +1,180 @@
+( uxncli tgachr.rom file.tga )
+
+|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
+|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
+
+|0000
+
+	@src $40
+
+|0100
+
+@on-reset ( -> )
+	.Console/type DEI ?{
+		;dict/usage <perr>
+		#010f DEO
+		BRK }
+	;await-src .Console/vector DEO2
+	BRK
+
+@await-src ( -> )
+	.Console/read DEI .src skey ?on-ready
+	BRK
+
+@on-ready ( -> )
+	;src <pstr>
+	#0a18 DEO
+	#800f DEO
+	BRK
+
+@<save> ( -- )
+	JMP2r
+
+(
+@|tga )
+
+@<open-tga> ( name* -- )
+	.File/name DEO2
+	#0012 .File/length DEO2
+	;tga .File/read DEO2
+	( | update name )
+	;src ;dict/chr-ext OVR2 scap/ #0004 SUB2 <scpy>
+	( | flip endianness )
+	;tga/x STH2k LDA2 SWP STH2r STA2
+	;tga/y STH2k LDA2 SWP STH2r STA2
+	;tga/w STH2k LDA2 SWP STH2r STA2
+	;tga/h STH2k LDA2 SWP STH2r STA2
+	( | get parser )
+	;tga/image-type LDA
+	( ) DUP #02 EQU ?&rawt
+	( ) DUP #03 EQU ?&rawm
+	POP
+	( | error )
+	;&error-txt <pstr>/
+	#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <pstr>/
+	#0a18 DEO
+	JMP2r
+	&rawt ( type -- )
+		POP ;tga-rawt #0004 !parse-tga
+	&rawm ( type -- )
+		POP ;tga-rawm #0001 !parse-tga
+	&error-txt ( err )
+		"Unsupported 20 "image-type: 20 $1
+
+@parse-tga ( filter* length* -- )
+	( | cache size )
+	.File/length DEO2
+	,&filter STR2
+	;tga/w LDA2 ,&w STR2
+	( | paint )
+	#0000 [ LIT2r 0000 ]
+	&stream ( -- )
+		;&pixel feof ?&end
+		STH2kr ;&pixel [ LIT2 &filter $2 ] JSR2 <set-pixel>
+		POP2 INC2 DUP2 [ LIT2 &w $2 ] NEQ2 ?&stream
+	( lb ) POP2 #0000 INC2r !&stream
+	&end POP2 POP2r !<save>
+	&pixel $4
+
+@tga-types-txts &null "missing-type $1
+	&rawc "RAW-color $1
+	&rawt "RAW-true $1
+	&rawm "RAW-mono $1
+	&rlec "RLE-color $1
+	&rlet "RLE-true $1
+	&rlem "RLE-mono $1
+	&void "unknown-type $1
+
+@tga-types [
+	=tga-types-txts/null =tga-types-txts/rawc
+	=tga-types-txts/rawt =tga-types-txts/rawm
+	=tga-types-txts/void =tga-types-txts/void
+	=tga-types-txts/void =tga-types-txts/void
+	=tga-types-txts/void =tga-types-txts/rlec
+	=tga-types-txts/rlet =tga-types-txts/rlem ]
+
+(
+@|filters )
+
+@tga-rawt ( rgba* -- color )
+	STH2
+	( b ) #00 LDAkr STHr INC2r
+	( g ) #00 LDAkr STHr INC2r
+	( r ) #00 LDAr STHr
+	( res ) ADD2 ADD2 #0003 DIV2 NIP #06 SFT #03 SWP SUB JMP2r
+
+@tga-rawm ( grey* -- color )
+	( res ) LDA #06 SFT JMP2r
+
+(
+@|stdlib )
+
+@scap ( str* -- end* )
+	&w ( -- )
+		INC2 & LDAk ?&w
+	JMP2r
+
+@<scpy> ( src* dst* -- )
+	STH2
+	&w ( -- )
+		LDAk #00 STH2kr STA2
+		INC2r INC2 LDAk ?&w
+	POP2 POP2r JMP2r
+
+@sput ( chr str* -- )
+	scap ROT #00 SWP2 STA2
+	JMP2r
+
+@skey ( key buf -- proc )
+	OVR #21 LTH ?&eval
+	#00 SWP sput #00 JMP2r
+	&eval POP2 #01 JMP2r
+
+@feof ( buf* -- eof )
+	.File/read DEO2
+	.File/success DEI2 #0000 EQU2 JMP2r
+
+@<pstr> ( str* -- )
+	&w ( -- )
+		LDAk #18 DEO
+		INC2 & LDAk ?&w
+	POP2 JMP2r
+
+@<perr> ( str* -- )
+	&w ( -- )
+		LDAk #19 DEO
+		INC2 LDAk ?&w
+	POP2 JMP2r
+
+@<emit-long> ( a* b* -> )
+	SWP2 <emit-long>/s
+	&s ( -- )
+		SWP <emit-long>/b
+	&b ( -- )
+		DUP #04 SFT <emit-long>/c
+	&c ( -- )
+		#0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
+		JMP2r
+
+(
+@|memory )
+
+@dict &usage "usage: 20 "checksum.rom 20 "input.bin 0a $1
+	&icn-ext ".icn $1
+	&chr-ext ".chr $1
+	&tga-ext ".tga $1
+
+@tga &id-length $1
+	&color-map $1
+	&image-type $1
+	&map $5
+	&position &x $2
+	&y $2
+	&size &w $2
+	&h $2
+	&depth $1
+	&descriptor $1
+
+@pict
+
+