Creating a nametable compressor

etc/nametable.tal

@@ -0,0 +1,182 @@
+( nametable )
+
+|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $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
+
+@id $2
+@src $40
+@dst $40
+@buf $10
+@length $2
+
+|0100 ( -> )
+
+	;on-console .Console/vector DEO2
+
+BRK
+
+@on-console ( -> )
+
+	;src STH2
+
+	( read source )
+	.Console/read DEI
+	DUP #20 LTH OVR #7f GTH ORA ,&end JCN
+	STH2kr ;slen JSR2 #003f GTH2 ,&end JCN
+		STH2r ;sput JSR2 BRK
+		&end
+	POP
+
+	( prep destination )
+	;src ;dst ;scpy JSR2
+	;&nmt-ext ;dst ;scat JSR2
+	;dst .File2/name DEO2
+
+	STH2r ;parse-chr JSR2
+
+	( export compressed spritesheet )
+	;&out-ext ;src ;scap JSR2 #0004 SUB2 ;scpy JSR2
+	;src .File2/name DEO2
+	.length LDZ2 .File2/length DEO2
+	;spritesheet .File2/write DEO2
+
+	( halt )
+	#010f DEO
+
+BRK
+	&nmt-ext ".nmt $1
+	&out-ext ".out $1
+
+@parse-chr ( file* -- )
+
+	DUP2 ;print-str JSR2 #0a18 DEO
+	.File1/name DEO2
+	#0010 .File1/length DEO2
+	#0002 .File2/length DEO2
+	&stream
+		;buf .File1/read DEO2
+		;buf ;add-tile JSR2 ,&b STR2
+			;&b .File2/write DEO2
+		.id LDZ2k INC2 ROT STZ2
+		.File1/success DEI2 ORA ,&stream JCN
+
+JMP2r
+	&b $2
+
+@add-tile ( tile* -- addr* )
+
+	.id LDZ2 ;print JSR2 LIT ': #18 DEO #2018 DEO
+	DUP2 ;print-tile JSR2
+
+	( append )
+	.length LDZ2 STH2k ;spritesheet ADD2 #0010 ;mcpy JSR2
+	STH2kr #0010 ADD2 .length STZ2
+
+	;&spacer ;print-str JSR2
+	;&created ;print-str JSR2
+	STH2kr ;print JSR2 #0a18 DEO
+	STH2r
+
+JMP2r
+	&created "(!) $1
+	&spacer "-> 20 $1
+
+@tile-equal ( a* b* -- flag )
+
+	,&a STR2
+	,&b STR2
+	#1000
+	&loop
+		#00 OVR [ LIT2 &a $2 ] ADD2 LDA
+		#00 OVR [ LIT2 &b $2 ] ADD2 LDA
+			EQU ,&continue JCN
+				POP2 #00 JMP2r
+				&continue
+		INC GTHk ,&loop JCN
+	POP2
+	#01
+
+JMP2r
+
+( stdlib )
+
+@slen ( str* -- len* )
+
+	DUP2 ,scap JSR SWP2 SUB2
+
+JMP2r
+
+@scap ( str* -- end* )
+
+	LDAk #00 NEQ JMP JMP2r
+	&while INC2 LDAk ,&while JCN
+
+JMP2r
+
+@sput ( char str* -- )
+
+	,scap JSR STA
+
+JMP2r
+
+@scat ( src* dst* -- )
+
+	DUP2 ,slen JSR ADD2
+
+@scpy ( src* dst* -- )
+
+	STH2
+	&while
+		LDAk STH2kr STA INC2r
+		INC2 LDAk ,&while JCN
+	POP2
+	#00 STH2r STA
+
+JMP2r
+
+@mcpy ( src* dst* len* -- )
+
+	SWP2 STH2
+	OVR2 ADD2 SWP2
+	&loop
+		LDAk STH2kr STA INC2r
+		INC2 GTH2k ,&loop JCN
+	POP2 POP2
+	POP2r
+
+JMP2r
+
+@print ( short* -- )
+
+	SWP ,&byte JSR
+	&byte ( byte -- ) DUP #04 SFT ,&char JSR
+	&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
+
+JMP2r
+
+@print-str ( str* -- )
+
+	&while
+		LDAk .Console/write DEO
+		INC2 LDAk ,&while JCN
+	POP2
+
+JMP2r
+
+@print-tile ( addr* -- )
+
+	STH2
+	#1000
+	&loop
+		#00 OVR STH2kr ADD2 LDA2 ;print JSR2
+		#2018 DEO
+		INC INC GTHk ,&loop JCN
+	POP2
+	POP2r
+
+JMP2r
+
+@spritesheet