; PRT2HTM
;
; Program for Proteus
;
; (C) 1998-2004 Simone Zanella Productions
;
; Convert a Proteus program (.prt) into a HTML file, adding tags
; for syntax highlighting. The parameter "ISO" allow for PC 437 to ISO Latin 1
; conversion during formatting.
; Implicit parameters: input e output NULL
;!proteus -z
; Constants for HTML output
TEXT HTML_INTEST = "END"
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">
<meta name="description"
content="Program $PROGNAME">
<meta name="keywords"
content="program, $PROGNAME">
<title>Program $PROGNAME</title>
<!-- Syntax highlighting created by PRT2HTM -->
</head>
<body bgcolor="#FFFFFF">
<pre>END
TEXT HTML_END = "END"
</pre>
</body>
</html>END
FUNCTION ColorConstants(s)
; Add color tags for strings, numbers and symbols
x = 1
WHILE LE(x, STRLEN(s))
c = SUBSTR(s, x, 1)
IF STREQ(c, "\"")
INSERT(@s, x, "\x1")
ADD(@x, 2)
prev = " "
WHILE AND(LE(x, STRLEN(s)), OR(STRNEQ(SUBSTR(s, x, 1), "\""), \
STREQ(prev, "\\")))
c = SUBSTR(s, x, 1)
IF AND(STREQ(c, "\\"), STREQ(prev, "\\"))
prev = " "
ELSE
prev = c
FI
INC(@x)
LOOP
INC(@x)
INSERT(@s, x, "\x7")
ELSE
IF IN(c, "+-0123456789")
IF IN(c, "+-")
IF EQ(SUBSTR(s, INC(x), 1), " ")
INC(@X)
CONTINUE
FI
STUFF(@s, x, 1, "\x3" c "\x7")
ADD(@x, 3)
FI
INSERT(@s, x, "\x2")
ADD(@x, 2)
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), "0123456789e.+-xXAaBbCcDdEeFf"))
INC(@x)
LOOP
INSERT(@s, x, "\x7")
ELSE
IF IN(c, "(),=@")
STUFF(@s, x, 1, "\x3" c "\x7")
ADD(@x, 2)
ELSE
IF NOT(IN(c, " \t"))
INC(@x)
WHILE AND(LE(x, STRLEN(s)), NOT(IN(SUBSTR(s, x, 1), " \t,()\"")))
INC(@x)
LOOP
IF IN(SUBSTR(s, x, 1), " \t")
INC(@x)
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), " \t"))
INC(@x)
LOOP
FI
DEC(@x)
FI
FI
FI
FI
INC(@x)
LOOP
RETURN
FUNCTION ColorToStep(s)
; Add color codes for TO..STEP in FOR..NEXT
;
; FOR syntax:
;
; FOR id = exp1 TO exp2 STEP exp3
x = 1
part = 1
to_part = -1
step_part = -1
WHILE LE(x, STRLEN(s))
c = SUBSTR(s, x, 1)
SWITCH part EQ
ON 3
IF EQ(to_part, -1)
IF STREQ(c, "=")
to_part = 5
step_part = 7
ELSE
to_part = 4
step_part = 6
FI
FI
ON to_part
INSERT(@s, x, "\x5")
WHILE AND(LE(x, STRLEN(s)), NOT(IN(SUBSTR(s, x, 1), " \t")))
INC(@x)
LOOP
INSERT(@s, x, "\x7")
INC(@x)
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), " \t"))
INC(@x)
LOOP
INC(@part)
CONTINUE
ON step_part
INSERT(@s, x, "\x5")
WHILE AND(LE(x, STRLEN(s)), NOT(IN(SUBSTR(s, x, 1), " \t")))
INC(@x)
LOOP
INSERT(@s, x, "\x7")
INC(@x)
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), " \t"))
INC(@x)
LOOP
INC(@part)
CONTINUE
OFF
SWITCH c IN
ON " \t"
INC(@part)
INC(@x)
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), " \t"))
INC(@x)
LOOP
DEC(@x)
ON "("
INC(@x)
inpar = 1
WHILE AND(LE(x, STRLEN(s)), inpar)
c = SUBSTR(s, x, 1)
SWITCH c STREQ
ON "\""
prev = " "
WHILE AND(LE(x, STRLEN(s)), OR(STRNEQ(SUBSTR(s, x, 1), "\""), \
STREQ(prev, "\\")))
prev = SUBSTR(s, x, 1)
INC(@x)
LOOP
ON "("
INC(@inpar)
ON ")"
DEC(@inpar)
OFF
INC(@x)
LOOP
DEC(@x)
OFF
INC(@x)
LOOP
RETURN
FUNCTION Translate(s)
; Add color codes for methods and directives
x = 1
WHILE AND(LE(x, STRLEN(s)), IN(SUBSTR(s, x, 1), " \t"))
INC(@x)
LOOP
IF DEC(x)
indent_space = LEFT(s, DEC(x))
s = RESTFROM(s, x)
ELSE
indent_space = ""
FI
Method = TOKEN(s, 1, " \t")
IF _InDoc
IF STRIEQ(Method, _Str_EDOC)
_InDoc = DEC(_InDoc)
color = IIF(_InDoc, 4, 6)
ELSE
IF _InDoc
s = indent_space "\x4" s "\x7"
HtmlEncode(@s)
RETURN
ELSE
color = 4
FI
FI
ELSE
IF _InText
lab = RTRIM(s, " \t")
IF STREQ(RIGHT(lab, STRLEN(_TxtLabel)), _TxtLabel)
s = indent_space "\x1" LEFT(lab, NEG(STRLEN(_TxtLabel))) \
"\x7\x4" _TxtLabel "\x7"
_InText = 0
ELSE
s = indent_space "\x1" s "\x7"
FI
HtmlEncode(@s)
RETURN
FI
color = 0
IF IN(LEFT(Method, 1), ";#")
; One-line remark
s = indent_space "\x4" s "\x7"
HtmlEncode(@s)
RETURN
FI
IF STRIEQ(LEFT(Method, 1), "!")
; Directive
IF STRIEQ(Method, _Str_BDOC)
_InDoc = INC(_InDoc)
ELSE
IF STRIEQ(Method, _Str_EDOC)
_InDoc = DEC(_InDoc)
FI
FI
color = 6
ELSE
; Method?
FOR x = 1 TO VECLEN(_MetVec)
IF STRIEQ(Method, VECGET(_MetVec, x))
color = 5
BREAK
FI
NEXT
IF STRIEQ(Method, _Str_TEXT)
lab = LTRIM(RESTFROM(s, POSTOKEN(s, 3, " \t")), " \t=")
_InText = 1
IF STREQ(LEFT(lab, 1), "\"")
RTRIM(@lab, " \t")
STRIPQUOTES(@lab)
CTRAN(@lab)
ELSE
; Force label evaluation as a number
ADD(@lab, 0)
FI
_TxtLabel = lab
ELSE
IF STRIEQ(Method, _Str_FOR)
ColorToStep(@s)
FI
FI
FI
FI
IF color
s = CHR(color) Method "\x7" \
RESTFROM(s, INC(STRLEN(Method)))
FI
s = indent_space s
ColorConstants(@s)
HtmlEncode(@s)
RETURN
FUNCTION HtmlEncode(s)
; Convert critical characters, remap to Iso Latin 1, add colours
STRTRAN(@s, "&", "&")
STRTRAN(@s, "<", "<")
STRTRAN(@s, ">", ">")
STRTRAN(@s, "\"", """)
IF _ISO_Convert
MAP(_DW, @s)
FI
ExpandColors(@s)
RETURN
FUNCTION ExpandColors(s)
; Expand colour codes to HTML sequences
; Strings
STRTRAN(@s, "\x1", "<font color=\"#FF0000\">")
; Numbers
STRTRAN(@s, "\x2", "<font color=\"#FF8000\">")
; Symbols
STRTRAN(@s, "\x3", "<font color=\"#808080\">")
; Remarks
STRTRAN(@s, "\x4", "<font color=\"#006400\">")
; Methods
STRTRAN(@s, "\x5", "<font color=\"#0000FF\">")
; Directives
STRTRAN(@s, "\x6", "<font color=\"#800080\">")
STRTRAN(@s, "\x7", "</font>")
RETURN
; These are all the strings used in the program,
; to be modified for localization
MetVec = VECCREATE("TO", "STEP", "ABORT", "BREAK", "CONSOLE", "CONSOLELN", \
"CONTINUE", "DEBUG", "ELSE", "FI", "FOR", "FUNCTION", \
"IF", "IGNORE", "LOOP", "NEXT", "OFF", "ON", "ONC", \
"OTHER", "PRINT", "PRINTLN", "PSET", "REPEAT", "RETURN", \
"SET", "SWITCH", "UNTIL", "WHILE", "ERROR", "ERRORLN", \
"PAUSE", "CONST", "TEXT")
Str_TEXT = "TEXT"
Str_FOR = "FOR"
Str_BDOC = "!bdoc"
Str_EDOC = "!edoc"
SourceDir = STRIPQUOTES(ARGV(5))
IF ISEMPTY(SourceDir)
CONSOLELN "Syntax: " ARGV(1) " " ARGV(2) " program.prt [destination [ISO]]"
CONSOLELN ""
CONSOLELN "Purpose: format the program to HTML with syntax highlighting."
CONSOLELN "If \"destination\" is a directory, the file program.html will"
CONSOLELN "be created inside. If \"destination\" is a file, it will be"
CONSOLELN "overwritten. If \"destination\" is not specified,"
CONSOLELN "the file program.html will be created in the same folder"
CONSOLELN "as program.prt."
ABORT 0
FI
ISO_Convert = 0
DestFile = ""
IF GT(ARGC, 5)
IF STRIEQ(ARGV(6), "ISO")
ISO_Convert = 1
ELSE
DestFile = ARGV(6)
IF STRIEQ(ARGV(7), "ISO")
ISO_Convert = 1
FI
FI
FI
IF ISNOTEMPTY(DestFile)
N = ISFILE(DestFile)
DestIsDir = EQ(N, 2)
FI
; Mapping Pc-437 -> Iso Latin 1
DW = MAPNEW("\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C" \
"\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99" \
"\x9A\x9B\x9C\x9D\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7" \
"\xA8\xAA\xAB\xAC\xAD\xAE\xAF\xB1\xB3\xE6\xEC\xED\xF0" \
"\xF1\xF6\xF8\xF9\xFA\xFD\xFE\xFF", \
"\xC7\xFC\xE9\xE2\xE4\xE0\xE5\xE7\xEA\xEB\xE8\xEF\xEE" \
"\xEC\xC4\xC5\xC9\xE6\xC6\xF4\xF6\xF2\xFB\xF9\xFF\xD6" \
"\xDC\xA2\xA3\xA5\x83\xE1\xED\xF3\xFA\xF1\xD1\xAA\xBA" \
"\xBF\xAC\xBD\xBC\xA1\xAB\xBB\x7F\xA6\xB5\x9C\xF8\x3D" \
"\xB1\xF7\xB0\xB7\xB7\xB2\x95\xA0")
; Determine the directory separator according to the operating system
!ifdef UNIX
DirSep = "/"
!else
DirSep = "\\"
!endif
; Isolate base directory and file specification
X = STRRSTR(SourceDir, DirSep)
IF X
BaseDir = LEFT(SourceDir, X)
Spec = RESTFROM(SourceDir, INC(X))
ELSE
BaseDir = ""
Spec = SourceDir
FI
H = FOPEN(BaseDir IIF(ISNOTEMPTY(BaseDir), DirSep, "") \
Spec, 1)
IF EQ(H, -1)
CONSOLELN "Error: could not open " Spec
ABORT 0
FI
; Pathname for destination, created in the folder of the source files
IF ISEMPTY(DestFile)
S = QualifyName(BaseDir IIF(ISNOTEMPTY(BaseDir), DirSep, "") \
Spec, ".htm")
ELSE
IF DestIsDir
S = QualifyName(DestFile IIF(ISNOTEMPTY(DestFile), DirSep, "") \
Spec, ".htm")
ELSE
S = DestFile
FI
FI
D = FOPEN(S, 26)
IF EQ(D, -1)
CONSOLELN "Error: could not create " S
FCLOSE(H)
ABORT 0
FI
; Write HTML header, replacing the name of the file in the title
FWRITELN(D, STRTRAN(HTML_INTEST, "$PROGNAME", UPPER(Spec)))
; Translate each line, mapping to Iso Latin 1 and substituting
; all the critical characters with sequences "&..;"
INDOC = 0
INTEXT = 0
WHILE NOT(FEOF(H))
S = FREADLN(H)
Translate(@S)
FWRITELN(D, S)
LOOP
; Write end of HTML document
FWRITE(D, HTML_END)
FCLOSE(D)
FCLOSE(H)
ABORT 0
FUNCTION QualifyName(s, ext)
; Isolate extension
p = STRRSTR(s, ".")
IF p
RETURN LEFT(s, DEC(p)) ext
FI
RETURN s ext