; LANGUAGE
;
; Programma per Proteus
;
; (C) 1998 Simone Zanella Productions
;
; Questo programma crea i file di supporto linguistico per Proteus:
; keyword.h (parole chiave) e message.h (messaggi).
; Si veda language.txt per il formato del file di configurazione.

; Parametri impliciti: input e output predefiniti nulli
;!proteus -z

SET H = FOPEN("language.txt", 1)
IF EQ(H, -1)
  CONSOLELN "File \"language.txt\" non trovato; verificare."
  ABORT 0
FI

IF OR(ISEMPTY(ARGV(5)), ISEMPTY(ARGV(6)))
  CONSOLELN "Sintassi: " ARGV(1) " " ARGV(2) " lingua_keyword lingua_msg"
  CONSOLELN "Scopo: crea gli header di supporto linguistico per Proteus"
  ABORT 0
FI

KWLanguage = UPPER(ARGV(5))
MSGLanguage = UPPER(ARGV(6))

SET Section = ""
SET L = LTRIM(FREADLN(H), " ")

SET MSG_IDLanguage = ""
SET KW_ColLanguage = -1
SET NumLanguage = 0

REPEAT
  ; Ignora tutti i commenti
  IF AND(ISNOTEMPTY(L), AND(STRNEQ(LEFT(L, 1), ";"), IMATCH(L, "[*]")))
    SET NewSec = LTRIM(RTRIM(L, "]"), "[")
    IF ISEMPTY(Section)
      IF STRINEQ(NewSec, "languages")
        CONSOLELN "La prima sezione non è \"[languages]\"; verificare."
        ABORT 0
      FI
    FI
    IF STRIEQ(Section, "languages")
      IF EQ(KW_ColLanguage, -1)
        CONSOLELN "Lingua delle parole chiave non trovata."
        ABORT 0
      FI
      IF ISEMPTY(MSG_IDLanguage)
        CONSOLELN "Lingua dei messaggi non trovata."
        ABORT 0
      FI
      SET M = FOPEN("message.h", 26)
      IF EQ(M, -1)
        CONSOLELN "Impossibile creare \"message.h\"."
        ABORT 0
      FI
      FWRITELN(M, \
               "/* File generato automaticamente da \"language.txt\" il " \
               DATE() "; non modificare! */")

      SET K = FOPEN("keyword.h", 26)
      IF EQ(K, -1)
        CONSOLELN "Impossibile creare \"keyword.h\"."
        ABORT 0
      FI
      FWRITELN(K, \
               "/* File generato automaticamente da \"language.txt\" il " \
               DATE() "; non modificare! */")
    FI
    SET Section = NewSec
    SWITCH NewSec STRIEQ

      ON "languages"
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF STREQ(LEFT(L, 1), "[")
            BREAK
          FI
          IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
            IF STRIEQ(TOKEN(L, 1, " "), ARGV(5))
              ; Lingua delle parole chiave
              SET KW_ColLanguage = ADD(TOKEN(L, 2, " "), 0)
            FI
            IF STRIEQ(TOKEN(L, 1, " "), ARGV(6))
              ; Lingua dei messaggi
              SET MSG_IDLanguage = TOKEN(L, 1, " ")
            FI
            INC(@NumLanguage)
          FI
        UNTIL OR(FEOF(H), STREQ(LEFT(L, 1), "["))

      ON "functions", "methods"
        SET QH = QUEUENEW()
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF STREQ(LEFT(L, 1), "[")
            BREAK
          FI
          IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
            ENQUEUE(QH, ExtractLang(L, NumLanguage, KW_ColLanguage))
          FI
        UNTIL OR(FEOF(H), STREQ(LEFT(L, 1), "["))
        SET VN = QueueToVec(QH)
        IF STRIEQ(NewSec, "functions")
          WritePar(K, VN)
          FWRITELN(K, "")
          FWRITELN(K, "enum func_type {")
          WriteToken(K, VN, 2)
          FWRITELN(K, "};")
          FWRITELN(K, "")
          FWRITELN(K, "char *funclist[] = {")
          WriteToken(K, VN, 1)
          FWRITELN(K, "};")
          FWRITELN(K, "")
          FWRITELN(K, "char funcnpar[] = {")
          WriteToken(K, VN, 3)
        ELSE
          WritePar(K, VN)
          FWRITELN(K, "")
          FWRITELN(K, "enum met_type {")
          WriteToken(K, VN, 2)
          FWRITELN(K, "};")
          FWRITELN(K, "")
          FWRITELN(K, "char *metlist[] = {")
          WriteToken(K, VN, 1)
          FWRITELN(K, "};")
          FWRITELN(K, "")
          FWRITELN(K, "int metpar[] = {")
          WriteToken(K, VN, 3)
        FI
        VECFREE(VN)
        FWRITELN(K, "};")
        FWRITELN(K, "")

      ON "directives"
        SET QH = QUEUENEW()
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF STREQ(LEFT(L, 1), "[")
            BREAK
          FI
          IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
            ENQUEUE(QH, TOKEN(L, KW_ColLanguage, " ") " " \
                        TOKEN(L, INC(NumLanguage), " "))
          FI
        UNTIL OR(FEOF(H), STREQ(LEFT(L, 1), "["))
        SET VN = QueueToVec(QH)
        FWRITELN(K, "")
        FWRITELN(K, "char *dtvlist[] = {")
        WriteDTV(K, VN, 1)
        FWRITELN(K, "};")
        FWRITELN(K, "")
        FWRITELN(K, "enum dtv_code {")
        WriteDTV(K, VN, 2)
        VECFREE(VN)
        FWRITELN(K, "};")
        FWRITELN(K, "")

      ON "defines", "prefunc", "postfunc", "core"
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF STREQ(LEFT(L, 1), "[")
            BREAK
          FI
          IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
            SET S = TOKEN(L, KW_ColLanguage, " ")
            IF STRIEQ(NewSec, "core")
              SET S = "\"<" STRIPQUOTES(S) ">\""
            FI
            FWRITELN(K, "#define " \
                     PADR(TOKEN(L, INC(NumLanguage), " "), 30, " ") S)
          FI
        UNTIL OR(FEOF(H), STREQ(LEFT(L, 1), "["))

      ON "messages", "dosmessages", "unxmessages"
        SWITCH NewSec STRIEQ
          ON "dosmessages"
            FWRITELN(M, "#ifndef COMP_UNIX")
          ON "unxmessages"
            FWRITELN(M, "#ifdef COMP_UNIX")
        OFF
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF OR(FEOF(H), STREQ(LEFT(L, 1), "["))
            CONSOLELN "Lingua dei messaggi non trovata nella sezione [" \
                      NewSec "]"
            ABORT 0
          FI
          IF STREQ(LEFT(L, 1), "(")
            SET S = ALLTRIM(RTRIM(L, " "), "()")
            IF STRIEQ(S, MSG_IDLanguage)
              REPEAT
                SET L = LTRIM(FREADLN(H), " ")
                IF ISEMPTY(L)
                  CONTINUE
                FI
                IF IN(LEFT(L, 1), "[(")
                  BREAK
                FI
                IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
                  SET S = ALLTRIM(RESTFROM(L, POSTOKEN(L, 2, " ")), " ")
                  FWRITELN(M, "#define " \
                           PADR(TOKEN(L, 1, " "), 30, " ") S)
                FI
              UNTIL FEOF(H)
              BREAK
            FI
          FI
        UNTIL 0
        IF STRINEQ(NewSec, "messages")
          FWRITELN(M, "#endif")
        FI

      ON "help"
        FWRITELN(M, "#ifdef DECLARE_HELP")
        FWRITELN(M, "static char *hlptext[] = {")
        REPEAT
          SET L = LTRIM(FREADLN(H), " ")
          IF OR(FEOF(H), STREQ(LEFT(L, 1), "["))
            CONSOLELN "Lingua dei messaggi non trovata nella sezione [" \
                      NewSec "]"
            ABORT 0
          FI
          IF STREQ(LEFT(L, 1), "(")
            SET S = ALLTRIM(RTRIM(L, " "), "()")
            IF STRIEQ(S, MSG_IDLanguage)
              SET First = 1
              REPEAT
                SET L = ALLTRIM(FREADLN(H), " ")
                IF ISEMPTY(L)
                  CONTINUE
                FI
                IF IN(LEFT(L, 1), "[(")
                  BREAK
                FI
                IF AND(ISNOTEMPTY(L), STRNEQ(LEFT(L, 1), ";"))
                  IF NOT(First)
                    FWRITELN(M, ",")
                  ELSE
                    SET First = 0
                  FI
                  FWRITE(M, L)
                FI
              UNTIL FEOF(H)
              BREAK
            FI
          FI
        UNTIL 0
        FWRITELN(M, "};")
        FWRITELN(M, "#endif")
    OFF
  ELSE
    SET L = LTRIM(FREADLN(H), " ")
  FI
UNTIL FEOF(H)
FCLOSE(H)
FCLOSE(K)
FCLOSE(M)
CONSOLELN "Copiare i file \"message.h\" e \"keyword.h\" nella"
CONSOLELN "directory con i sorgenti di Proteus."
ABORT 0


FUNCTION QueueToVec(qh)

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


FUNCTION ExtractLang(l, n, col)

  SET col2 = INC(n)
  SET col3 = INC(col2)
  SET col4 = INC(col3)
  SET col5 = INC(col4)
  SET l = TOKEN(l, col, " ") " " TOKEN(l, col2, " ") " " \
          TOKEN(l, col3, " ") " " TOKEN(l, col4, " ") " " \
          TOKEN(l, col5, " ")
RETURN l


FUNCTION WriteDTV(h, vn, n)

  FOR x = 1 TO VECLEN(vn)
    FWRITELN(h, TOKEN(VECGET(vn, x), n, " ") \
                IIF(EQ(x, VECLEN(vn)), "", ","))
  NEXT
RETURN


FUNCTION WritePar(h, vn)

  FOR x = 1 TO VECLEN(vn)
    SET s = VECGET(vn, x)
    SET f = TOKEN(s, 5, " ")
    SET t = TOKEN(s, 4, " ")
    SET u = PADR(TOKEN(s, 3, " "), 30, " ")
    IF IN("/", t)
      FWRITELN(h, "#ifndef COMP_UNIX")
      FWRITELN(h, "#define " u TOKEN(t, 1, "/"))
      FWRITELN(h, "#else")
      FWRITELN(h, "#define " u  TOKEN(t, 2, "/"))
      FWRITELN(h, "#endif")
    ELSE
      SWITCH f STRIEQ
        ON "D"
          FWRITELN(h, "#ifndef COMP_UNIX")
        ON "U"
          FWRITELN(h, "#ifdef COMP_UNIX")
      OFF
      FWRITELN(h, "#define " u t)
      IF STRINEQ(f, "N")
        FWRITELN(h, "#endif")
      FI
    FI
  NEXT
RETURN


FUNCTION WriteToken(h, vn, n)

  FOR x = 1 TO VECLEN(vn)
    SET s = VECGET(vn, x)
    SET f = TOKEN(s, 5, " ")
    SWITCH f STRIEQ
      ON "D"
        FWRITELN(h, "#ifndef COMP_UNIX")
      ON "U"
        FWRITELN(h, "#ifdef COMP_UNIX")
    OFF
    FWRITELN(h, TOKEN(s, n, " ") IIF(EQ(x, VECLEN(vn)), "", ","))
    IF STRINEQ(f, "N")
      FWRITELN(h, "#endif")
    FI
  NEXT
RETURN