From 779a412086f9c74a44b91ab1136098246620d76a Mon Sep 17 00:00:00 2001
From: elioat <elioat@tilde.institute>
Date: Mon, 21 Nov 2022 02:53:23 +0000
Subject: *

---
 forth/gmi2html.fs | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 164 insertions(+)
 create mode 100644 forth/gmi2html.fs

(limited to 'forth/gmi2html.fs')

diff --git a/forth/gmi2html.fs b/forth/gmi2html.fs
new file mode 100644
index 0000000..9776334
--- /dev/null
+++ b/forth/gmi2html.fs
@@ -0,0 +1,164 @@
+\ 2022 - winduptoy.sensorstation.co
+\ PUBLIC DOMAIN
+
+\ === HTML Output === \
+
+: html-line-break ." <br>" ;
+
+: html-blockquote-open ." <blockquote>" ;
+: html-blockquote-close ." </blockquote>" ;
+
+: html-preformatted-open ( c-content u -- )
+	.\" <pre aria-label=\"" type .\" \">" cr ;
+
+: html-preformatted-close ." </pre>" cr ;
+
+: html-list-open ." <ul>" ;
+: html-list-close ." </ul>" ;
+
+: html-paragraph-open ." <p>" ;
+: html-paragraph-close ." </p>" ;
+
+: html-list-item ( c-content u -- )
+	." <li>" type ." </li>" ;
+
+
+: html-link ( c-content u c-url u -- )
+	.\" <a rel=\"noreferrer\" href=\"" type .\" \">"
+	type
+	." </a>"
+	;
+
+: html-heading ( level c-content u -- )
+	." <h" 2 pick 48 + emit ." >"
+	type
+	." </h" 48 + emit ." >"
+	;
+
+\ === Parsing === \
+
+: starts-preformatted? ( c-addr u -- f )
+	s" ```" string-prefix? ;
+
+: starts-blockquote? ( c-addr u -- f )
+	s" >" string-prefix? ;
+
+: starts-list-item? ( c-addr u -- f )
+	s" *" string-prefix? ;
+
+: starts-link? ( c-addr u -- f )
+	s" =>" string-prefix? ;
+
+: starts-heading? ( c-addr u -- n ) \ returns header level
+	0 rot rot
+	3 min 0 ?do
+		dup i + c@ '# = if swap 1 + swap endif
+	loop drop ;
+
+4096 constant line-buffer-size
+create   line-buffer line-buffer-size chars allot
+variable line-number
+variable line-len
+
+0 constant capture-none
+1 constant capture-preformatted
+2 constant capture-blockquote
+3 constant capture-list
+variable capture-state
+
+: process-line ( -- )
+	capture-state @ case
+		capture-preformatted of
+			line-buffer line-len @ starts-preformatted? if
+				html-preformatted-close
+				capture-none capture-state !
+				exit
+			else
+				line-buffer line-len @ type cr
+				exit
+			endif
+		endof
+		capture-blockquote of
+			line-buffer line-len @ starts-blockquote? invert if
+				html-blockquote-close
+				capture-none capture-state !
+			endif
+		endof
+		capture-list of
+			line-buffer line-len @ starts-list-item? invert if
+				html-list-close
+				capture-none capture-state !
+			endif
+		endof
+	endcase
+
+	line-buffer line-len @ starts-preformatted? if
+		capture-preformatted capture-state !
+		line-buffer line-len @ '` skip
+		html-preformatted-open
+		exit
+	endif
+
+	line-buffer line-len @ starts-blockquote? if
+		capture-state @ capture-blockquote = invert if
+			html-blockquote-open
+			capture-blockquote capture-state !
+		endif
+		line-buffer 1 + line-len @ 1 - type
+		html-line-break cr
+		exit
+	endif
+	line-buffer line-len @ starts-list-item? if
+		capture-state @ capture-list = invert if
+			html-list-open
+			capture-list capture-state !
+		endif
+		line-buffer 1 + line-len @ 1 - html-list-item cr
+		exit
+	endif
+
+	line-buffer line-len @ starts-heading? dup if
+		line-buffer line-len @ '# skip 32 skip 9 skip html-heading cr
+		exit
+	endif drop
+
+	line-buffer line-len @ starts-link? if
+		line-buffer line-len @ '= skip '> skip 32 skip 9 skip ( c-addr len )
+
+		\ find end of URL
+		over over 32 scan ( c-addr len label-addr label-len )
+		>r dup >r 2 pick - swap drop ( c-addr url-len )
+		r> r> 32 skip 9 skip ( c-addr url-len label-addr label-len )
+		dup 0 = if \ use the URL for the label if no label is provided
+			drop drop over over
+		endif
+
+		2swap
+		html-link
+
+		exit
+	endif
+
+	line-len @ 0 = if
+		html-line-break cr
+	else
+		html-paragraph-open
+		line-buffer line-len @ type
+		html-paragraph-close cr
+	endif
+	;
+
+: gmi-to-html
+	begin
+		1 line-number +!
+		line-buffer line-buffer-size stdin read-line ( len flag err )
+		throw
+		invert if drop exit endif  \ false flag == eof
+		line-len !
+		process-line
+	again ;
+
+gmi-to-html
+
+depth throw \ ensure stack is clean
+bye
\ No newline at end of file
-- 
cgit 1.4.1-2-gfad0