; TRANSLAT
;
; Programma per Proteus
;
; (C) 1998 Simone Zanella Productions
;
; Questo programma traduce un programma Proteus da una lingua
; ad un'altra.
; Proteus deve essere invocato in questo modo:
;
; proteus translat.prt program.prt program.new srclang dstlang
;
; dove:
; program.old    è il programma da tradurre
; program.new    è il nome del file per il programma tradotto
; srclang        è la lingua del file sorgente
; dstlang        è la lingua del file destinazione
;
; Questo programma utilizza il file "language.txt", che deve essere
; disponibile.
;
; Cosa è tradotto:
; - gli identificatori che sono predefiniti in srclang;
; - tutte le funzioni di libreria;
; - tutti i metodi;
; - tutte le direttive.
;
; Cosa non è modificato:
; - commenti;
; - blocchi di documentazione (tra !bdoc e !edoc);
; - i nomi di funzioni dentro stringhe (se non sono primo parametro
;   di FUNC).
;
; Cosa non è verificato:
; - il numero di parametri per ciascuna funzione.

FUNCTION ONSTART()

  IF OR(ISEMPTY(ARGV(5)), ISEMPTY(ARGV(6)))
    CONSOLELN "Sintassi: " ARGV(1) " " ARGV(2) \
              " program.old program.new srclang dstlang"
    CONSOLELN "Scopo: traduce program.old (in lingua srclang) nel programma" \
              " program.new (in lingua dstlang)."
    ABORT 0
  FI
  SET h = FOPEN("language.txt", 1)
  IF EQ(h, -1)
    CONSOLELN "File \"language.txt\" non trovato; verificare."
    ABORT 0
  FI

  SET section = ""
  SET ql = QUEUENEW()
  SET qf = QUEUENEW()
  SET qm = QUEUENEW()
  SET qd = QUEUENEW()
  SET qv = QUEUENEW()
  SET ln = LTRIM(FREADLN(h), " ")
  WHILE NOT(FEOF(h))
    ; Ignora tutti i commenti
    IF AND(ISNOTEMPTY(ln), STRNEQ(LEFT(ln, 1), ";"), \
           IMATCH(ln, "[*]"))
      SET newsec = LTRIM(RTRIM(ln, "]"), "[")
      IF ISEMPTY(section)
        IF STRINEQ(newsec, "languages")
          CONSOLELN "La prima sezione non è \"[languages]\"; verificare."
          ABORT 0
        FI
      FI
      SET section = newsec
      SWITCH newsec STRIEQ
        ON "languages"
          SET qh = ql
        ON "functions"
          SET qh = qf
        ON "prefunc"
          SET qh = qf
        ON "postfunc"
          SET qh = qf
        ON "methods"
          SET qh = qm
        ON "directives"
          SET qh = qv
        ON "defines"
          SET qh = qd
        OTHER
          SET qh = -1
      OFF
      IF EQ(qh, -1)
        REPEAT
          SET ln = LTRIM(FREADLN(h), " ")
        UNTIL OR(FEOF(h), STRNEQ(LEFT(ln, 1), "["))
      ELSE
        SET ln = LTRIM(FREADLN(h), " ")
        WHILE AND(NOT(FEOF(h)), STRNEQ(LEFT(ln, 1), "["))
          IF AND(ISNOTEMPTY(ln), STRNEQ(LEFT(ln, 1), ";"))
            ENQUEUE(qh, PACKCHAR(ln, " "))
          FI
          SET ln = LTRIM(FREADLN(h), " ")
        LOOP
      FI
    ELSE
      SET ln = LTRIM(FREADLN(h), " ")
    FI
  LOOP
  FCLOSE(h)

  SET vf = QueueToVec(qf)
  SET vm = QueueToVec(qm)
  SET vd = QueueToVec(qd)
  SET vv = QueueToVec(qv)

  SET srclang = 0
  SET dstlang = 0
  SET n = QUEUELEN(ql)
  WHILE QUEUELEN(ql)
    SET s = DEQUEUE(ql)
    SWITCH TOKEN(s, 1, " ") STRIEQ
      ON ARGV(5)
        SET srclang = TOKEN(s, 2, " ")
      ON ARGV(6)
        SET dstlang = TOKEN(s, 2, " ")
    OFF
  LOOP
  QUEUEFREE(ql)

  IF OR(EQ(srclang, 0), EQ(dstlang, 0))
    CONSOLELN "Lingua sorgente o destinazione non trovata."
    ABORT 0
  FI

  INC(@n)

  PSET AD = ExtractLang(vd, srclang, dstlang)

  ; Determina la posizione dei metodi TEXT e SWITCH
  PSET AM = VECNEW(VECLEN(vm))
  SET tv = PUB(AM)
  FOR x = 1 TO VECLEN(vm)
    SET s = VECGET(vm, x)
    SET t = TOKEN(s, n, " ")
    SET s = STRIPQUOTES(TOKEN(s, srclang, " ")) " " \
            STRIPQUOTES(TOKEN(s, dstlang, " ")) " "
    SWITCH t STRIEQ
      ON "MT_TEXT"
        SET s = s "*"
      ON "MT_SWITCH"
        SET s = s "+"
    OFF
    VECSET(tv, x, s)
  NEXT
  SORT(tv, 4, 1)
  VECFREE(vm)

  FOR x = 1 TO VECLEN(tv)
    SWITCH TOKEN(VECGET(tv, x), 3, " ") STRIEQ
      ON "*"
        PSET TextPos = x
      ON "+"
        PSET SwitchPos = x
    OFF
  NEXT

  ; Determina la posizione della funzione FUNC
  PSET AF = VECNEW(VECLEN(vf))
  SET tv = PUB(AF)
  FOR x = 1 TO VECLEN(vf)
    SET s = VECGET(vf, x)
    VECSET(tv, x, STRIPQUOTES(TOKEN(s, srclang, " ")) " " \
                  STRIPQUOTES(TOKEN(s, dstlang, " ")) " " \
                  IIF(STRIEQ("FN_FUNC", TOKEN(s, n, " ")), "*", ""))
  NEXT
  SORT(tv, 4, 1)
  VECFREE(vf)

  FOR x = 1 TO VECLEN(tv)
    IF STRIEQ("*", TOKEN(VECGET(tv, x), 3, " "))
      PSET FuncPos = x
      BREAK
    FI
  NEXT

  ; Determina la posizione delle direttive !bdoc e !edoc
  PSET AV = VECNEW(VECLEN(vv))
  SET tv = PUB(AV)
  FOR x = 1 TO VECLEN(vv)
    SET s = VECGET(vv, x)
    SET s2 = TOKEN(s, n, " ")
    VECSET(tv, x, STRIPQUOTES(TOKEN(s, srclang, " ")) " " \
                  STRIPQUOTES(TOKEN(s, dstlang, " ")) " " \
                  IIF(STRIEQ("DTV_BDOC", s2), "1", \
                  IIF(STRIEQ("DTV_EDOC", s2), "2", "")))
  NEXT
  SORT(tv, 4, 1)
  VECFREE(vv)
  FOR x = 1 TO VECLEN(tv)
    SWITCH TOKEN(VECGET(tv, x), 3, " ") STREQ
      ON "1"
        PSET BDocPos = x
        PSET BDocDTV = TOKEN(VECGET(tv, x), srclang, " ")
      ON "2"
        PSET EDocPos = x
        PSET EDocDTV = TOKEN(VECGET(tv, x), srclang, " ")
    OFF
  NEXT

  PSET InDoc = 0
  PSET InText = 0
RETURN


FUNCTION QueueToVec(qh)

  SET vh = VECNEW(QUEUELEN(qh))
  SET x = 1
  WHILE QUEUELEN(qh)
    VECSET(vh, x, DEQUEUE(qh))
    INC(@x)
  LOOP
  QUEUEFREE(qh)
RETURN vh


FUNCTION ExtractLang(vf, SrcCol, DstCol)

  SET vn = VECNEW(VECLEN(vf))
  FOR x = 1 TO VECLEN(vf)
    SET s = VECGET(vf, x)
    VECSET(vn, x, STRIPQUOTES(TOKEN(s, SrcCol, " ")) \
           " " STRIPQUOTES(TOKEN(s, DstCol, " ")))
  NEXT
  SORT(vn, 4, 1)
  VECFREE(vf)
RETURN vn


; Programma principale (eseguito per ogni linea)
IF IN(LEFT(LTRIM(L, " "), 1), "#;")
  PRINTLN L
  ; Commento - ignorato
  IGNORE
FI

IF NOT(MetSpecial(L))
  PRINTLN L
  IGNORE
FI

; Si prende cura delle direttive !bdoc/!edoc
IF NOT(DTVSpecial(L))
  PRINTLN L
  IGNORE
FI

; Suddivide la linea in componenti
SET VL = SplitLine(L)

; Il primo elemento può essere un metodo, una direttiva, una
; funzione o un identificatore (se il secondo elemento è un
; simbolo '='); gli altri elementi possono essere funzioni o
; identificatori; fa eccezione SWITCH, che può avere una funzione come 
; terzo parametro: SWITCH exp [func]

SET First = 1
SET MetSwitch = 0
FOR X = 1 TO VECLEN(VL)
  SET S = VECGET(VL, X)
  IF ISNOTEMPTY(S)
    IF First
      SET First = 0
      ; Direttiva?
      IF STREQ(LEFT(S, 1), "!")
        ProcessDTV(VL, S, X)
      ELSE
        ; Funzione?
        IF STREQ(RIGHT(S, 1), "(")
          ProcessFunc(VL, S, X)
        ELSE
          ; SET implicito?
          IF STREQ(ALLTRIM(VECGET(VL, INC(X)) \
                   VECGET(VL, ADD(X, 2)), " "), "=")
            ProcessID(VL, S, X)
          ELSE
            ; Metodo
            SET MetName = S
            SET P = BSEARCHUDF(AM, MetName, TokComp)
            IF P
              SET MetSwitch = EQ(P, SwitchPos)
              SET S = STRTRAN(S, MetName, \
                              TOKEN(VECGET(AM, P), 2, " "))
              VECSET(VL, X, S)
              IF EQ(P, TextPos)
                ; Isola l'etichetta che termina il testo
                ; La sintassi del metodo è:
                ; TEXT id [=] "string" | number
                SET P = POSTOKEN(L, 3, " ")
                IF STREQ(SUBSTR(L, P, 1), "=")
                  SET TextTerm = RESTFROM(L, POSTOKEN(L, 4, " "))
                ELSE
                  SET TextTerm = RESTFROM(L, P)
                FI
                IF STREQ(LEFT(TextTerm, 1), "\"")
                  RTRIM(@TextTerm, " ")
                  STRIPQUOTES(@TextTerm)
                  CTRAN(@TextTerm)
                ELSE
                  ; Forza la valutazione di TextTerm come numero
                  ADD(@TextTerm, 0)
                FI
                SET InText = 1
              FI
            FI
          FI
        FI
      FI
    ELSE
      ; Il token non è il primo valido
      IF NOT(IN(LEFT(LTRIM(S, " "), 1), "+-0123456789\""))
        IF STREQ(RIGHT(S, 1), "(")
          ; Chiamata di funzione
          ProcessFunc(VL, S, X)
        ELSE
          ; Se è un identificatore, ma il metodo è SWITCH
          ; e chiude l'istruzione e non è il secondo token
          ; sulla stringa, allora è il parametro funzione di SWITCH;
          ; pertanto, devo cercarlo tra le funzioni
          IF AND(MetSwitch, EQ(X, VECLEN(VL)), NEQ(X, 2))
            ProcessFunc(VL, S, X)
          ELSE
            ; ID
            ProcessID(VL, S, X)
          FI
        FI
      FI
    FI
  FI
NEXT
FOR X = 1 TO VECLEN(VL)
  PRINT VECGET(VL, X)
NEXT
PRINTLN ""
VECFREE(VL)


FUNCTION TokComp(e1, e2)

RETURN STRICMP(TOKEN(e1, 1, " "), TOKEN(e2, 1, " "))


FUNCTION SplitLine(l)

  SET len = STRLEN(l)
  SET x = 1
  SET vl = VECNEW(0)
  SET last = ""
  WHILE LE(x, len)
    SET a = SUBSTR(l, x, 1)
    INC(@x)
    SWITCH a STREQ
      ON " "
        IF ISEMPTY(last)
          SET last = last a
        ELSE
          VECAPPEND(vl, last)
          SET last = a
        FI
      ON "\""
        VECAPPEND(vl, last)
        SET last = a
        SET c = ""
        WHILE LE(x, len)
          SET b = SUBSTR(l, x, 1)
          INC(@x)
          IF AND(STREQ(b, "\""), STRNEQ(c, "\\"))
            VECAPPEND(vl, last b)
            SET last = ""
            BREAK
          FI
          IF AND(STREQ(b, "\\"), STREQ(c, "\\"))
            SET c = ""
          ELSE
            SET c = b
          FI
          SET last = last b
        LOOP
      ON "("
        VECAPPEND(vl, last a)
        SET last = ""
      ON ","
        VECAPPEND(vl, last a)
        SET last = ""
      ON ")"
        VECAPPEND(vl, last a)
        SET last = ""
      OTHER
        IF ISEMPTY(last)
          VECAPPEND(vl, last)
          SET last = a
        ELSE
          SET last = last a
        FI
    OFF
  LOOP
  VECAPPEND(vl, last)
RETURN vl


FUNCTION ProcessFunc(vl, s, x)

  ; Funzione
  SET func_name = RTRIM(ALLTRIM(s, " "), "(")
  IF STREQ(LEFT(func_name, 1), "@")
    RESTFROM(@func_name, 2)
  FI
  SET p = BSEARCHUDF(PUB(AF), func_name, TokComp)
  IF p
    SET s = STRTRAN(s, func_name, \
                    TOKEN(VECGET(PUB(AF), p), 2, " "))
    VECSET(vl, x, s)
    ; FN_FUNC? Allora sostituisce il primo parametro, se stringa
    IF EQ(p, PUB(FuncPos))
      INC(@x)
      WHILE LT(x, VECLEN(vl))
        SET s = VECGET(vl, x)
        IF ISNOTEMPTY(s)
          BREAK
        FI
        INC(@x)
      LOOP
      IF STREQ(LEFT(s, 1), "\"")
        SET func_name = STRIPQUOTES(s)
        SET p = BSEARCHUDF(PUB(AF), func_name, TokComp)
        IF p
          SET s = STRTRAN(s, "\"" func_name "\"", \
                          "\"" TOKEN(VECGET(PUB(AF), p), 2, " ") "\"")
          VECSET(vl, x, s)
        FI
      FI
    FI
  FI
RETURN


FUNCTION ProcessDTV(vl, s, x)

  ; Direttiva
  SET dtv_name = RESTFROM(s, 2)
  SET p = BSEARCHUDF(PUB(AV), dtv_name, TokComp)
  IF p
    STRTRAN(@s, dtv_name, TOKEN(VECGET(PUB(AV), p), 2, " "))
    VECSET(vl, x, s)
    IF EQ(p, PUB(BDocPos))
      INC(@PUB(InDoc))
    ELSE
      IF EQ(p, PUB(EDocPos))
        DEC(@PUB(InDoc))
      FI
    FI
  FI
RETURN


FUNCTION DTVSpecial(l)

  ; Ritorna 1 se la linea deve essere elaborata (fuori !bdoc..!edoc,
  ; oppure la stessa direttiva !bdoc/!edoc), 0 altrimenti
  IF PUB(InDoc)
    SET pl = TOKEN(LTRIM(l, " "), 1, " ")
    IF STREQ(LEFT(pl, 1), "!")
      RESTFROM(@pl, 2)
      IF OR(STRIEQ(pl, PUB(EDocDTV)), STRIEQ(pl, PUB(BDocDTV)))
        ; Processa la linea
        RETURN 1
      FI
    FI
    RETURN 0
  FI
RETURN 1


FUNCTION MetSpecial(l)

  ; Ritorna 1 se la linea deve essere elaborata (fuori dal metodo TEXT),
  ; 0 altrimenti
  IF PUB(InText)
    RTRIM(@l, " \t")
    IF STREQ(RIGHT(l, STRLEN(PUB(TextTerm))), PUB(TextTerm))
      PSET InText = 0
    FI
    RETURN 0
  FI
RETURN 1


FUNCTION ProcessID(vl, s, x)

  ; Identificatore
  SET IdName = ALLTRIM(s, ",)\\")
  IF STREQ(LEFT(IdName, 1), "@")
    RESTFROM(@IdName, 2)
  FI
  SET p = BSEARCHUDF(PUB(AD), IdName, TokComp)
  IF p
    SET s = STRTRAN(s, IdName, TOKEN(VECGET(PUB(AD), p), 2, " "))
    VECSET(vl, x, s)
  FI
RETURN