Home
More Samples
/////////////////////////////////////////////////////////////////////////////// // // This program converts an .F1 (Formula One source code file) into an .HTML // file. // // The purpose is to display the .F1 file with much the same look and feel as // when viewed in the F1 compiler IDE: fixed font, colorized syntax, // non-breakable spaces etc. Well, except the page background color, which // looks better grey when displayed in browsers. // // To run the program, issue the following query: // // F1toHTML('input.f1':Bin, 'output.html':Bin, 'title string') // // The program assumes the input file is an .F1 file, there are no sanity // checks. // /////////////////////////////////////////////////////////////////////////////// local Color = ColorKeyword | ColorComment | ColorString | ColorText | ColorNumber local Symbol = Word | Number | Char | Eof | EndColor local Quote = SingleQuote | DoubleQuote | NoQuote local YesNo = Yes | No local CommentType = None | SingleLine local State = nest:I, // nesting level of comment block symbol:Symbol, // calculated parse symbol char:I[0..256], // parsed character color:Color, // current color comment:CommentType,// single line comment word:S, // parsed word lookahead:I, // lookahead character quote:Quote, // field to track single and double quotes verbose:YesNo // flag the next character as verbose (escape sequence) // Words to be displayed Red local F1Keywords :< [0..]->S = ['pred','iff','proc','if','else','elsif','end','then','_cdecl','_stdcall','external', 'case','true','false','of','in','subr','local','use','Nil','one', 'min', 'max','all', 'mod','_pred','_file','_line','_addressof'] local F1Chars :<[0..]->I[0..255] = [" ",":",".","<",">","+","-","*","|",",","(",")","[","]","&","=", "0","1","2","3","4","5","6","7","8","9" ] local F1Numbers :<[0..]->I[0..255] = ["0","1","2","3","4","5","6","7","8","9" ] proc F1toHTML(fin:.Bin,fout:.Bin,title:<S) iff DbRewind(fout) & st:.State & st:= (0,Word," ",ColorText,None,'',0,NoQuote,No) & HtmlWritePrologue(fout,title) & Parse(fin,fout,st) & HtmlWriteEpilogue(fout) & DbTruncate(fout) local proc Parse(fin:.Bin,fout:.Bin,st:.State) iff NextSymbol(fin,fout,st) & if st.symbol <> Eof then if st.symbol = Char then case st.char of ">" => HtmlWrite(fout,'>'); "<" => HtmlWrite(fout,'<'); "&" => HtmlWrite(fout,'&'); "\"" => HtmlWrite(fout,'"'); else DbPut(fout,st.char) end elsif st.symbol = Word then ProcessWord(fout,st) elsif st.symbol = Number then ProcessNumber(fout,st) elsif st.symbol = EndColor then DbPut(fout,st.char) & SetColor(fout,st,ColorText) end & Parse(fin,fout,st) end // Check if the word is one of F1 reserved keywords. If so, and we are not in a comment // block nor part of single line comment, nor part of a quoted string, paint it blue. // Otherwise, just use the current color. local proc ProcessWord(fout:.Bin,st:.State) iff if st.quote = NoQuote & st.nest = 0 & st.comment = None & st.word in F1Keywords then SetColor(fout,st,ColorKeyword) & HtmlWrite(fout,st.word) & SetColor(fout,st,ColorText) else HtmlWrite(fout,st.word) end local proc ProcessNumber(fout:.Bin,st:.State) iff if st.quote = NoQuote & st.nest = 0 & st.comment = None then SetColor(fout,st,ColorNumber) & HtmlWrite(fout,st.word) & SetColor(fout,st,ColorText) else HtmlWrite(fout,st.word) end // Parse the next symbol. Basically track if we are in comment, quote, single line comment // etc. The parsed symbol is returned in st.symbol: // // st.symbol = Char : st.char containes a character to be printed out // st.symbol = Word : st.word contains a word (string) to be printed out // st.symbol = EndColor: restore black color after the st.char is printed out // st.symbol = Eof: end of file // // Additional information about current state of comments, quotes etc. is also kept // in additional st. fields. local proc NextSymbol(fin:.Bin, fout:.Bin,st:.State) iff if st.lookahead <> 0 then c = st.lookahead & st.lookahead := 0 else NextChar(fin,st,c) end & if st.symbol <> Eof then st.char := c & st.symbol := Char & if st.verbose = Yes then st.verbose := No else if c = "\\" then st.verbose := Yes {the very next char will be unprocessed} elsif c = "\"" then if st.nest = 0 & st.comment = None & st.quote <> SingleQuote then if st.quote = NoQuote then st.quote := DoubleQuote else st.quote := NoQuote end end elsif c = "'" then if st.nest = 0 & st.comment = None & st.quote <> DoubleQuote then if st.quote = NoQuote then st.quote := SingleQuote & SetColor(fout,st,ColorString) else st.quote := NoQuote & st.symbol := EndColor end end elsif c = "{" then if st.comment = None & st.quote = NoQuote then st.nest := st.nest + 1 & if st.nest = 1 then SetColor(fout,st,ColorComment) end end elsif c = "}" then if st.comment = None & st.quote = NoQuote then st.nest := st.nest - 1 & if st.nest = 0 then st.symbol := EndColor end end elsif c = "/" then if st.quote = NoQuote & st.nest = 0 & st.comment = None then NextChar(fin,st,c2) & if c2 = "/" then st.comment := SingleLine & SetColor(fout,st,ColorComment) end & st.lookahead := c2 end elsif c = "\n" then st.comment := None & if st.nest = 0 then SetColor(fout,st,ColorText) end elsif c in F1Numbers then st.symbol := Number & st.word := c:S & GetRestOfNumber(fin,st) elsif ~c in F1Chars then st.symbol := Word & st.word := c:S & GetRestOfWord(fin,st) end end end local proc GetRestOfWord(fin:.Bin,st:.State) iff NextChar(fin,st,c) & if (c >= "a" & c <= "z") | (c >= "A" & c < "Z") | (c >= "0" & c <= "9") | c = "_"then st.word := Append(st.word,c:S) & GetRestOfWord(fin,st) else st.lookahead := c end local proc GetRestOfNumber(fin:.Bin,st:.State) iff NextChar(fin,st,c) & if (c >= "0" & c <= "9") then st.word := Append(st.word,c:S) & GetRestOfNumber(fin,st) else st.lookahead := c end local proc NextChar(fin:.Bin, st:.State, ch:>I) iff if DbAccess(fin,c) then ch = c & DbSkip(fin,1) else st.symbol := Eof & ch = 0 end local proc SetColor(fout:.Bin,st:.State,color:<Color) iff if st.color <> color then case color of ColorComment => HtmlWrite(fout,'<span class="comment">'); ColorString => HtmlWrite(fout,'<span class="string">'); ColorKeyword => HtmlWrite(fout,'<span class="keyword">'); ColorNumber => HtmlWrite(fout,'<span class="number">'); ColorText => HtmlWrite(fout,'</span>'); end & st.color := color end local proc HtmlWritePrologue(f:.Bin,title:<S) iff HtmlWrite(f,'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">\n') & HtmlWrite(f,'<html>\n') & HtmlWrite(f,'<head>\n') & HtmlWrite(f,' <meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">\n') & HtmlWrite(f,' <meta name="keywords" content="formulaone,f1compiler,logic,programming,source,code,sample">\n') & HtmlWrite(f,' <style type="text/css">\n') & HtmlWrite(f,' hr {\n') & HtmlWrite(f,' color: rgb(136,143,255);\n') & HtmlWrite(f,' background-color: rgb(136,143,255);\n') & HtmlWrite(f,' height: 5px; \n') & HtmlWrite(f,' }\n') & HtmlWrite(f,' span.keyword { color:rgb(51,51,255) }\n') & HtmlWrite(f,' span.comment { color:rgb(0,102,0) }\n') & HtmlWrite(f,' span.string { color:rgb(204,0,0) }\n') & HtmlWrite(f,' span.number { color:rgb(128,64,0) }\n') & HtmlWrite(f,' </style>\n') & HtmlWrite(f,' <title>') & HtmlWrite(f,'F1 Source Code: ') & HtmlWrite(f,title) & HtmlWrite(f,' </title>\n') & HtmlWrite(f,'</head>\n') & HtmlWrite(f,' <body bgcolor="#dddddd" text="#000000" link="#0000ee" alink="#0000ee" vlink="#551a8b">\n') & HtmlWrite(f,' <a href="/default.html"><img src="/images/up.gif" align="middle" hspace="5" height="32" width="32" alt="Home">Home</a>\n') & HtmlWrite(f,' <a href="samples.html"><img src="/images/next.gif" align="middle" hspace="5" height="32" width="32" alt="More Samples">More Samples</a>\n') & HtmlWrite(f,' <hr>\n') & HtmlWrite(f,' <pre>\n') local proc HtmlWriteEpilogue(f:.Bin) iff HtmlWrite(f,'</pre>\n') & HtmlWrite(f,'<hr>\n') & HtmlWrite(f,'<p class="MsoNormal"><i><span style="font-size: 10pt; font-family: Arial; color: rgb(255, 15, 80);">') & HtmlWrite(f,'This page was created by F1toHTML</span></i></p>\n') & HtmlWrite(f,'</body>\n') & HtmlWrite(f,'</html>\n') local proc HtmlWrite(f:.Bin,s:<S) iff HtmlWriteString1(f,0,Len(s),s) local proc HtmlWriteString1(f:.Bin,i:<I,len:<I,s:<S) iff if i < len then if s(i) <> 13 then DbPut(f,s(i)) end & HtmlWriteString1(f,i+1,len,s) end
This page was created by F1toHTML