~aleteoryx/uxn

d1c1ecc89ff04d16a3f36209ce9d59a40a585f19 — Aleteoryx 7 months ago ad6afdf
lzw work
3 files changed, 97 insertions(+), 4 deletions(-)

M gif.tal
A lzw.tal
M mkfile
M gif.tal => gif.tal +3 -3
@@ 44,14 44,14 @@
	INC2 !puts


@gif/chunk &magic $ff
@Gif/chunk &magic $ff
	&screen &wid $2 &hei $2 &pack $1 &bg $1 &aspect $1
	&colortab $300
	
@gif/init ( -- )
@Gif/init ( -- )
	#06 /read
	/magic-ok? ?{ ;errs/corrupt die }
@gif/read ( len* -- )
@Gif/read ( len* -- )
	#00 SWP .File1/length DEO2
	;/chunk .File1/read
	JMP2r

A lzw.tal => lzw.tal +93 -0
@@ 0,0 1,93 @@
|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10 @Console/vector $2 &read $5 &type $1 &write $1 &error $1


%dup3 ( a b c -- a b c a b c ) { ROTk ROT ROT }
%dbg ( -- ) { [ LIT2 01 -System/debug ] DEO }

|100
@on-reset ( -> )
	#ffff #00 LUT/insert POP2
	#ffff LIT "A LUT/insert
	LIT "B LUT/insert LIT "C LUT/insert POP2

	#0002 LIT "C LUT/lookup
	;putc-visitor LUT/visit
	BRK

@putc-visitor ( addr* sym -- )
	.Console/write DEO POP2
	JMP2r

( @LUT )

( visitor is a pointer to a routine of the form ( addr* sym -- ) )
@LUT/visit ( addr* visitor* -- first-byte )
	,/visitor STR2 /walk-up DUP ,/visitret STR
	&visitloop
		[ LIT2 &visitor $2 ] JSR2
		,/buf-prev LDR2
		INC2k ORA ?{ POP2 [ LIT &visitret $1 ] JMP2r }
		/get STH POP2 ,/buf-parent LDR2 STHr ( addr* sym )
		!/visitloop

@LUT/cpybuf
	&buf-prev $2 &buf-parent $2 &buf-sym $1

@LUT/walk-up ( addr* -- addr* sym ) ( routine leaves root node metadata in /cpybuf )
	#ffff SWP2 ( -1* node* )
	&walkloop
		DUP2 />getaddr DUP2 />setaddr
		;/getext .System/expansion DEO2 ( load node info )
		SWP2 ,/buf-prev STR2
		;/setext .System/expansion DEO2 ( save child ptr )

		,/buf-parent LDR2 ( node* new-node* )
		INC2k ORA ?/walkloop
	POP2 ,/buf-sym LDR JMP2r


@LUT/insert ( parent* sym -- addr* )
	,/size LDR2 DUP2 />setaddr
	INC2k ,/size STR2 STH2

	,/buf-sym STR ,/buf-parent STR2
	;/setext .System/expansion DEO2
	STH2r JMP2r

@LUT/get ( addr* -- parent* sym )
	/>getaddr
	;/getext .System/expansion DEO2

	,/buf-parent LDR2 ,/buf-sym LDR
	JMP2r

@LUT/lookup ( parent* sym -- addr* )
	[ LIT2r 0000 ]
	&lookuploop
		dup3
		STH2rk [ LIT2 &size 0000 ]
		LTH2 ?{ POP2r POP2 POP2 POP2 #ffff JMP2r }
		STH2rk /get ( parent1* sym1  parent2* sym2 )
		STH ROT STH NEQ2 NEQr STHr ORA ( parent1 != parent2 || sym1 != sym2 )
		INC2r ?/lookuploop
	POP2 POP STH2r #0001 SUB2 JMP2r

@LUT/>getaddr ( addr* -- )
	DUP2 #3334 DIV2 INC2
	,/getbank STR2
	#0005 MUL2
	,/getaddr STR2
	JMP2r

@LUT/>setaddr ( addr* -- )
	DUP2 #3334 DIV2 INC2
	,/setbank STR2
	#0005 MUL2
	,/setaddr STR2
	JMP2r

@LUT/setext
	01  0005  0000 =/cpybuf  &setbank $2 &setaddr $2
@LUT/getext
	01  0005  &getbank $2 &getaddr $2  0000 =/cpybuf

M mkfile => mkfile +1 -1
@@ 2,7 2,7 @@ roms=\
	arvelie.rom\
	nanpa.rom\
	bfc.rom\
	gif.rom
	lzw.rom

all:VQ: $roms