|
Programma di esempio PRT2HTM.PRT |
; PRT2HTM
;
; Programma per Proteus
;
; (C) 1998-2003 Simone Zanella Productions
;
; Converte un programma Proteus (.prt) in un file HTML, formattandolo
; opportunamente ed aggiungendovi i codici HTML per l'evidenziazione
; sintattica. Il parametro ISO permette anche la conversione PC 437 ->
; ISO Latin 1 durante la formattazione.
; Parametri impliciti: input e output predefiniti nulli
;!proteus -z
; Costanti preformattate per l'ouput HTML
TEXT HTML_INTEST = "FINE"
<!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="Programma $PROGNAME">
<meta name="keywords"
content="programma, $PROGNAME">
<title>Programma $PROGNAME</title>
<!-- Evidenziazione sintattica prodotta da PRT2HTM -->
</head>
<body bgcolor="#FFFFFF">
<pre>FINE
TEXT HTML_END = "FINE"
</pre>
</body>
</html>FINE
FUNCTION ColorConstants(s)
; Aggiunge i codici colori per stringhe, numeri e simboli
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)
; Aggiunge i codici colori per TO..STEP in FOR
;
; Sintassi di FOR:
;
; 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)
; Aggiunge i codici colori per metodi e direttive
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), ";#")
; Commento di una riga
s = indent_space "\x4" s "\x7"
HtmlEncode(@s)
RETURN
FI
IF STRIEQ(LEFT(Method, 1), "!")
; Direttiva
IF STRIEQ(Method, _Str_BDOC)
_InDoc = INC(_InDoc)
ELSE
IF STRIEQ(Method, _Str_EDOC)
_InDoc = DEC(_InDoc)
FI
FI
color = 6
ELSE
; Metodo?
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
; Forza la valutazione della label come numero
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)
; Converte i caratteri critici, rimappa su Iso Latin 1, aggiunge
; la sintassi colorata
STRTRAN(@s, "&", "&")
STRTRAN(@s, "<", "<")
STRTRAN(@s, ">", ">")
STRTRAN(@s, "\"", """)
IF _ISO_Convert
MAP(_DW, @s)
FI
ExpandColors(@s)
RETURN
FUNCTION ExpandColors(s)
; Espande i codici colori nelle sequenze HTML
; Stringhe
STRTRAN(@s, "\x1", "<font color=\"#FF0000\">")
; Numeri
STRTRAN(@s, "\x2", "<font color=\"#FF8000\">")
; Simboli
STRTRAN(@s, "\x3", "<font color=\"#808080\">")
; Commenti
STRTRAN(@s, "\x4", "<font color=\"#006400\">")
; Metodi
STRTRAN(@s, "\x5", "<font color=\"#0000FF\">")
; Direttive
STRTRAN(@s, "\x6", "<font color=\"#800080\">")
STRTRAN(@s, "\x7", "</font>")
RETURN
; Queste sono tutte le stringhe utilizzate dal programma,
; da modificare in caso di nazionalizzazione
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 "Sintassi: " ARGV(1) " " ARGV(2) " program.prt [destination [ISO]]"
CONSOLELN ""
CONSOLELN "Scopo: formatta in HTML il programma con sintassi evidenziata."
CONSOLELN "Se destination e` una directory, il file program.html viene creato"
CONSOLELN "al suo interno. Se destination e` un file, l'output formattato"
CONSOLELN "andra` a sovrascrivere il suo contenuto. Se destination non viene"
CONSOLELN "specificato, il file program.html viene creato nella stessa"
CONSOLELN "cartella di 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
; Mappatura 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")
; Determina il separatore di directory sulla base del sistema operativo
!ifdef UNIX
DirSep = "/"
!else
DirSep = "\\"
!endif
; Isola la directory base e la specifica del file
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 "Errore: impossibile aprire " Spec
ABORT 0
FI
; Pathname del file destinazione, creato nella directory dei sorgenti
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 "Errore: impossibile creare " S
FCLOSE(H)
ABORT 0
FI
; Stampa l'intestazione HTML sostituendo il nome del file nel titolo
FWRITELN(D, STRTRAN(HTML_INTEST, "$PROGNAME", UPPER(Spec)))
; Traduce ogni riga, mappando su Iso Latin 1 e sostituendo con
; le sequenze &..; i caratteri critici
INDOC = 0
INTEXT = 0
WHILE NOT(FEOF(H))
S = FREADLN(H)
Translate(@S)
FWRITELN(D, S)
LOOP
; Scrive la chiusura standard del documento HTML
FWRITE(D, HTML_END)
FCLOSE(D)
FCLOSE(H)
ABORT 0
FUNCTION QualifyName(s, ext)
; Isola l'estensione
p = STRRSTR(s, ".")
IF p
RETURN LEFT(s, DEC(p)) ext
FI
RETURN s ext