uxn-utils/gui/sixels/icnsix.tal

|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 ( -> )
	;on-console .Console/vector DEO2
	BRK

@on-console ( -> )
	.Console/read DEI DUP #20 LTH OVR #7f GTH ORA ?{
		;src scap STA
		BRK }
	POP
	( | get size )
	;src scap #0009 SUB2 parse-size
	( h ) ;img/height STA
	( w ) ;img/width STA
	( | get data )
	;src .File/name DEO2
	#00 ;img/width LDA #00 ;img/height LDA #30 SFT2 MUL2 .File/length DEO2
	;img/data .File/read DEO2
	<convert>
	#800f DEO
	BRK

@parse-size ( 00x00* -- w h )
	DUP2 sbyte #00 EQU ?&cancel
	INC2k INC2 LDA LIT "x NEQ ?&cancel
	INC2k INC2 INC2 sbyte #00 EQU ?&cancel
	( y ) INC2k INC2 INC2 sbyte STH
	( x ) sbyte STHr JMP2r
	&cancel POP2 #0000 JMP2r

(
@| core )

@<convert> ( -- )
	#00 ;img/height LDA #30 SFT2 #0000
	&v ( -- )
		STH2k #00 ;img/width LDA #30 SFT2 #0000
	&w ( -- )
		( | rle )
		DUP2 STH2kr get-rle DUP2 #0003 LTH2 ?{
			( rune ) [ LIT2 "! 18 ] DEO
			( dec ) DUP2 pdec
			( sixel ) OVR2 STH2kr get-sixel #18 DEO
			ADD2 !& }
		POP2 DUP2 STH2kr get-sixel #18 DEO
		INC2 & GTH2k ?&w
	POP2 POP2 POP2r [ LIT2 "- 18 ] DEO
	#0006 ADD2 GTH2k ?&v
	POP2 POP2 JMP2r

@get-sixel ( x* y* -- byte )
	( acc ) [ LITr 00 ] ,&y STR2
	,&x STR2
	#0006 #0000
	&l ( -- )
		( acc ) [ LITr 10 ] SFTr
		( get ) [ LIT2 &x $2 ] OVR2 #0005 SWP2 SUB2 [ LIT2 &y $2 ] ADD2
		( res ) get-pixel STH ORAr
		( ) INC2 GTH2k ?&l
	POP2 POP2 STHr [ LIT "? ] ADD JMP2r

@get-row ( x* y* -- row* )
	STH2k
	( ) #03 SFT2 SWP2
	( ) #03 SFT2 SWP2
	( ) #00 ;img/width LDA MUL2 ADD2 #30 SFT2
	( ) STH2r #0007 AND2 ADD2
	( ) ;img/data ADD2 JMP2r

@get-pixel ( x* y* -- b )
	( keep x* ) OVR2 NIP #07 AND STH
	( get byte ) get-row LDA
	( flag ) #07 STHr SUB SFT #01 AND JMP2r

@get-rle ( x* y* -- count* )
	( acc ) [ LIT2r 0001 ]
	( target ) OVR2 OVR2 get-sixel ,&t STR
	,&y STR2
	INC2 #00 ;img/width LDA #30 SFT2 SWP2
	&l ( -- )
		DUP2 [ LIT2 &y $2 ] get-sixel [ LIT &t $1 ] NEQ ?&end
		INC2r INC2 GTH2k ?&l
	&end ( -- )
		POP2 POP2 STH2r JMP2r

(
@|stdlib )

@sbyte ( str* -- byte )
	( hn ) LDAk chex #40 SFT STH INC2
	( ln ) LDA chex STHr ORA JMP2r

@chex ( c -- val? )
	( dec ) [ LIT "0 ] SUB DUP #09 GTH ?{ JMP2r }
	( hex ) #27 SUB DUP #0f GTH ?{ JMP2r }
	( err ) POP #ff JMP2r

@scap ( str* -- end* )
	LDAk #00 NEQ [ JMP JMP2r ] &w INC2 LDAk ?&w
	JMP2r

@pdec ( short* -- )
	#2710 [ LIT2r 00fb ]
	&w ( -- )
		DIV2k #000a DIV2k MUL2 SUB2 SWPr EQUk OVR STHkr EQU AND ?{
			DUP [ LIT "0 ] ADD #18 DEO
			INCr }
		POP2 #000a DIV2 SWPr INCr STHkr ?&w
	POP2r POP2 POP2 JMP2r

(
@|memory )

@img ( )
	&size &width $1
	&height $1
	&data