/*
 *	$VER: rdag2html 2.1 (1.1.1997) Copyright (C) by Michael Ranner
 *	E-Mail: rmike@sbox.tu-graz.ac.at
 *	Homepage: http://www.sbox.tu-graz.ac.at/home/rmike/
 *
 *      Modified by Magnus Holmgren (8.11.96)
 *
 *	This piece of code is Public Domain. Use it, distribute it, modify it!
 *	If you have some useful modifications, please send it to the author!
 */

call time('E')

parse arg arguments

template = 'Source/A,Dest/K,SingleFile/S,TOC/K,Index/K,Help/K,Icons/S,' || ,
	   'TOCIcon/K,TOCIconDisabled/K,TOCText/K,IndexIcon/K,IndexIconDisabled/K,IndexText/K,' || ,
	   'HelpIcon/K,HelpIconDisabled/K,HelpText/K,PrevIcon/K,PrevIconDisabled/K,PrevIconText/K,' || ,
	   'NextIcon/K,NextIconDisabled/K,NextText/K,HideDisabledLinks/S,' || ,
	   'Background/K,BGColor/K,TextColor/K,LinkColor/K,ALinkColor/K,VLinkColor/K,' || ,
	   'FontSize/K,NoHR/S,Header/K,Footer/K,NoLowerCase/S,Suffix/K,8Point3/S,NoStrip/S,' || ,
           'NoInternational/S,ArgFile/K'

argArray. = ''
argArray.Source = ''
argArray.Dest   = ''
argArray.SingleFile = 0
argArray.TOC = ''
argArray.Index = ''
argArray.Help = ''
argArray.Icons = 0
argArray.TOCIcon = 'images/content.gif'
argArray.TOCIconDisabled = 'images/dcontent.gif'
argArray.TOCText = '[Contents]'
argArray.IndexIcon = 'images/index.gif'
argArray.IndexIconDisabled = 'images/dindex.gif'
argArray.IndexText = '[Index]'
argArray.HelpIcon = 'images/help.gif'
argArray.HelpIconDisabled = 'images/dhelp.gif'
argArray.HelpText = '[Help]'
argArray.PrevIcon = 'images/prev.gif'
argArray.PrevIconDisabled = 'images/dprev.gif'
argArray.PrevText = '[Browse <]'
argArray.NextIcon = 'images/next.gif'
argArray.NextIconDisabled = 'images/dnext.gif'
argArray.NextText = '[Browse >]'
argArray.HideDisabledLinks = 0
argArray.Background = ''
argArray.BGColor = ''
argArray.TextColor = ''
argArray.LinkColor = ''
argArray.ALinkColor = ''
argArray.VLinkColor = ''
argArray.FontSize = ''
argArray.NoHR = 0
argArray.Header = ''
argArray.Footer = ''
argArray.NoLowerCase = 0
argArray.Suffix = '.html'
argArray.8Point3 = 0
argArray.NoStrip = 0
argArray.NoInternational = 0
argArray.ArgFile = ''

rc = MyReadArgs(template, arguments) 

if rc ~= 0 then do
	return rc
end

if ~existsFile(argArray.Source) then do
	return 205
end

header = ''
comment = 'Converted on ' || date() || ' with RexxDoesAmigaGuide2HTML 2.1 by Michael Ranner.'
footer  = 'Converted on ' || date() || ' with RexxDoesAmigaGuide2HTML 2.1 by <A HREF="http://www.sbox.tu-graz.ac.at/home/rmike">Michael Ranner</A>.</P>'

if argArray.Dest = '' & argArray.SingleFile then argArray.Dest = 'out.html'

if argArray.8Point3 then argArray.Suffix = '.htm'

if argArray.ArgFile ~= '' then do
	if ~existsFile(argArray.ArgFile) then do
		return 205
	end

	open('ArgFile', argArray.ArgFile, 'R')

	do while ~eof('ArgFile')
		interpret readln('ArgFile')
	end

	close('ArgFile')
end

if argArray.Header ~= '' then do
	if ~existsFile(argArray.Header) then do
		return 205
	end

	open('Header', argArray.Header, 'R')
	header = readFile('Header')
	close('Header')
end

if argArray.Footer ~= '' then do
	if ~existsFile(argArray.Footer) then do
		return 205
	end

	open('Footer', argArray.Footer, 'R')
	footer = readFile('Footer')
	close('Footer')
end

if argArray.Icons then do
	tocA = '<IMG SRC="'argArray.TOCIcon'" ALT="'argArray.TOCText'" BORDER="0">'
	dtocA = '<IMG SRC="'argArray.TOCIconDisabled'" ALT="'argArray.TOCText'">'
	indexA = '<IMG SRC="'argArray.IndexIcon'" ALT="'argArray.IndexText'" BORDER="0">'
	dindexA = '<IMG SRC="'argArray.IndexIconDisabled'" ALT="'argArray.IndexText'">'
	helpA = '<IMG SRC="'argArray.HelpIcon'" ALT="'argArray.HelpText'" BORDER="0">'
	dhelpA = '<IMG SRC="'argArray.HelpIconDisabled'" ALT="'argArray.HelpText'">'
	prevA = '<IMG SRC="'argArray.PrevIcon'" ALT="'argArray.PrevText'" BORDER="0">'
	dprevA = '<IMG SRC="'argArray.PrevIconDisabled'" ALT="'argArray.PrevText'">'
	nextA = '<IMG SRC="'argArray.NextIcon'" ALT="'argArray.NextText'" BORDER="0">'
	dnextA = '<IMG SRC="'argArray.NextIconDisabled'" ALT="'argArray.NextText'">'
end
else do
	tocA = argArray.TOCText
	dtocA = tocA
	indexA = argArray.IndexText
	dindexA = indexA
	helpA = argArray.HelpText
	dhelpA = helpA
	prevA = argArray.PrevText
	dprevA = prevA
	nextA = argArray.NextText
	dnextA = nextA
end

if argArray.HideDisabledLinks then do
	dtocA = ''
	dindexA = ''
	dhelpA = ''
	dprevA = ''
	dnextA = ''
end

currentNode = ''
destination. = ''
id = pragma('ID')
open = 0
tmpfile = 't:rdag2html_' || id || '.tmp'
oldDir = ''

/* Scanning for nodes */

say 'Scanning for nodes...'

i = 0

address command 'Search' argArray.Source 'nonum @NODE >' || tmpfile

call open('NodeList', tmpfile)

do until eof('NodeList')
	line = readln('NodeList')

	if upper(word(line, 1)) = '@NODE' then do
		i = i + 1
		nodes.i = getNode(line)
	end
end

close('NodeList')
address command 'Delete' tmpfile '>NIL:'

nodes.0 = i
nextNodeNum = 1
currentNode = ''

/* Main */

call open('Guide', argArray.Source, 'R')
srcline = readln('Guide')

if upper(word(srcline, 1)) ~= '@DATABASE' then do
	say "That's not an AmigaGuide file!"
	return 10
end

if argArray.SingleFile then do
	open('HTML', argArray.Dest, 'W')
	open = 1
	writeHeader(word(srcline, 2), comment, header)
end
else if argArray.Dest ~= '' then do
	oldDir = pragma('D', argArray.Dest)
end

do until eof('Guide')
	srcline = readln('Guide')
	srcline = replaceString('&', '&amp;', srcline)
	/* srcline = replaceString('<', '&lt;', srcline) */
	/* srcline = replaceString('>', '&gt;', srcline) */
	srcline = replaceString('\\', '\', srcline)

	if index(srcline, '@') > 0 then do
		srcline = replaceString('\@', '&#64;', srcline)
		token = upper(word(srcline, 1))

		select
			when token = '@AUTHOR' then do
				say 'Author: ' || subword(srcline, 2)
			end

			when token = '@$VER:' then do
				say 'Version: ' || subword(srcline, 2)
			end

			when token = '@REMARK' | token = '@REM' then do
				say 'Remark: ' || subword(srcline, 2)
			end

			when token = '@NODE' then do
				n = 0

				if nextNodeNum < nodes.0 then do
					nextNodeNum = nextNodeNum + 1
					nextNode = nodes.nextNodeNum
				end
				else nextNode = ''

				prevNode = currentNode
				currentNode = getNode(srcline)
				currentHTMLDoc = currentNode || argArray.Suffix
				nodeTitle = getTitle(srcLine)

				if upper(currentNode) = 'MAIN' then do
					currentNode = 'main'
				end

				say 'Node:' currentNode

				if ~argArray.SingleFile then do
					call open('HTML', currentHTMLDoc, 'W')
					open = 1

					if currentNode = 'main' & argArray.TOC ~= '' then do
						_tocURL = argArray.TOC
					end
					else do
						_tocURL = 'main'argArray.Suffix
					end

					_indexURL = argArray.Index
					_helpURL = argArray.Help
				end
			end

			when token = '@TOC' & argArray.TOC = '' then do
				_tocURL = getNode(srcline) || argArray.Suffix
			end

			when token = '@INDEX' & argArray.Index = '' then do
				_indexURL = getNode(srcline) || argArray.Suffix
			end

			when token = '@HELP' & argArray.Help = '' then do
				_helpURL = getNode(srcline) || argArray.Suffix
			end

			when token = '@NEXT' then do
				nextNode = getNode(srcline)
			end

			when token = '@PREV' then do
				prevNode = getNode(srcline)
			end

			when token = '@ENDNODE' then do

				if argArray.SingleFile then do
					call writech('HTML', '<A NAME="' || currentNode || '">')

					if nodeTitle ~= '' then do
						call writech('HTML', '<H3>'nodeTitle'</H3>')
					end

					call writeln('HTML', '</A>')
					call writech('HTML', '<PRE>')
				end
				else do
					call writeHeader(nodeTitle, comment, header)

					if _tocURL ~= currentHTMLDoc then do
						call writeln('HTML', '<A HREF="'_tocURL'">'tocA'</A>')
					end
					else do
						call writeln('HTML', dtocA)
					end

					if _indexURL ~= '' & _indexURL ~= currentHTMLDoc then do
						call writeln('HTML', '<A HREF="'_indexURL'">'indexA'</A>')
					end
					else do
						call writeln('HTML', dindexA)
					end

					if _helpURL ~= '' & _helpURL ~= currentHTMLDoc then do
						call writeln('HTML', '<A HREF="'_helpURL'">'helpA'</A>')
					end
					else do
						call writeln('HTML', dhelpA)
					end

					if prevNode ~= '' then do
						call writeln('HTML', '<A HREF="'prevNode || argArray.Suffix'">'prevA'</A>')
					end
					else do
						call writeln('HTML', dprevA)
					end

					if nextNode ~= '' then do
						call writeln('HTML', '<A HREF="'nextNode || argArray.Suffix'">'nextA'</A>')
					end
					else do
						call writeln('HTML', dnextA)
					end

					call writech('HTML', '<HR><PRE>')
				end

				if argArray.FontSize ~= '' then do
					call writech('HTML', '<FONT SIZE="'argArray.FontSize'">')
				end

				do i = 0 to n
					call writeln('HTML', destination.i)
				end

				if argArray.FontSize ~= '' then do
					call writech('HTML', '</FONT>')
				end

				if argArray.SingleFile then do

					if argArray.NoHR then do
						call writeln('HTML', '</PRE>')
					end
					else do
						call writeln('HTML', '</PRE><P><HR>')
					end

				end
				else do

					if argArray.NoHR then do
						call writeln('HTML', '</PRE>')
					end
					else do
						call writeln('HTML', '</PRE><HR>')
					end
						
					call writeFooter(footer)
					call close('HTML')
					open = 0
				end
			end

			otherwise do
				dstline = ''

				do while srcline ~= ''
					parse var srcline start '@{' text '}' srcline
					token = upper(text)
					start = replaceString('<', '&lt;', start)
					start = replaceString('>', '&gt;', start)

					select
						when token = 'AMIGAGUIDE' then do
							dstline = dstline || start || '<B>AmigaGuide</B>&reg;'
						end

						when token = 'I' then do
							dstline = dstline || start || '<I>'
						end

						when token = 'UI' then do
							dstline = dstline || start || '</I>'
						end

						when token = 'B' then do
							dstline = dstline || start || '<B>'
						end

						when token = 'UB' then do
							dstline = dstline || start || '</B>'
						end

						when token = 'U' then do
							dstline = dstline || start || '<U>'
						end

						when token = 'UU' then do
							dstline = dstline || start || '</U>'
						end

						when abbrev(token, '!') then do
							dstline = dstline || start || right(text, length(text) - 1)
						end

						otherwise do
							parse var text '"' name '"' token node

							if pos('"', node) ~= 0 then parse var node '"'node'"' destLineNumber .
							else parse var node node destLineNumber

							token = upper(token)
							node = compress(node, ' "')

							if argArray.NoInternational then do
								node = replaceString('Ä', 'Ae', node)
								node = replaceString('Ö', 'Oe', node)
								node = replaceString('Ü', 'Ue', node)
								node = replaceString('ä', 'ae', node)
								node = replaceString('ö', 'oe', node)
								node = replaceString('ü', 'ue', node)
								node = replaceString('ß', 'ss', node)
							end

							if ~argArray.NoLowerCase then do
								node = lowerCase(node)
							end

							if ~argArray.NoStrip then do
								node = stripNode(node)
							end

							if token = 'LINK' then do
								if argArray.SingleFile = 1 then do
									dstline = dstline || start || '<A HREF="#' || node || '">' || name || '</A>'
								end
								else do
									dstline = dstline || start || '<A HREF="' || node || argArray.Suffix || '">' || name || '</A>'
								end
							end
							else do
								dstline = dstline || start
							end
						end
					end
				end

				if open & ~abbrev(dstline, '@') then do
					n = n + 1
					destination.n = dstline
				end
			end
		end
	end
	else do
		if open then do
			n = n + 1
			destination.n = srcline
		end
	end
end

if argArray.SingleFile then do
	writeFooter(footer)
	close('HTML')
end

call close('Guide')

if oldDir ~= '' then do
	pragma('D', oldDir)
end

say 'Time elapsed:' time('E')

exit

/* Parse the argument string */

MyReadArgs: procedure expose argArray.

	parse arg template, string
	string = strip(string, 'T')

	if right(string, 1) = '?' then do
		string = left(string, length(string) - 1)
		call writech('STDOUT', template': ')
		string = string || readln('STDOUT')
	end

	upString = upper(string)

	do while template ~= ''
		parse upper var template parameter'/'key','template

		value = ''
		i = find(upString, parameter)

		if i > 0 then do
			select
				when key = "S" then do
					value = 1
				end

				when (key = "K") | (key = "A") then do
					value = word(string, i + 1)

					if index(value, '"') ~= 0 then do
						value = subword(string, i + 1)
						parse var value '"'value'"' .
					end
				end

				when key = "N" then do
					value = word(string, i + 1)
				end

				otherwise nop
			end
		end

		if (key = 'A') & (value = '') then do
			value = word(string, 1)

			if index(value, '"') ~= 0 then do
				value = subword(string, i + 1)
				parse var value '"'value'"' .
			end

			if value = '' then do
				say "Missing argument"
				return 116
			end
		end

		if value ~= '' then do
			argArray.parameter = value
		end

		/* say "Parameter" parameter "Key" key "Value" argArray.parameter */
	end

	return 0

/* Check if file exists */

existsFile:
	if ~exists(arg(1)) then do
		say arg(1) "not found"
		return 0
	end
	else do
		return 1
	end

/* Replace char/substring in string */

replaceString:
	parse arg old, new, string

	if index(string, old) > 0 then do
		parse var string begin(old)end
		return begin || new || replaceString(old, new, end)
	end

	return string

/* Procedures for header and footer */

writeHeader: procedure expose argArray.
	parse arg title, comment, header

	call writeln('HTML', '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">')
	call writeln('HTML', '<!-- ' || comment || ' -->')
	call writeln('HTML', '<HTML>')
	call writeln('HTML', '<HEAD>')
	call writeln('HTML', '<TITLE>' || title || '</TITLE>')
	call writeln('HTML', '</HEAD>')
	call writech('HTML', '<BODY')

	if argArray.Background ~= '' then do
		call writech('HTML', ' BACKGROUND="'argArray.Background'"')
	end

	if argArray.BGColor ~= '' then do
		call writech('HTML', ' BGCOLOR="'argArray.BGColor'"')
	end

	if argArray.TextColor ~= '' then do
		call writech('HTML', ' TEXT="'argArray.TextColor'"')
	end

	if argArray.LinkColor ~= '' then do
		call writech('HTML', ' LINK="'argArray.LinkColor'"')
	end

	if argArray.ALinkColor ~= '' then do
		call writech('HTML', ' ALINK="'argArray.ALinkColor'"')
	end

	if argArray.VLinkColor ~= '' then do
		call writech('HTML', ' VLINK="'argArray.VLinkColor'"')
	end

	call writeln('HTML', '>')

	call writeln('HTML', header)
	return 0

writeFooter: procedure
	parse arg footer

	call writeln('HTML', footer)
	call writeln('HTML','</BODY></HTML>')
	return 0

/* Read the content of a small file */

readFile: procedure
	parse arg file

	string = ''

	do until eof(file)
		string = string || readln(file) || '0A'X
	end

	return string

/* Make string lower case */

lowerCase:
	return translate(arg(1), 'abcdefghijklmnopqrstuvwxyz', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')

/* Get the node from a '@NODE' string */

getNode: procedure expose argArray.
	parse arg string

	if index(word(string, 2), '"') > 0 then do
		parse var string '"'node'"' .
	end
	else do
		node = word(string, 2)
	end

	node = compress(node, ' "')

	if ~argArray.NoLowerCase then do
		node = lowerCase(node)
	end

	if ~argArray.NoStrip then do
		node = stripNode(node)
	end

	if argArray.NoInternational then do
		node = replaceString('Ä', 'Ae', node)
		node = replaceString('Ö', 'Oe', node)
		node = replaceString('Ü', 'Ue', node)
		node = replaceString('ä', 'ae', node)
		node = replaceString('ö', 'oe', node)
		node = replaceString('ü', 'ue', node)
		node = replaceString('ß', 'ss', node)
	end

	return node

/* Get the title from a '@NODE' string */

getTitle: procedure
	parse arg string

	if index(word(string, 2), '"') > 0 then do
		parse var string '"'node'"' title
	end
	else do
		title = subword(string, 3)
	end

	return compress(title, '"')

/* Strip nodes down */

stripNode: procedure expose argArray.
	parse arg name

	strlen = length(name)

	if argArray.8Point3 then do
		select
			when (strlen > 8) & (strlen < 16) then do
				name = left(name, 16 - strlen) || right(name, strlen - 8)
			end

			when (strlen >= 16) then do
				name = left(name, 1) || right(name, 7)
			end

			otherwise nop
		end
	end
	else do
		select
			when (strlen > 25) & (strlen < 50) then do
				name = left(name, 50 - strlen) || right(name, strlen - 25)
			end

			when (strlen >= 50) then do
				name = left(name, 1) || right(name, 24)
			end

			otherwise nop
		end
	end

	return name