path: root/forth/gmi2html.fs

\ 2022 - winduptoy.sensorstation.co
\ PUBLIC DOMAIN

\ USAGE
\ $ cat in.gmi | gforth gmi2html.fs > out.html
\
\ This only outputs major blocks, allowing full customization of the HTML document.
\ Best used in composition, like so:
\ 
\ $ cat _header.html > out.html
\ $	cat in.gmi | gforth gmi2html.fs >> out.html
\ $ cat _footer.html >> out.html

\ === HTML Output === \

\ : html-line-break ." <br>" ;

: html-line-break ." " ;
: 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 -- )
	.\" <p><a rel=\"noreferrer\" href=\"" type .\" \">"
	type
	." </a></p>"
	;

: 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