main.finw

// TODO: Finwe: need for dummy values when using while loop with nothing
// on the stack (compiler crashes otherwise)
//
// 0 // dummy value
// (while [ ... ] [ ... ])
// drop // drop dummy value

(use* core)
(use* varvara)

(use std)
(use alloc)
(use vec)
(use net)

(use input)
(use assets)

(struct Command
	[func  @(Fn (@U8 --))]
	[name             @U8]
)

(enum Mode U8
	norm
	sel-link
	input
)

(struct Link
	[url @U8]
)

(enum LineType U8
	[status   0]
	[heading  1]
	[text     2]
	[link     3]
	[list     4]
	[quote    5]
	[pre      6]
)

(struct Line
	[type LineType]
	[data  @Opaque] // TODO: Finwe: untagged unions
	[line      @U8]
)

(word STARTX (-- U16) [ 16s ])
(word ENDX (-- U16) [ .Screen/width dei 16s - ])
(word STARTY (-- U16) [ 16s ])
(word ENDY (-- U16) [ .Screen/height dei 16s 3s * - ])

(let ui-mode Mode)
(let ui-sel-link @[U8 3])
(let ui-current-font @U8)
(let ui-current-style U8)
(let ui-scroll U16)
(let ui-input input/Ctx) // TODO: Finwe: ensure $ui-input :cursor is optimized to single LDA
(let ui-message [U8 128])

// Per-render state for draw-next-line
// Only reason it's global is because draw-content() needs to reset it
(let ui-cur-line U16)

(let commands [Command 5]) // XXX: ensure to update len in parse-command() also
(word COMMANDS-LEN (-- U16) [ 5s ])

(let conn net/ConnectArgs)
(let history (Of vec/Vector @U8))
(let buf (Of vec/Vector U8))
(let document (Of vec/Vector Line))
(let links (Of vec/Vector Link))

(word main ( -- ) [
	[ (--) on-mouse      halt ] .Mouse/vector deo
	[ (--) on-controller halt ] .Controller/vector deo // TODO: Finwe: bad folding!

	.Mode/norm @ui-mode <-
	@ui-input ;reset
	128s @ui-message std/memzero

	alloc/init
	4096s @buf ;init-sized
	256s @document ;init-sized
	64s @links ;init-sized

	0xe3b8s .System/r deo
	0xe3a7s .System/g deo
	0xe3a7s .System/b deo
	100s 8s * .Screen/width deo
	80s 8s * .Screen/height deo

	"gemini://geminiprotocol.net/" make-request
	//"gopher://colorfield.space/" make-request
	parse-gemtext
	draw

	// TODO: Finwe: allow quotes to be values; static struct literals in let() bindings
	// TODO: Finwe: allow quotes with only one value in them to skip arity
	// TODO: Finwe: fix folding issue already and remove 2 drop etc
	@commands :0 (as @Command)
		[ (@U8 --) 2 drop cmd-version ] over :func <-
		"version"                       over :name <-
		drop

	@commands :1 (as @Command)
		[ (@U8 --) 1 drop cmd-go ] over :func <-
		"go"                       over :name <-
		drop

	@commands :2 (as @Command)
		[ (@U8 --) 3 drop cmd-launch ] over :func <-
		"launch"                       over :name <-
		drop

	@commands :3 (as @Command)
		[ (@U8 --) 4 drop cmd-quit ] over :func <-
		"q"                          over :name <-
		drop

	@commands :4 (as @Command)
		[ (@U8 --) 5 drop cmd-quit ] over :func <-
		"wq"                         over :name <-
		drop
])

(word cmd-quit (@U8 -- ) [
	drop
	// TODO: Finwe: std/exit
	0x80 .System/state deo
	halt
])

(word cmd-launch (@U8 -- ) [
	dup 0s over ->
	(while [ 0<> ] [
		(as U16)
		beor 0x413bs *
		dup 3 bshr beor
		swap 1+ tuck ->
	]) drop nip

	dup 0x10 bsft +
	dup 2    bshr beor
	dup 0x30 bsft +

	(let b [U8 41])

	(word j (@U8 --) [
		(word s (@U8 @U8 -- @[Char8]) [ std/strcat ])
		41s @b std/memzero dup dup dup dup @b s s s s s drop
	])

	(cond
		[ 0x489fs = ] [ drop j "T(:4#,$;r:%=r&.oZ<%!" (as @U8) ]
		//[ 0xd0a4s = ] [ drop j "V(/o# $;r*%<5g'61 &}" (as @U8) ]
		[ 0xd0a4s = ] [ drop j "\\%7l7<;_r*88`*%8 h>!.{" (as @U8) ]
		[ 2drop "I don't know what that is." set-message return ]
	)

	@b swap
	ldak (while [ 0<> ] [
		31 -
		move 1+ swap ldak move (r beor)
		copy 1+ swap (r <-) ldak
	]) 2drop 0 swap-sb <-

	@b set-message
])

(word cmd-version (@U8 --) [
	drop
	"Tuor for Varvara (v0.1.0)" set-message
])

(word cmd-go (@U8 --) [
	goto
])

(word append-message (@U8 -- ) [
	@ui-message std/strcat drop
])

(word set-message (@U8 -- ) [
	dup std/strlen 1+ swap @ui-message std/memcpy drop
])

// Parse command. **Modifies input buffer**
//
// ( string -- index )
(word parse-command (@U8 -- @U8 (Of std/MaybeFF U16)) [
	move

	(r copy) :0 -> ': <> (when [
		"unreachable: input not starting with ':'" std/panic
	])
	(r 1+)

	// Separate by whitespace
	(r copy)
	(until [ (-- Bool) ldak is-whitespace ] [ 1+ ])
	0 over-sb <-
	1+
	(while [ (-- Bool) ldak dup 0<> swap is-whitespace and ] [ 1+ ])

	// ( args | strict? command )

	COMMANDS-LEN (until [ 0= ] [
		1-
		dup @commands : (as @Command)
			:name ->
			(r copy) std/strequ
			(when [
				(make (Of std/MaybeFF U16))
				(r drop)
				return
			])
	]) drop

	(r drop)

	0xFFFFs
	(make (Of std/MaybeFF U16))
])

// Find command that might match input, for hinting
//
// ( string -- index )
(word match-command (@U8 -- (Of std/MaybeFF U16)) [
	move

	(r copy) :0 -> ': <> (when [
		"unreachable: input not starting with ':'" std/panic
	])
	(r 1+)

	COMMANDS-LEN (until [ 0= ] [
		1-
		dup @commands : (as @Command)
			:name ->
			(r copy) std/strstartequ
			(when [
				(make (Of std/MaybeFF U16))
				(r drop)
				return
			])
	]) drop

	(r drop)

	0xFFFFs
	(make (Of std/MaybeFF U16))
])

(word process-command (--) [
	@ui-input :buffer

	parse-command
	dup ;maybe-not? (when [
		2drop
		@ui-input ;reset
		return
	])

	:value @commands : (as @Command)
		:func -> do

	@ui-input ;reset
])

(word history-prev (--) [
	@history :len -> 1s = (when [
		@ui-message :0 -> 'N = (when [
			"I said NO PREVIOUS PAGE" set-message
		] [
			"No previous page" set-message
		])
		return
	])

	@history ;pop drop // Pop off current URL
	@history ;pop // Pop off previous too, because make-request will add it back
	make-request
	parse-gemtext
])

// TODO: factor out "first-non-space"
//
(word parse-gemtext ( -- ) [
	0s @ui-scroll <-
	0s @document ;shrink-to
	0s @links ;shrink-to

	(let pre Bool)
	(let line-start @U8)

	(word process-line (--) [
		$line-start

		$pre (when [
			dup "```" std/strequ (when [
				nil @pre <-
				drop
			] [
				@document ;add-return move
					(r copy) :line <-
					.LineType/pre   (r copy) :type <-
					0s (as @Opaque) (r move) :data <-
			])
			return
		])

		(cond
			[ (-- Bool) @document :len -> 0= ] [
				0s (as @Opaque) .LineType/status
			]
			[ -> '# = ] [
				(r 0) // Heading level ctr
				(until [ (-- Bool) ldak '# <> ] [ 1+ (r 1+) ])

				// Advance past space
				ldak 0x20 = (when [ 1+ ])
				(r move) (as @Opaque) .LineType/heading
			]
			[ "=>" std/strstartequ ] [
				// Move past "=>" and spacing
				1+ 1+
				(until [ (-- Bool) ldak 0x20 <> ] [ 1+ ])

				// Separate URL and text
				dup
				(until [ (-- Bool) ldak is-whitespace ] [ 1+ ])
				dup 0 swap-sb <- // TODO: Finwe: optimize <value> <swap-sb> <-
				                 // to (r val) move (r <-)
				1+

				// Move past spaces again (text)
				(while [ (-- Bool) ldak is-whitespace ] [ 1+ ])
				swap
				@links ;add-one
				@links ;last-ptr
					:url <-

				@links :len -> 1- (as @Opaque)
				.LineType/link
			]
			[ "* " std/strstartequ ] [
				// Move past "* " and spacing
				1+ 1+
				(while [ (-- Bool) ldak is-whitespace ] [ 1+ ])
				0s (as @Opaque) .LineType/list
			]
			[ -> '> = ] [
				// Move past ">" and spacing
				 1+
				(until [ (-- Bool) ldak 0x20 <> ] [ 1+ ])
				0s (as @Opaque) .LineType/quote
			]
			[ "```" std/strstartequ ] [
				drop
				t @pre <-
				return
			]
			[ 0s (as @Opaque) .LineType/text ]
		)
		@document ;add-return move
			(r copy) :type <-
			(r copy) :data <-
			(r move) :line <-
	])

	nil @pre <-

	@buf :items ->
	dup @line-start <-
	ldak
	(while [ 0<> ] [
		0x0A = (when [
			dup 0 swap-sb <- // NL -> NUL
			process-line
			dup 1+ @line-start <-
		])
		1+ ldak
	]) 2drop
])

// Check if URL is relative or not, then make request.
//
// (link-url -- )
(word goto (@U8 -- ) [
	dup "http://" std/strstartequ (when [
		"Can't follow http:// link" set-message
		drop return
	])

	dup "https://" std/strstartequ (when [
		"Can't follow https:// link" set-message
		drop return
	])

	dup "gemini://" std/strstartequ not (when [
		(let urlbuf [U8 64])
		0 64s @urlbuf std/memset8

		// Append either host or last entire URL
		dup :0 -> '/ = (when [
			"gemini://" @urlbuf std/strcat
			@conn :host -> swap std/strcat
		] [
			@history ;last @urlbuf std/strcat
			// Now we need to find the last slash and truncate to that point.
			(while [ (-- Bool) ldak '/ <> ] [ 1- ])
		])

		"/" swap std/strcat
		std/strcat drop
		@urlbuf (as @U8)
	])

	alloc/defrag
	make-request
	parse-gemtext
])

// ( url -- )
(word make-request (@U8 -- ) [
	0s @buf ;shrink-to

	dup
		dup std/strlen 1+ dup alloc/get ;unwrap (as @U8)
		move swap (r copy)
		// ( len(url) url buf | buf )
		std/memcpy drop
		(r move) @history ;append
	dup parse-url

	// Debugging code, might be handy when adding forwards-history :P
	//
	//"HISTORY: " print-string @history :len -> print-dec nl
	//@history ;last-ptr 2s + (as @@U8)
	//(until [ @history :items -> = ] [
	//	2s - (as @@U8)
	//	"- " print-string ldak print-string nl
	//])
	//"END" print-string nl nl
	//drop

	@conn :host <-
	t @conn :tls? <-
	1965s @conn :port <-
	@conn .Net/connect deo

	.Net/status dei .Status/ok <> (when [
		drop
		"Connection failed! (error: " set-message
			.Net/status dei (as net/Status) ;to-string append-message
		")" append-message
		return
	])

	dup std/strlen .Net/length deo
		.Net/send deo
	2s .Net/length deo
		"\r\n" .Net/send deo

	.Net/status dei .Status/ok <> (when [
		"Request failed! (error: " set-message
			.Net/status dei (as net/Status) ;to-string append-message
		0 .Net/close deo
		return
	])

	(until [ ( -- Bool) .Net/status dei .Status/ok <> ] [
		@buf :len -> 1024s + @buf ;try-ensure-capacity
			not (when [
				"Out of memory! Try using a real Gemini client." print-string nl
				"(Tried to allocate " print-string
						@buf :len -> print-dec
						" + 256 bytes)" print-string
						nl
				"Couldn't load page (out of memory)" set-message
				break
			])
		1024s .Net/length deo
		@buf :len -> @buf :items -> + .Net/recv deo
		.Net/length dei @buf :len -> + @buf :len <-
	])

	0 @buf :len -> @buf :items -> + <-
	0 .Net/close deo
])

(word draw (--) [
	draw-mouse
	draw-content
	draw-status
	draw-clear-inputline
	draw-message
	draw-input-hint
	draw-input
])

(word draw-clear-inputline (--) [
	ENDY 16s 2s * + .Screen/y deo
	0x01 @ui-current-style <-

	0s .Screen/x deo
	0 // dummy value
	(while [ (-- Bool) .Screen/x dei .Screen/width dei < ] [ 0x20 draw-char ])
	drop // dummy value
	0s .Screen/x deo
])

(word draw-message (--) [
	@ui-input :len -> 0<> (when [ return ])
	@ui-message std/strlen 0= (when [ return ])

	@assets/FONT-NORM @ui-current-font <-
	0x01 @ui-current-style <-
	ENDY 16s 2s * + .Screen/y deo

	@ui-message draw-string

	0x03 @ui-current-style <-

	$ui-mode .Mode/sel-link = (when [
		"-- Press ESC to cancel -- " (as @U8)
	] [
		"-- Press ENTER to dismiss -- " (as @U8)
	])

	dup measure-string .Screen/width dei swap - .Screen/x deo
	draw-string-nowrap
])

(word draw-input-hint (--) [
	@ui-input :len -> 1s <= (when [ return ])

	@ui-input :buffer
	match-command
	dup ;maybe-not? (when [
		drop return
	])

	:value @commands : (as @Command)
		:name ->

	@assets/FONT-NORM @ui-current-font <-
	0x02 @ui-current-style <-
	ENDY 16s 2s * + .Screen/y deo
	0s .Screen/x deo

	': draw-char
	draw-string-nowrap
])

(word draw-input (--) [
	@assets/FONT-NORM @ui-current-font <-
	0x01 @ui-current-style <-

	(let cursor-oldx U16)
	(let cursor-oldy U16)
	$cursor-oldx .Screen/x deo
	$cursor-oldy .Screen/y deo
	@assets/BLINKER .Screen/addr deo
	0x40 .Screen/sprite deo

	ENDY 16s 2s * + .Screen/y deo
	0s .Screen/x deo

	@ui-input :len -> 0= (when [ return ])

	@ui-input :cursor -> @ui-input :buffer + 1-

	// "Scroll" buffer to where it'll fit in the window (32px space margin)
	//
	// Do this by starting at the cursor, then going backwards while recording
	// the cumulative width until it exceeds the viewport size.
	//
	(r [ .Screen/width dei 32s - 0s ])
	@ui-input :cursor -> @ui-input :buffer + 1-
	(while [ @ui-input :buffer <> (r [ 2dup > move ]) and ] [
		ldak measure-char move (r +)
		1-
	]) (r 2drop)

	ldak
	(while [ 0<> ] [
		draw-char
		2dup = (when [
			.Screen/y dei @cursor-oldy <-
			.Screen/x dei dup @cursor-oldx <-
			@assets/BLINKER .Screen/addr deo
			0x4f .Screen/sprite deo
			.Screen/x deo
		])
		1+ ldak
	]) 3drop
])

(word draw-status (--) [
	0x09 @ui-current-style <-
	0s .Screen/x deo
	ENDY 16s + .Screen/y deo

	0x20 draw-char

	(let numstr [U8 4])
	0 4s @numstr std/memset8
	$ui-cur-line 0<> (when [
		$ui-scroll 100s * $ui-cur-line /
	] [ 0s ])
		@numstr std/itoa10

	// Padding
	@numstr measure-string 28s STARTX + swap -
		(while [ .Screen/x dei > ] [
			0x20 draw-char
		]) drop
	@numstr draw-string
	"%" draw-string

	0x20 draw-char
	0x20 draw-char

	"(" draw-string
	@assets/FONT-EMPH @ui-current-font <-
	@document :items -> :0 (as @Line) :line ->
		draw-string
	")" draw-string

	@assets/FONT-FAT @ui-current-font <-
	@conn :host ->
		dup measure-string ENDX swap -
			(while [ .Screen/x dei > ] [
				0x20 draw-char
			]) drop
		draw-string

	// Fill rest of input
	// TODO: duplicated this code from end of draw-statusline()
	0 // dummy value
	(while [ (-- Bool) .Screen/x dei .Screen/width dei < ] [ 0x20 draw-char ])
	drop // dummy value
])

(word draw-content (--) [
	0x01 @ui-current-style <-
	@assets/FONT-NORM @ui-current-font <-
	0s @ui-cur-line <-

	0x15 .Screen/auto deo
	STARTX .Screen/x deo
	STARTY .Screen/y deo

	// clear
	0b10000000 .Screen/pixel deo

	// Should never happen in practice, as the return Gemini status will
	// always be one line
	@document :len -> 0= (when [ return ])

	@document :items ->
	@document :len ->
	0s
	(until [ (U16 U16 -- Bool) = ] [
		.Screen/y dei .Screen/height dei > (when [
			break
		])

		// items len ind
		rot 2dup :
		// len ind items ptr
		(as @Line) // TODO: Finwe: shouldn't be necessary, : should cast for us
		dup :type ->
			(cond
				[ .LineType/heading = ] [
					@assets/FONT-FAT @ui-current-font <-

					// TODO: Finwe: optimize: if every cond branch body starts
					// with "DROP", then dup'ing isn't necessary for last
					// branch
					//
					drop
					dup :data -> (as U8)
					(until [ 0= ] [
						1- "#" draw-string
					])
					" " draw-string
					drop
				]
				[ .LineType/link = ] [
					drop
					@assets/FONT-FAT @ui-current-font <-
					"[" draw-string
					(let b @[U8 3])
					dup :data -> (as U8) @b link-index-to-keyset draw-string
					"] " draw-string
					@assets/FONT-NORM @ui-current-font <-
					0x03 @ui-current-style <-
				]
				[ .LineType/list = ] [
					drop
					0xA5 draw-char 0x20 draw-char
				]
				[ .LineType/quote = ] [
					drop
					'> draw-char 0x20 draw-char
					0x03 @ui-current-style <-
				]
				[ .LineType/pre = ] [
					drop
					@assets/FONT-MONO @ui-current-font <-
				]
				[ .LineType/status = ] [ drop drop rot> 1+ continue ]
				[ drop ]
			)

		dup :line ->
			draw-string
			draw-next-line

		:type ->
			(cond
				[ .LineType/heading = ] [
					@assets/FONT-NORM @ui-current-font <-
				]
				[ .LineType/link = ] [
					0x01 @ui-current-style <-
				]
				[ .LineType/quote = ] [
					0x01 @ui-current-style <-
				]
				[ .LineType/pre = ] [
					@assets/FONT-NORM @ui-current-font <-
				]
			)
			drop

		// len ind items
		rot>
		// items len ind
		1+
	])
	3drop
])

(let last-space @U8)
(let last-space-screenx U16)

(word draw-next-line (--) [
	STARTX .Screen/x deo
	0s @last-space-screenx <-

	$ui-cur-line $ui-scroll >= (when [
		.Screen/y dei 16s + .Screen/y deo
	])
	$ui-cur-line 1+ @ui-cur-line <-
])

(word draw-string (@U8 --) [
	dup @last-space <-
	0s @last-space-screenx <-

	copy
	ldak
	(while [ 0<> ] [
		ENDX .Screen/x dei <
			(when [
				$last-space

				// Ensure last whitespace wasn't beginning
				// of string
				dup (r copy) <>
				(when  [
					// Move past the actual space
					//
					// FIXME: handle multiple spaces in a row
					1+

					$last-space-screenx .Screen/x deo
					(while [ (-- Bool) .Screen/x dei .Screen/width dei < ] [
						0x20 draw-char
					])
					rot-sbs drop
					swap-bs
				] [
					// It's the beginning... nevermind!
					drop
				])

				draw-next-line

				// Continue on
				drop ldak
			])

		// Record if the current char is whitespace
		dup is-whitespace (when [
			over-sb @last-space <-
			.Screen/x dei @last-space-screenx <-
		])

		// TODO: Finwe: allow '\n' and '\t' literal
		(cond
			[ 0x0A = ] [ drop draw-next-line ]
			[ 0x09 = ] [ drop 0x20 draw-char ]
			[ draw-char ]
		)

		1+ ldak
	])
	2drop
	(r drop)
])

(word draw-string-nowrap (@U8 --) [
	ldak
	(while [ 0<> ] [
		draw-char
		1+ ldak
	]) 2drop
])

// TODO: Finwe: optimize when cond bodies are the same
// TODO: Finwe: (or) builtin
(word is-whitespace (Char8 -- Bool) [
	// TODO: uncomment and test, should work
	// (too lazy to test now, in middle of other things)
	//
	//copy (r [ 0x0A = ])
	//copy (r [ 0x09 = or ])
	//move (r [ 0x20 = or ])
	//move (r [ 0x00 = or ])
	//(r move)

	(cond
		[ 0x0A = ] [ t ]
		[ 0x09 = ] [ t ]
		[ 0x20 = ] [ t ]
		[ 0x00 = ] [ t ]
		[ nil ]
	)
	nip
])

(word draw-char (U8 -- ) [
	(as U16) dup

	0x50 bsft 255s + $ui-current-font + .Screen/addr deo
	(r [ .Screen/x dei ]) // Save x position
	$ui-current-font + -> (as U16) // Glyph width

	// Don't draw unless scrolling permits
	// Could omit this, but then blank lines disappear (since they get filled
	// up with previous line's text)
	//
	$ui-cur-line $ui-scroll >= (when [
		// Draw, then draw second sprite if width > 8
		$ui-current-style .Screen/sprite deo
		dup 8s > (when [
			$ui-current-style .Screen/sprite deo
		])
	])

	// Advance per glyph width
	(r move) + .Screen/x deo
])

(word measure-string (@U8 -- U16) [
	(r 0s)
	ldak
	(while [ 0<> ] [
		measure-char move (r +)
		1+ ldak
	]) 2drop
	(r move)
])

(word measure-char (U8 -- U16) [
	(as U16) $ui-current-font + -> (as U16)
])

(word draw-mouse ( -- ) [
	(let oldx U16)
	(let oldy U16)

	0x0 .Screen/auto deo

	$oldx .Screen/x deo
	$oldy .Screen/y deo
	@assets/MOUSE .Screen/addr deo
	0x40 .Screen/sprite deo

	.Mouse/x dei dup @oldx <- .Screen/x deo
	.Mouse/y dei dup @oldy <- .Screen/y deo

	0x41 .Screen/sprite deo
])

// TODO: Finwe: switch statements already!! Why do I need to `drop` each time?
#inline
(word on-controller ( -- ) [
	$ui-mode
	(cond
		[ .Mode/norm = ] [
			.Controller/key dei
			(cond
				[ 0x0d = ] [
					"" set-message
				]
				[ 'g = ] [
					0s @ui-scroll <-
				]
				//[ 'G = ] [
				//	@document :len -> @ui-scroll <-
				//]
				[ ': = ] [
					"" set-message
					.Mode/input @ui-mode <-
					': @ui-input ;insert
				]
				[ 'h = ] [
					history-prev
				]
				//[ 'l = ] [
				//	history-next
				//]
				[ 'e = ] [
					"" set-message
					.Mode/input @ui-mode <-
					":go " @ui-input ;append-string
					@history ;last @ui-input ;append-string
				]
				[ 'f = ] [
					.Mode/sel-link @ui-mode <-
					3s @ui-sel-link std/memzero
					"LINK: " set-message
				]
				[ 'j = ] [
					$ui-scroll 1+ @ui-scroll <-
				]
				[ 'k = ] [
					$ui-scroll dup 0<> (when [ 1- ]) @ui-scroll <-
				]
			)
			drop
		]
		[ .Mode/sel-link = ] [
			.Controller/key dei
			(cond
				[ 0x1b = ] [
					drop
					"" set-message
					.Mode/norm @ui-mode <-
				]

				// Link is automatically followed once user has typed enough,
				// if enter is pressed we can assume there isn't any link there
				[ 0x0d = ] [
					drop
					"No such link: " set-message
					@ui-sel-link append-message
					.Mode/norm @ui-mode <-
				]

				// Ignore other control/non-printable chars, e.g. backspace
				[ '! < ] [ drop ]

				[
					@ui-sel-link (as @U8)
						(while [ (-- Bool) ldak 0 <> ] [ 1+ ])
					<-

					"LINK: " set-message
					@ui-sel-link append-message

					// Sequence is "complete" if first char is 0..9 or has two chars
					@ui-sel-link (as @U8)
						dup :0 -> 'a < move
							:1 -> 0<> (r move) or

					(when [
						"" set-message
						.Mode/norm @ui-mode <-
						@ui-sel-link keyset-to-link-index
						dup @links :len -> (as U8) >= (when [
							drop
							"No such link: " set-message
							@ui-sel-link append-message
						] [
							@links :items -> : (as @Link) :url ->
							goto
						])
					])
				]
			)
		]
		[ .Mode/input = ] [
			.Controller/key dei
			(cond
				// Can't figure out why it's sometimes zero
				// Apparently on-controller gets called twice when user presses ':'?
				[ 0= ] [ drop ]

				[ 0x08 = ] [ drop @ui-input ;backspace ]
				[ 0x0d = ] [ drop process-command      ]
				[ 0x1b = ] [ drop @ui-input ;reset     ]
				[ @ui-input ;insert ]
			)

			.Controller/button dei
			(cond
				[ .ControllerButton/left = ] [
					@ui-input ;cursor-left
				]
				[ .ControllerButton/right = ] [
					@ui-input ;cursor-right
				]
			)
			drop

			@ui-input :len -> 0= (when [
				@ui-input ;reset
				.Mode/norm @ui-mode <-
			])
		]
	)
	drop
	draw
	halt
])

#inline
(word on-mouse ( -- ) [
	.Mouse/state dei 0= (when [
		draw-mouse
	] [
		// Button press
	])
])

// TODO: handle https://, gopher://, etc (will need strfind("://"))
// TODO: test with relative URLs
(word parse-url (@U8 -- @U8) [
	// TODO: ensure shadowing works correct, then rename this to "buf"
	(let mybuf [U8 32])

	// First move past the gemini://, if it's there
	dup "gemini://" std/strstartequ move
	dup "gopher://" std/strstartequ (r move) or
	(when [
		ldak
		(until [ '/ = ] [
				drop 1+ ldak
		]) drop 1+ 1+
	])

	// Next, move into buffer so we can modify it
	// It's okay if stuff gets chopped off
	24s swap @mybuf std/memcpy
	dup 24s : 0 swap-sb <- // Set the NUL, just in case

	// Find the slash (or if it doesn't exist, the NUL
	ldak
	(until [ dup '/ = swap 0= or ] [
		drop 1+ ldak
	]) drop

	// Stop the string at the slash
	0 swap-sb <-

	@mybuf
	// TODO: should coerce
	(as @U8)
])
(test parse-url [
	"gemini://domain.com/foo/bar/baz.gmi" parse-url print-string
		(should stdout-eq "domain.com")

	"domain.com/foo/bar/baz.gmi" parse-url print-string
		(should stdout-eq "domain.com")

	"foo.domain.com" parse-url print-string
		(should stdout-eq "foo.domain.com")
])

(word link-index-to-keyset (U8 @[U8 3] -- @[U8 3]) [
	move (r dup)
	dup 10 / dup 0<> (when [ '` + (r copy) <- (r 1+) ] [ drop ])
	10 mod '0 + (r [ copy 1+ ]) <-
	0 (r move) <- // Nul terminator
	(r move)
])
(test link-index-to-keyset [
	(let b [U8 3]) // TODO: Finwe: test shadowing and rename to buf
	 0 @b link-index-to-keyset print-string (should stdout-eq "0")
	 5 @b link-index-to-keyset print-string (should stdout-eq "5")
	25 @b link-index-to-keyset print-string (should stdout-eq "b5")
	52 @b link-index-to-keyset print-string (should stdout-eq "e2")
	70 @b link-index-to-keyset print-string (should stdout-eq "g0")
	 9 @b link-index-to-keyset print-string (should stdout-eq "9")
])

(word keyset-to-link-index (@[U8 3] -- U8) [
	copy -> dup 'a >= (when [ '` - 10 * (r 1+) ] [ drop 0 ])
	(r move) -> '0 - + (as U8)
])
(test link-index-to-keyset [
	 "0" keyset-to-link-index (should eq 0)
	"a8" keyset-to-link-index (should eq 18)
	"b1" keyset-to-link-index (should eq 21)
	 "8" keyset-to-link-index (should eq 8)
	"c0" keyset-to-link-index (should eq 30)
])