oquonie/etc/tools/packer.tal

( Packer - Asset Packager )

|10 @Console &vector $2 &read $1 &pad $5 &write $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

@dst $30
@src $40
@size $2

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

	( wait )
	;ready-output .Console/vector DEO2

BRK

(
@|vectors )

@ready-output ( -> )

	.Console/read DEI .dst skey
		?&await

BRK

&await ( -> )

	;dst pstr #0a18 DEO
	;dst .File2/name DEO2
	#01 .File2/delete DEO

	;ready-input .Console/vector DEO2

BRK

@ready-input ( -> )

	.Console/read DEI #0a EQU ?&end

	.Console/read DEI .src skey
		?do-input

BRK

&end

	#010e DEO
	#800f DEO

BRK

@do-input ( -- )

	LIT "> #18 DEO #2018 DEO
	;src file-open-tga
	.size LDZ2
		DUP2 LIT "( #18 DEO phex LIT ") #18 DEO #2018 DEO
		pdec ;&total-txt pstr #0a18 DEO
	;src sclr

BRK
	&total-txt 20 "bytes. $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

	;image/w LDA2 #43 SFT2 .File2/length DEO2

	( print details )

	#00 ;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 pstr

	#2018 DEO
	.image/w LDZ2 pdec LIT "x #18 DEO .image/h LDZ2 pdec #2018 DEO
	pstr #2018 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 )
	;&error-unknown-txt pstr #0a18 DEO

JMP2r
	&error-unknown-txt "Unsupported 20 "tga-type: 20 $1

@parse-tga ( filter* length* -- )

	.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 .File2/write DEO2
				.size LDZ2k .File2/length DEI2 ADD2 ROT STZ2
				&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 ]

	#50 LTH ?&alpha
	DUP #a0 GTH ?&white
	DUP #40 GTH ?&gray
	POP #02

JMP2r

&white POP #03 JMP2r
&gray POP #01 JMP2r

&alpha ( rgb a -- color )

	POP #00

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
@sclr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w STH2k #00 STH2r STA INC2 LDAk ,&w JCN POP2 JMP2r

@scpy ( src* dst* -- )

	STH2
	&w
		LDAk STH2kr STA INC2r
		INC2 LDAk ?&w
	POP2
	#00 STH2r STA

JMP2r

@pdec ( v* -- )

	#00 ,&z STR
	#2710 ,&parse JSR
	#03e8 ,&parse JSR
	#0064 ,&parse JSR
	#000a ,&parse JSR
	NIP
	&emit
		DUP [ LIT &z $1 ] EQU ,&skip JCN
			#ff ,&z STR DUP #30 ADD #18 DEO
			&skip
	POP

JMP2r
	&parse
		DIV2k DUP ,&emit JSR MUL2 SUB2
	JMP2r

(
@|assets )

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