Fix stack imbalance

If all the entries of a folder have a common prefix replace the prefix
with "..." when displaying them.

(If the prefix is 3 bytes or less it will not be shortened, since no
space is saved in that case.)

gui/m291/README.md

@@ -0,0 +1,25 @@
+# m291
+
+A music player, written in [Uxntal](https://wiki.xxiivv.com/site/uxntal.html).
+
+## Build
+
+You must have the [Uxn11](https://git.sr.ht/~rabbits/uxn/) assembler and emulator.
+
+```sh
+uxnasm src/m291.tal bin/m291.rom
+```
+
+## Usage
+
+The following command will read a `tal` file and raise warnings if optimizations can be found.
+
+```sh
+ux11 bin/m291.rom
+```
+
+## Extras
+
+- [Need a hand?](https://llllllll.co/t/uxn-virtual-computer/46103)
+- Linted with [uxnlin](https://git.sr.ht/~rabbits/uxnlin)
+- Assembled with [drifblim](https://git.sr.ht/~rabbits/drifblim)

gui/m291/src/m291.tal

@@ -16,6 +16,7 @@
 	@playing $1
 	@mode $1
 	@paused $1
+	@prefix &folders $1 &tracks $1
 	@secfrom $2
 	@secto $2
 	@secprog $2
@@ -51,7 +52,7 @@
 	( name ) "m291 0a
 	( desc ) "Audio 20 "Player 0a
 	( auth ) "By 20 "Linvega 20 "& 20 "d6 0a
-	( date ) "29 20 "Aug 20 "2024 $2
+	( date ) "31 20 "Aug 20 "2024 $2
 
 (
 @|vectors )
@@ -78,7 +79,7 @@
 	POP2 <update-cursor>
 	( | route events )
 	.Mouse/y DEI2
-	( > ) DUP2 #0014 LTH2 ?&status-bar
+	( > ) DUP2 #0018 LTH2 ?&status-bar
 	( > ) [ LIT2 00 -playing ] LDZ EQU ?{ DUP2 #0098 LTH2 ?&player }
 	( | on list )
 	<y-id>
@@ -116,11 +117,12 @@
 	POP2 BRK
 
 	&scroll ( distance -> )
-	.selection/scroll LDZ ADD
+	.selection/scroll LDZ ADD INCk ?{ POP BRK }
-	( above ) DUP #ff EQU ?{
+	.lines/folders LDZ .lines/tracks LDZ ADD #18 SUB
-		( below ) DUP #18 ADD .lines/tracks LDZ GTH ?{ DUP .selection/scroll STZ
+	( needs scroll ) DUP #80 LTH ?{ POP2 BRK }
-			<redraw-dir> } }
+	( max scroll ) LTHk [ JMP SWP POP ] .selection/scroll STZ
-	POP BRK
+	<redraw-dir>
+	BRK
 
 @on-control ( -> )
 	( | mod )
@@ -130,6 +132,7 @@
 	( esc ) DUP #1b NEQ ?{ <escape> }
 	( enter ) DUP #0d NEQ ?{ .selection LDZ <pick> }
 	( space ) DUP #20 NEQ ?{ <send-pause> }
+	DUP #20 SUB #5f GTH ?{ DUP <find-any> }
 	POP
 	( | button )
 	.Controller/button DEI
@@ -192,7 +195,7 @@
 @<seek> ( x* -- )
 	pos-to-seconds DUP2 #00e7 LTH2 #00 SWP ADD2 ;dict/jump-cmd <pstr>
 	<pdec>
-	LIT2 "s 18 DEO
+	[ LIT2 "s 18 ] DEO
 	#0a18 DEO
 	JMP2r
 
@@ -208,16 +211,26 @@
 	JMP2r
 
 @<send-pause> ( -- )
+	.playing LDZ ?{ JMP2r }
 	[ LIT2 02 -paused ] LDZ ORA .paused STZ
 	;dict/pause-cmd <pstr> !<draw-play>
 
 @<move> ( mod -- )
 	.selection LDZ ADD
-	( top ) DUP .selection/scroll LDZ #ff00 NEQ2 ?{ POP JMP2r }
+	( top ) INCk ?{ POP JMP2r }
 	( bottom ) DUP .lines/folders LDZ .lines/tracks LDZ ADD NEQ ?{ POP JMP2r }
 	( >> )
 
 @<select> ( id -- )
+	( | follow )
+	DUP .selection/scroll LDZ SUB
+	( top ) DUP #80 AND #00 EQU ?{
+		DUP .selection/scroll LDZ ADD .selection/scroll STZ !&resume }
+	( bottom ) DUP #18 LTH ?{
+		DUP .selection/scroll LDZ ADD #17 SUB .selection/scroll STZ }
+	&resume ( id scroll -- )
+	POP
+	( | continue )
 	[ LIT &last ff ] NEQk ?{ POP2 JMP2r }
 	POP DUP ,&last STR
 	.selection STZ !<redraw-dir>
@@ -228,7 +241,7 @@
 	POP JMP2r
 
 	&tracks ( id -- )
-	.selection/scroll LDZ ADD DUP .selection/track STZ
+	DUP .selection/track STZ
 	#00 SWP
 	( CELLSIZE ) #70 SFT2 ;mem/tracks ADD2 !<send-load>
 
@@ -240,13 +253,31 @@
 	path/<push> !<refresh-dir>
 
 @<escape> ( -- )
-	( > ) [ LIT2 00 -selection/scroll ] STZ
 	;path/null LDA ?{ JMP2r }
+	[ LIT2 00 -selection/scroll ] STZ
 	path/pop !<refresh-dir>
 
 @<change-mode> ( -- )
 	.mode LDZk INC #03 DIVk MUL SUB SWP STZ !<draw-mode>
 
+@<find-any> ( letter -- )
+	( case insensitive ) cflc STH
+	( | folders )
+	.lines/folders LDZ #00
+	&>folders ( -- )
+		#00 OVR
+		( CELLSIZE ) #70 SFT2 ;mem/folders ADD2 LDA cflc STHkr NEQ ?{ POPr NIP !<select> }
+		INC GTHk ?&>folders
+	POP2
+	( | tracks )
+	.lines/tracks LDZ #00
+	&>tracks ( -- )
+		#00 OVR
+		( CELLSIZE ) #70 SFT2 ;mem/tracks ADD2 LDA cflc STHkr NEQ ?{
+			POPr NIP .lines/folders LDZ ADD !<select> }
+		INC GTHk ?&>tracks
+	POP2 POPr JMP2r
+
 (
 @|events )
 
@@ -279,6 +310,7 @@
 	POP2 STH2r STH2r SWP2 OVR2 ADD2 SWP2
 	( | print )
 	calc-width .secprog STZ2
+	<draw-title-scroll>
 	<draw-progress>
 	<draw-timestamp> !message/<new>
 
@@ -308,20 +340,7 @@
 
 @<y-id> ( y* -- id )
 	[ LIT2 00 -playing ] LDZ EQU ?{ #0080 SUB2 }
-	#0018 SUB2
+	#0018 SUB2 #04 SFT2 NIP .selection/scroll LDZ ADD JMP2r
-	( | 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
@@ -335,16 +354,15 @@
 	&w ( -- )
 	DUP2 <parse-line>
 	lcap/ INC2 LDAk ?&w
-	POP2 sort-folders sort-tracks
+	POP2 <post-refresh>
 	( >> )
 
 @<fit-window> ( -- )
 	#00
 	( folders ) .lines/folders LDZ
-	( tracks ) .lines/tracks LDZ
+	( tracks ) .lines/tracks LDZ ADD
-	( scroll ) #18 LTHk [ JMP SWP ] POP ADD
+	( scroll ) #18 LTHk [ JMP SWP ] POP
 	( 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
@@ -382,43 +400,84 @@
 @str-lth ( a* b* -- a>b )
 	STH2
 	&>loop ( -- )
-		LDAk LDAkr STHr SUBk ?&done
+		LDAk LDAkr STHr SUBk ?{
-		DUP2 #0000 EQU2 ?&done
+			DUP2 #0000 EQU2 ?{ POP2 INC2 INC2r !&>loop } }
-		POP2 INC2 INC2r !&>loop
+	NIP2 LTH POP2r JMP2r
-	&done NIP2 LTH POP2r JMP2r
+
+@str-len ( a* -- len^ )
+	LITr 00 &loop LDAk ?{ POP2 STHr JMP2r } INCr INC2 !&loop
+
+@str-prefix ( a* b* -- len^ )
+	STH2 DUP2 ,&a0 STR2               ( a* [b*] ; a0<-a )
+	&loop LDAk LDAkr STHr NEQk ?&done ( a1* ca^ cb^ [b1*] )
+	DUP2 #0000 EQU2 ?&done            ( a1* ca^ cb^ [b1*] )
+	POP2 INC2 INC2r !&loop            ( a1+1* [b1+1*] )
+	&done POP2 POP2r                  ( a1* )
+	LIT2 [ &a0 $2 ] SUB2 NIP JMP2r    ( len^ )
+
+@<post-refresh> ( -- )
+	common-folder-prefix .prefix/folders STZ
+	common-track-prefix .prefix/tracks STZ
+	sort-folders
+	!sort-tracks
 
 @sort-folders ( -- )
-	;mem/folders DUP2 LIT2 [ 00 -lines/folders ] LDZ #01 SUB #70 SFT2 ADD2 !sort-tracks-0
+	.lines/folders LDZ ?{ JMP2r }
+	;mem/folders DUP2 LIT2 [ 00 -lines/folders ] LDZ #01 SUB
+	( CELLSIZE ) #70 SFT2 ADD2 !sort-files
 
 @sort-tracks ( -- )
-	;mem/tracks DUP2 LIT2 [ 00 -lines/tracks ] LDZ #01 SUB #70 SFT2 ADD2
+	.lines/tracks LDZ ?{ JMP2r }
+	;mem/tracks DUP2 LIT2 [ 00 -lines/tracks ] LDZ #01 SUB
+	( CELLSIZE ) #70 SFT2 ADD2
 	( >> )
 
-@sort-tracks-0 ( first* last* -- )
+@sort-files ( first* last* -- )
-	SWP2 &loop GTH2k ?&ok
+	SWP2
-	POP2 POP2 JMP2r
+	&>loop ( -- )
-	&ok OVR2 OVR2 STH2k #0080 ADD2 &loop2 LTH2k ?&done
+		GTH2k ?{ POP2 POP2 JMP2r }
-	DUP2 STH2kr str-lth ?&replace
+		OVR2 OVR2 STH2k #0080 ADD2
-	!&inc
+		&>loop2 ( -- )
-	&replace POP2r STH2k &inc #0080 ADD2 !&loop2
+			LTH2k ?&done
-	&done POP2 POP2 DUP2 STH2r swap-tracks #0080 ADD2 !&loop
+			DUP2 STH2kr str-lth ?&replace
+			!{
+			&replace POP2r STH2k }
+		#0080 ADD2 !&>loop2
+
+	&done ( -- )
+	POP2 POP2 DUP2 STH2r swap-tracks #0080 ADD2 !&>loop
 
 @swap-tracks ( src* dst* -- )
-	EQU2k ?&skip
+	EQU2k ?{
-	DUP2 ;tmp <scpy>
+		DUP2 ;tmp <scpy>
-	OVR2 STH2
+		OVR2 STH2
-	<scpy>
+		<scpy>
-	;tmp STH2r <scpy>
+		;tmp STH2r !<scpy> }
-	JMP2r
+	POP2 POP2 JMP2r
-	&skip POP2 POP2 JMP2r
+
+@min ( x^ y^ -- min^ )
+	LTHk JMP SWP POP JMP2r
+
+@common-folder-prefix ( -- len^ )
+	.lines/folders LDZ ?{ #00 JMP2r }
+	;mem/folders DUP2 LIT2 [ 00 -lines/folders ] LDZ #70 SFT2 ADD2
+	!common-prefix-0
+
+@common-track-prefix ( -- len^ )
+	.lines/tracks LDZ ?{ #00 JMP2r }
+	;mem/tracks DUP2 LIT2 [ 00 -lines/tracks ] LDZ #70 SFT2 ADD2
+	( >> )
+
+@common-prefix-0 ( first* limit* -- len^ )
+	SWP2 DUP2k str-len STH                ( limit* first* first* [len^] )
+	,&s0 STR2 #0080 ADD2                  ( limit* first+128* [len^] )
+	&loop GTH2k ?&ok POP2 POP2 STHr JMP2r ( len^ )
+	&ok DUP2 LIT2 [ &s0 $2 ] str-prefix   ( limit* curr* p^ [len^] )
+	STHr min STH #0080 ADD2 !&loop        ( last* next+128* [min-p-len2^] )
 
 @count-lines ( -- lines )
 	.lines/folders LDZ .lines/tracks LDZ ADD JMP2r
 
-@has-spacer ( -- f )
-	[ LIT2 00 -lines/folders ] LDZ NEQ
-	( .. ) [ LIT2 00 -lines/tracks ] LDZ NEQ AND JMP2r
-
 @is-folder ( line* -- line* f )
 	DUP2 lcap/ #0001 SUB2 LDA [ LIT "/ ] EQU JMP2r
 
@@ -513,32 +572,54 @@
 		#0008 .Screen/x DEO2
 		;dict/empty #0f !<draw-uf2> }
 	( | folders )
-	;mem/folders .lines/folders LDZ .selection LDZ <draw-folders>
+	<draw-folders>
-	has-spacer #00 EQU ?{ ;dash-icn <draw-spacer> }
-	;mem/tracks .lines/tracks LDZ .selection LDZ .lines/folders LDZ SUB
 	( >> )
 
-@<draw-files> ( addr* length selection -- )
+@<draw-tracks> ( -- )
-	,&sel STR
+	.selection LDZ .lines/folders LDZ SUB ,&sel STR
-	DUP ?{ POP2 POP JMP2r }
 	#0008 .Screen/x DEO2
-	#00 SWP2 ,&t STR2
+	.lines/tracks LDZ #00 NEQk ?{ POP2 JMP2r }
+	.selection/scroll LDZ .lines/folders LDZ LTH ?{
+		.selection/scroll LDZ .lines/folders LDZ SUB ADD }
 	&>l ( -- )
-		( scroll ) DUP #18 LTH ?{ POP2 JMP2r }
 		[ LITr 05 ]
 		( | selected )
 		DUP [ LIT &sel $1 ] NEQ ?{
 			POPr [ LITr 06 ] ;fill-icn <draw-background> }
 		( | marker )
-		DUP .selection/scroll LDZ ADD .selection/track LDZ NEQ ?{
+		DUP .selection/track LDZ NEQ ?{
 			[ LIT2 15 -Screen/auto ] DEO
 			#0000 .Screen/x DEO2
 			;poke-icn .Screen/addr DEO2
 			DUPr [ LITr -Screen/sprite ] DEOr }
 		( | normal )
 		#0008 .Screen/x DEO2
-		#00 OVR .selection/scroll LDZ ADD
+		#00 OVR
-		( CELLSIZE ) #70 SFT2 [ LIT2 &t $2 ] ADD2 STHr <draw-uf2>
+		( CELLSIZE ) #70 SFT2 ;mem/tracks ADD2 STHr <draw-uf2-track>
+		.Screen/y DEI2k #0010 ADD2 ROT DEO2
+		INC GTHk ?&>l
+	POP2 JMP2r
+
+@<draw-folders> ( -- )
+	.selection LDZ ,&sel STR
+	#0008 .Screen/x DEO2
+	.lines/folders LDZ #00 NEQk ?{ POP2 JMP2r }
+	.selection/scroll LDZ ADD GTHk ?{ POP2 JMP2r }
+	&>l ( -- )
+		[ LITr 05 ]
+		( | selected )
+		DUP [ LIT &sel $1 ] NEQ ?{
+			POPr [ LITr 06 ] ;fill-icn <draw-background> }
+		( | gizmo )
+		.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 ] DEOr
+		.Screen/y DEO2
+		( | normal )
+		#0008 .Screen/x DEO2
+		#00 OVR
+		( CELLSIZE ) #70 SFT2 ;mem/folders ADD2 STHr <draw-uf2-folder>
 		.Screen/y DEI2k #0010 ADD2 ROT DEO2
 		INC GTHk ?&>l
 	POP2 JMP2r
@@ -576,10 +657,23 @@
 	<draw-next>
 	<draw-progress> !<draw-timestamp>
 
+@<draw-title-scroll> ( -- )
+	;id3/title get-uf2-width #00d0 LTH2 ?{
+		[ LIT2 &f $2 ] INC2k ,&f STR2
+		DUP #0f AND ?{
+			#0020 .Screen/y DEO2
+			<clear-line>
+			#0001 .Screen/x DEO2
+			#0020 .Screen/y DEO2
+			#04 SFT2 ;id3/title !<draw-uf2-scroll> }
+		POP2 }
+	JMP2r
+
 @<draw-title> ( -- )
 	( | clear )
 	#0020 .Screen/y DEO2
 	<clear-line>
+	#0000 ;<draw-title-scroll>/f STA2
 	( | draw )
 	#0020 .Screen/y DEO2
 	;id3/title get-uf2-width #00d0 LTH2 ?{
@@ -744,30 +838,6 @@
 	.Screen/y DEO2
 	JMP2r
 
-@<draw-folders> ( addr* length selection -- )
-	,&sel 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 ] ;fill-icn <draw-background> }
-		( | gizmo )
-		.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 ] DEOr
-		.Screen/y DEO2
-		( | normal )
-		#0008 .Screen/x DEO2
-		#00 OVR
-		( CELLSIZE ) #70 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 ( -- )
@@ -775,11 +845,33 @@
 		ADD2r next-glyph LDAk ?&>while
 	POP2 STH2r JMP2r
 
+@<draw-uf2-scroll> ( offset* text* -- )
+	[ LIT2 15 -Screen/auto ] DEO
+	.Screen/width DEI2 ,&bound STR2
+	STH2k llen DIV2k MUL2 SUB2 STH2kr ADD2
+	&>w ( -- )
+		.Screen/x DEI2 [ LIT2 &bound $2 ] LTH2 ?{ POP2 POP2r JMP2r }
+		LDAk DUP ?{
+			POP2 POP STH2kr #20 <draw-glyph> !&>w }
+	<draw-glyph>
+	next-glyph !&>w
+
 @<draw-uf2-center> ( text* color -- )
 	STH
 	.Screen/x DEI2 OVR2 get-uf2-width #01 SFT2 SUB2 .Screen/x DEO2
 	STHr
-	( >> )
+	!<draw-uf2>
+
+@<draw-uf2-folder> ( text* color -- )
+	STH .prefix/folders LDZ #03 GTH ?{ STHr !<draw-uf2> }
+	;dict/ellipses STHkr <draw-uf2>
+	LIT2 [ 00 -prefix/folders ] LDZ ADD2 STHr
+	!<draw-uf2>
+
+@<draw-uf2-track> ( text* color -- )
+	STH .prefix/tracks LDZ #03 GTH ?{ STHr !<draw-uf2> }
+	;dict/ellipses STHkr <draw-uf2>
+	LIT2 [ 00 -prefix/tracks ] LDZ ADD2 STHr
 
 @<draw-uf2> ( text* color -- )
 	,<draw-glyph>/color STR
@@ -829,6 +921,10 @@
 (
 @|stdlib )
 
+@cflc ( c -- lowercase )
+	DUP #41 SUB #1a GTH ?{ #20 ADD }
+	JMP2r
+
 @scap ( str* -- end* )
 	INC2 & LDAk ?scap
 	JMP2r
@@ -939,6 +1035,7 @@
 	&pause-cmd "pause 0a $1
 	&no-artist "Unknown 20 "Artist $1
 	&no-album "Unknown 20 "Album $1
+	&ellipses "... $1
 
 ~src/assets.tal