uxn-utils/gui/m291/src/m291.tal

( Well, I wasn't going to call it m7b )

|10 @Console &vector $2
|12 &read $1
|17 &type $1
|18 &write $1
|19 &error $1
|1c &addr $2
|1e &mode $1
|1f &exec $1
|00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &chord $1 &pad $4 &scrolly &scrolly-hb $1 &scrolly-lb $1
|a0 @File &vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|000

	@misc $1
	@selection $1 &mod $1
	@path $2 &null $80
	@lines &folders $1 &roms $1 &misc $1
	@playing $1
	@secfrom $2
	@secto $2

|100

@on-reset ( -> )
	;meta #06 DEO2
	( | theme )
	#d2d2 DUP2 .System/r DEO2
	DUP2 .System/g DEO2
	.System/b DEO2
	<load-theme>
	( | size )
	#0100 .Screen/width DEO2
	( | .. )
	message/<new>
	;dict/mpg-cmd .Console/addr DEO2
	[ LIT2 03 -Console/mode ] DEO
	[ LIT2 01 -Console/exec ] DEO
	[ LIT2 00 -playing ] STZ
	;dict/home-path set-path <refresh-dir>
	( | unlock )
	;on-mouse .Mouse/vector DEO2
	;on-control .Controller/vector DEO2
	;on-console .Console/vector DEO2
	BRK

@meta $1
	( name ) "m291 0a
	( desc ) "Audio 20 "Player 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "25 20 "Aug 20 "2024 $2

(
@|vectors )

@on-console ( -> brk )
	[ LIT2 01 -Console/type ] DEI EQU ?{ BRK }
	[ LIT2 0a -Console/read ] DEI EQUk ?{ message/<append>
		POP BRK }
	POP2 message/<parse>
	BRK

@on-mouse ( -> )
	#c1 ;touch-chr/down ;touch-chr .Mouse/state DEI ?{ SWP2 }
	POP2 <update-cursor>
	.Mouse/y DEI2 DUP2 #0014 LTH2 ?&status-bar
	<y-id>
	.Mouse/state DEI DUP ?{ POP <select>
		BRK }
	#01 GTH .selection/mod STZ
	<pick>
	[ LIT2 00 -Mouse/state ] DEO
	BRK

	&status-bar ( y* -> )
	POP2 BRK

@on-control ( -> )
	( | mod )
	[ LIT2 04 -Controller/button ] DEI AND #00 NEQ .selection/mod STZ
	( | key )
	.Controller/key DEI
	( esc ) DUP #1b NEQ ?{ <escape> }
	( tab ) DUP #09 NEQ ?{ <toggle-misc> }
	( enter ) DUP #0d NEQ ?{ .selection LDZ <pick> }
	POP
	( | button )
	.Controller/button DEI
	( up ) DUP #10 NEQ ?{ #ff <move> }
	( down ) DUP #20 NEQ ?{ #01 <move> }
	( A ) DUP #01 NEQ ?{ .selection LDZ <pick> }
	POP BRK

(
@|message )

@message/<parse> ( -- )
	#00 /<append>
	( | parse line )
	;&buf LDAk [ LIT "@ ] EQU ?{ POP2 JMP2r }
	INC2 LDAk
	( | route )
	DUP [ LIT "S ] EQU ?handle-status
	DUP [ LIT "F ] EQU ?handle-frame
	DUP [ LIT "I ] EQU ?handle-id3
	POP
	( | not-handled )
	<perr>
	#0a19 DEO
	( >> )

@message/<new> ( -- )
	( reset ) ;&buf ,&ptr STR2
	JMP2r

@message/<append> ( c -- )
	[ LIT2 &ptr =&buf ] INC2k ,&ptr STR2
	STA
	JMP2r

(
@|timestamp ) ( returns value between 0000 and 00d0 )

@calc-width ( total* curr* -- width* )
	STH2
	DUP2 #013c LTH2 ?&ready
	&scale ( -- )
	DUP2 #0277 LTH2 ?&almost
	#01 SFT2 LITr 01 SFT2r !&scale
	&almost INC2 #01 SFT2 INC2r LITr 01 SFT2r
	&ready ( -- )
	LIT2r 00d0 MUL2r STH2r SWP2 DIV2 JMP2r

(
@|events )

@handle-status ( buf* char -- )
	[ LIT2 01 -playing ] STZ
	#ffff ;<draw-timestamp>/last STA2
	fit-window POP <perr>
	#0a19 DEO
	<draw-player> !message/<new>

@handle-frame ( buf* char -- )
	POP
	( skip key ) #0003 ADD2
	( skip curr-frame ) #20 find-next INC2
	( skip next-frame ) #20 find-next INC2
	( | <curr-secs> )
	parse-dec STH2k .secfrom STZ2
	INC2 LDAk [ LIT "5 ] LTH ?{ INC2r }
	#20 find-next INC2
	( | <remaining-secs> )
	parse-dec STH2k .secto STZ2
	INC2 LDAk [ LIT "5 ] LTH ?{ INC2r }
	POP2 STH2r STH2r SWP2 OVR2 ADD2 SWP2
	( | print )
	calc-width <draw-progress> !message/<new>

@handle-id3 ( buf* char -- )
	POP <perr>
	#0a19 DEO !message/<new>

(
@|core )

@<y-id> ( y* -- id )
	[ LIT2 00 -playing ] LDZ EQU ?{ #0080 SUB2 }
	#0014 SUB2
	( | above )
	DUP2 #8000 GTH2 ?&outside
	( | spacer )
	has-spacer #00 EQU ?{
		DUP2 [ LIT2 00 -lines/folders ] LDZ #40 SFT2 SUB2 #0008 LTH2 ?&outside
		DUP2 [ LIT2 00 -lines/folders ] LDZ #40 SFT2 GTH2 #00 SWP #30 SFT2 SUB2 }
	#04 SFT2 NIP
	( | below )
	DUP count-lines LTH ?{ POP #ff }
	JMP2r

	&outside ( y* -- id )
	POP2 #ff JMP2r

@<refresh-dir> ( -- )
	;path .File/name DEO2
	#0800 .File/length DEO2
	;mem/dir .File/read DEO2
	( | clean )
	[ LIT2 00 -lines/folders ] STZ
	[ LIT2 00 -lines/roms ] STZ
	[ LIT2 00 -lines/misc ] STZ
	( | parse )
	;mem/dir
	&w ( -- )
	DUP2 <parse-line>
	lcap/ INC2 LDAk ?&w
	POP2
	( >> )

@fit-window ( -- )
	#00 count-lines
	( empty ) DUP #00 EQU ADD #40 SFT2
	( no-folder spacer ) has-spacer #00 EQU ?{ #0008 ADD2 }
	( padding ) #0020 ADD2
	( playing ) [ LIT2 00 -playing ] LDZ EQU ?{ #0080 ADD2 }
	.Screen/height DEO2 !<redraw>

@<parse-line> ( line* -- )
	#0005 ADD2 LDAk [ LIT ". ] EQU ?&hidden
	is-folder ?&folder
	is-mp3 ?&mp3
	;mem/misc [ LIT2 00 -lines/misc ] LDZ #40 SFT2 ADD2 <lcpy>
	.lines/misc LDZ INC .lines/misc STZ
	JMP2r

	&folder ( line* -- )
	;mem/folders [ LIT2 00 -lines/folders ] LDZ #40 SFT2 ADD2 <lcpy>
	.lines/folders LDZ INC .lines/folders STZ
	JMP2r

	&mp3 ( line* -- )
	;mem/roms [ LIT2 00 -lines/roms ] LDZ #40 SFT2 ADD2 <lcpy>
	.lines/roms LDZ INC .lines/roms STZ
	JMP2r

	&hidden ( line* -- )
	POP2 JMP2r

@<move> ( mod -- )
	.selection LDZ ADD INCk ?{
		POP count-lines #01 SUB !<select> }
	count-lines DIVk MUL SUB
	( >> )

@<select> ( id -- )
	[ LIT &last ff ] NEQk ?{ POP2 JMP2r }
	POP DUP ,&last STR
	.selection STZ !<redraw>

@<pick> ( alt id -- )
	DUP .lines/folders LDZ LTH ?&folder
	.lines/folders LDZ SUB DUP .lines/roms LDZ LTH ?&roms
	.lines/roms LDZ SUB DUP .lines/misc LDZ LTH ?&misc
	POP JMP2r

	&roms ( id -- )
	#00 SWP #40 SFT2 ;mem/roms ADD2 !<send-load>

	&misc ( id -- )
	#00 SWP #40 SFT2 ;mem/misc ADD2 !<send-load>

	&folder ( id -- )
	#00 SWP #40 SFT2 ;mem/folders ADD2 !<enter>

@<send-load> ( file* -- )
	;dict/load-cmd <pstr>
	;path <pstr>
	<pstr>/
	#0a18 DEO
	JMP2r

@<enter> ( folder* -- )
	.selection/mod LDZ ?&special
	push-path !<refresh-dir>

	&special ( folder* -- )
	;path <pstr>
	<pstr>/
	#0a18 DEO
	JMP2r

@<leave> ( -- )
	pop-path !<refresh-dir>

@<escape> ( -- )
	;path/null LDA ?<leave>
	JMP2r

@<toggle-misc> ( -- )
	[ LIT2 00 -misc ] LDZ EQU .misc STZ !fit-window

@count-lines ( -- lines )
	.lines/folders LDZ .lines/roms LDZ ADD
	( ) [ LIT2 00 -misc ] LDZ EQU ?{ .lines/misc LDZ ADD }
	JMP2r

@has-spacer ( -- f )
	[ LIT2 00 -lines/folders ] LDZ NEQ
	( ) [ LIT2 00 -lines/roms ] LDZ NEQ
	( ) [ LIT2 00 -misc ] LDZ EQU ?{
		[ LIT2 00 -lines/misc ] LDZ NEQ ORA }
	AND JMP2r

@is-folder ( line* -- line* f )
	DUP2 lcap/ #0001 SUB2 LDA [ LIT "/ ] EQU JMP2r

@is-mp3 ( line* -- line*f )
	DUP2 lcap/ #0003 SUB2 ;dict/mp3-ext !scmp3

(
@|path )

@set-path ( path* -- )
	;path !<scpy>

@push-path ( subpath* -- )
	;path scap/ !<scpy>

@pop-path ( -- )
	;path scap/ #0001 SUB2
	&w ( -- )
	;path/null LDA ?{ POP2 JMP2r }
	#0001 SUB2 LDAk [ LIT "/ ] NEQ ?{
		LITr 00 STH2
		INC2r STAr
		JMP2r }
	!&w

(
@|drawing )

@<redraw> ( -- )
	( | clear )
	#0000 .Screen/x DEO2
	#0018 [ LIT2 00 -playing ] LDZ EQU ?{ #0080 ADD2 }
	.Screen/y DEO2
	[ LIT2 80 -Screen/pixel ] DEO
	( | status )
	#0008 .Screen/x DEO2
	#0004 .Screen/y DEO2
	;path #01 <draw-uf2>
	( | spacer )
	#0014 .Screen/y DEO2
	;line-icn <draw-spacer>
	( | content )
	#001c [ LIT2 00 -playing ] LDZ EQU ?{ #0080 ADD2 }
	.Screen/y DEO2
	( | empty )
	count-lines ?{
		#0008 .Screen/x DEO2
		;dict/empty #0f !<draw-uf2> }
	( | folders )
	;mem/folders .lines/folders LDZ #01 .selection LDZ <draw-list>
	[ LIT2 00 -lines/folders ] LDZ EQU ?{ ;dash-icn <draw-spacer> }
	;mem/roms .lines/roms LDZ #00 .selection LDZ .lines/folders LDZ SUB <draw-list>
	[ LIT2 00 -misc ] LDZ EQU ?{
		;mem/misc .lines/misc LDZ #00 .selection LDZ !<draw-list> }
	JMP2r

@<draw-player> ( -- )
	#0080 .Screen/x DEO2
	#0020 .Screen/y DEO2
	;placeholder/track #01 <draw-uf2-center>
	#0080 .Screen/x DEO2
	#0030 .Screen/y DEO2
	;placeholder/artist #01 <draw-uf2-center>
	#0080 .Screen/x DEO2
	#0040 .Screen/y DEO2
	;placeholder/album #01 <draw-uf2-center>
	#0070 .Screen/x DEO2
	#0058 .Screen/y DEO2
	[ LIT2 36 -Screen/auto ] DEO
	;button-icn .Screen/addr DEO2
	[ LIT2 01 -Screen/sprite ] DEOk DEOk DEOk DEO
	( fill width ) #00e7
	( >> )

@<draw-progress> ( width* -- )
	[ LIT2 01 -Screen/auto ] DEO
	#0004 .Screen/x DEO2
	#0088 .Screen/y DEO2
	( | cap left )
	;progress-icn/left .Screen/addr DEO2
	[ LIT2 01 -Screen/sprite ] DEO
	( | fill )
	#e3
	&>t ( -- )
		;progress-icn/middle .Screen/addr DEO2
		[ LIT2 01 -Screen/sprite ] DEO
		INC DUP ?&>t
	POP
	( | cap right )
	;progress-icn/right .Screen/addr DEO2
	[ LIT2 01 -Screen/sprite ] DEO
	( | fill )
	#0008 .Screen/x DEO2
	[ LIT2 00 -Screen/auto ] DEO
	;progress-icn/fill .Screen/addr DEO2
	#0000
	&>l ( -- )
		[ LIT2 05 -Screen/sprite ] DEO
		.Screen/x DEI2 INC2 .Screen/x DEO2
		INC2 GTH2k ?&>l
	POP2 POP2
	( >> )

@<draw-timestamp> ( -- )
	.secfrom LDZ2
	( | catch redraws )
	DUP2 [ LIT2 &last $2 ] NEQ2 ?{ POP2 JMP2r }
	DUP2 ,&last STR2
	( | from )
	[ LIT2 15 -Screen/auto ] DEO
	#0008 .Screen/x DEO2
	#0070 .Screen/y DEO2
	#01 ;<draw-glyph>/color STA
	<draw-time>
	( | to )
	[ LIT2 15 -Screen/auto ] DEO
	#8000 .Screen/x DEO2
	#0070 .Screen/y DEO2
	.secto LDZ2 .Screen/width DEI2 OVR2 <draw-time>
	.Screen/x DEI2 #7ff8 SUB2 SUB2 .Screen/x DEO2
	#01 ;<draw-glyph>/color STA
	( >> )

@<draw-time> ( time* -- )
	( x0:00:00 ) DUP2 #8ca0 DIV2 NIP <draw-dec>
	( 0x:00:00 ) DUP2 #0e10 DIV2 NIP <draw-dec>
	[ LIT ": ] <draw-glyph>
	( 00:x0:00 ) DUP2 #0258 DIV2 NIP <draw-dec>
	( 00:0x:00 ) DUP2 #003c DIV2 NIP <draw-dec>
	[ LIT ": ] <draw-glyph>
	( 00:00:x0 ) DUP2 #000a DIV2 NIP <draw-dec>
	( 00:00:0x ) NIP
	( >> )

@<draw-dec> ( value -- )
	#0a DIVk MUL SUB [ LIT "0 ] ADD !<draw-glyph>

@<draw-spacer> ( addr* -- )
	#0000 .Screen/x DEO2
	.Screen/addr DEO2
	[ LIT2 f2 -Screen/auto ] DEO
	[ LIT2 05 -Screen/sprite ] DEOk #0080 .Screen/x DEO2
	.Screen/y DEI2 #0008 SUB2 .Screen/y DEO2
	DEO
	JMP2r

@<draw-background> ( -- )
	#0000 .Screen/x DEO2
	.Screen/y DEI2
	( ) ;fill-icn .Screen/addr DEO2
	[ LIT2 f2 -Screen/auto ] DEO
	[ LIT2 01 -Screen/sprite ] DEOk DEOk
	( | .. )
	.Screen/x DEI2 #0080 ADD2 .Screen/x DEO2
	.Screen/y DEI2 #0010 SUB2 .Screen/y DEO2
	DEOk DEO
	.Screen/y DEO2
	JMP2r

@<draw-list> ( addr* length folder selection -- )
	,&sel STR
	,&folder STR
	DUP ?{ POP2 POP JMP2r }
	#0008 .Screen/x DEO2
	#00 SWP2 ,&t STR2
	&>l ( -- )
		[ LITr 05 ]
		( | selected )
		DUP [ LIT &sel $1 ] NEQ ?{
			POPr [ LITr 06 ] <draw-background> }
		( | folder )
		[ LIT2 00 &folder $1 ] EQU ?{
			.Screen/y DEI2 [ LIT2 15 -Screen/auto ] DEO
			.Screen/width DEI2 #0010 SUB2 .Screen/x DEO2
			[ LIT2 00 "> ] #20 SUB #50 SFT2 ;font/glyphs ADD2 .Screen/addr DEO2
			DUPr [ LITr -Screen/sprite ] DEOkr
			DEOr
			.Screen/y DEO2 }
		( | normal )
		#0008 .Screen/x DEO2
		#00 OVR #40 SFT2 [ LIT2 &t $2 ] ADD2 STHr <draw-uf2>
		.Screen/y DEI2k #0010 ADD2 ROT DEO2
		INC GTHk ?&>l
	POP2 JMP2r

@get-uf2-width ( text* -- width* )
	[ LIT2r 0000 ]
	&>while ( -- )
		LDAk #20 SUB #0000 ROT ;font ADD2 LDA STH2
		ADD2r INC2 LDAk ?&>while
	POP2 STH2r JMP2r

@<draw-uf2-right> ( text* color -- )
	STH
	.Screen/x DEI2 OVR2 get-uf2-width SUB2 .Screen/x DEO2
	STHr !<draw-uf2>

@<draw-uf2-center> ( text* color -- )
	STH
	.Screen/x DEI2 OVR2 get-uf2-width #01 SFT2 SUB2 .Screen/x DEO2
	STHr
	( >> )

@<draw-uf2> ( text* color -- )
	,<draw-glyph>/color STR
	[ LIT2 15 -Screen/auto ] DEO
	&>w ( -- )
		LDAk #1f GTH ?{ POP2 JMP2r }
		LDAk <draw-glyph>
		INC2 !&>w

@<draw-glyph> ( char -- )
	#20 SUB #00 SWP
	( ) DUP2 #50 SFT2 ;font/glyphs ADD2 .Screen/addr DEO2
	( ) ;font ADD2 LDA #00 SWP .Screen/x DEI2 ADD2
	( ) [ LIT &color 05 ] .Screen/sprite DEOk DEO
	.Screen/x DEO2
	JMP2r

@<update-cursor> ( color addr* -- )
	;fill-icn .Screen/addr DEO2
	#40 <draw-cursor>
	.Screen/addr DEO2
	.Mouse/x DEI2 ,<draw-cursor>/x STR2
	.Mouse/y DEI2 ,<draw-cursor>/y STR2
	( >> )

@<draw-cursor> ( color -- )
	[ LIT2 16 -Screen/auto ] DEO
	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	.Screen/sprite DEOk DEO
	JMP2r

(
@|helpers )

@find-next ( buf* c -- index* )
	,&t STR
	&>loop ( -- )
		LDAk [ LIT &t $1 ] EQU ?{ INC2 !&>loop }
	JMP2r

@parse-dec ( buf* -- end* res* )
	[ LIT2r 000a ] [ LIT2r 0000 ]
	&>loop ( -- )
		LDAk [ LIT "0 ] SUB DUP #09 GTH ?{
			OVR2r MUL2r #00 SWP STH2
			ADD2r INC2 !&>loop }
	POP STH2r POP2r JMP2r

(
@|stdlib )

@scap ( str* -- end* )

	&w ( -- )
	INC2 & LDAk ?&w
	JMP2r

@scmp3 ( a* b* -- f )
	STH2
	LDAkr LDAk STHr NEQ ?{ INC2r INC2 }
	LDA2r LDA2 STH2r EQU2 JMP2r

@lcap ( str* -- next-line* )

	&w ( -- )
	LDAk #0a EQU ?{ INC2 & LDAk ?&w }
	JMP2r

@<lcpy> ( src* dst* -- )
	STH2
	&w ( -- )
	LDAk #1f GTH ?{
		POP2 #00 STH2r STA
		JMP2r }
	LDAk #00 STH2kr STA2
	INC2r INC2 !&w

@<scpy> ( src* dst* -- )
	STH2
	&w ( -- )
	LDAk #00 STH2kr STA2
	INC2r INC2 LDAk ?&w
	POP2 POP2r JMP2r

@<pstr> ( str* -- )
	LDAk #18 DEO
	INC2 & LDAk ?<pstr>
	POP2 JMP2r

@<perr> ( str* -- )
	LDAk #19 DEO
	INC2 & LDAk ?<perr>
	POP2 JMP2r

@<phex> ( short* -: )
	SWP /b
	&b ( byte -: )
	DUP #04 SFT /c
	&c ( byte -: )
	#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #19 DEO
	JMP2r

(
@|theme )

@<load-theme> ( -- )
	;&path .File/name DEO2
	#0002 .File/length DEO2
	[ LIT2 -System/debug -System/r ]
	&l ( -- )
	;&buf .File/read DEO2
	[ LIT2 00 -File/success-lb ] DEI EQU ?{
		[ LIT2r &buf $2 ] STHk DEO2r
		INC INC NEQk ?&l }
	POP2 JMP2r

	&path ".theme $1

(
@|assets )

@dict
	&home-path "./ $1
	&mp3-ext "mp3 $1
	&empty "(empty) $1
	&mpg-cmd "mpg123 20 "-R $1
	&load-cmd "load 20 $1

@placeholder
	&artist "Blood 20 "Girl $1
	&track "Always 20 "Wrong $1
	&album "Unknown 20 "Album $1
	&time-a "0:31 $1
	&time-b "2:25 $1

~src/assets.tal