' This is file h_2_bi_BiWriter.bas
' (C) 2010-2011 by TJF, GPLv3
' It's part of 'h_2_bi.bas' package, see for details:
' http://www.freebasic.net/forum/viewtopic.php?t=15364&postdays=0&postorder=asc&start=0

#DEFINE EXTE_COMM " ' (" & PROG_NAME & " -P_oCD option)"
#DEFINE LANG_COMM " ' (" & PROG_NAME & " -P_oBV option)"

TYPE BiWriter
  AS STRING TyNa = STACK_NEW
  AS STRING SuFu = STACK_NEW
  AS STRING LaWo
  AS INTEGER Deep
  AS CFileReader PTR In
  DECLARE DESTRUCTOR()
  DECLARE CONSTRUCTOR(BYREF F AS STRING, _
                      BYVAL O AS Config PTR, _
                      BYVAL P AS Options PTR, _
                      BYVAL M AS Macros PTR, _
                      BYVAL I AS CFileReader PTR, _
                      BYVAL E AS ErrorHandler PTR)
  DECLARE SUB add(BYREF T AS STRING, BYVAL Fl AS INTEGER = 0)
  DECLARE FUNCTION IncEbne(BYREF F AS STRING) AS CFileReader PTR
  DECLARE FUNCTION DecEbne() AS CFileReader PTR
  DECLARE FUNCTION checkFileNam(BYREF F AS STRING) AS STRING
Private:
  AS STRING InStack
  AS STRING Fok = STACK_NEW
  AS STRING Fko = STACK_NEW
  AS STRING BiNa, JoNa, CoLi
  AS INTEGER Fnr, Count, Ebne
  AS DOUBLE Ti
  AS ErrorHandler PTR Er
  AS Options PTR Op
  AS Macros PTR Ma
  AS Config PTR Co

  DECLARE SUB PostRepOut(BYREF T AS STRING)
  DECLARE FUNCTION ProNrOut(BYREF T AS STRING, BYREF N AS STRING) AS STRING
  DECLARE SUB ReplaOut(BYREF T AS STRING, BYVAL R AS RepData PTR, _
                       BYVAL N AS INTEGER, BYVAL Mo AS INTEGER)
  DECLARE SUB StackOut(BYREF T AS STRING, BYREF R AS STRING, BYVAL Mo AS INTEGER)
  DECLARE SUB MacroOut(BYVAL Mo AS INTEGER)
  DECLARE STATIC FUNCTION NormRep(BYREF S AS ZSTRING PTR, _
                                  BYREF E AS ZSTRING PTR, _
                                  BYREF Az AS INTEGER, _
                                  BYVAL Po AS ANY PTR) AS INTEGER
  DECLARE STATIC FUNCTION MacrRep(BYREF S AS ZSTRING PTR, _
                                  BYREF E AS ZSTRING PTR, _
                                  BYREF Az AS INTEGER, _
                                  BYVAL Po AS ANY PTR) AS INTEGER
END TYPE

CONSTRUCTOR BiWriter(BYREF F AS STRING, _
                     BYVAL C AS Config PTR, _
                     BYVAL P AS Options PTR, _
                     BYVAL M AS Macros PTR, _
                     BYVAL I AS CFileReader PTR, _
                     BYVAL E AS ErrorHandler PTR)
  Co = C
  Op = P
  Ma = M
  In = I
  Er = E
  JoNa = F
  BiNa = F & BI_FILE_SUFFIX
  Ti = TIMER
  Fnr = FREEFILE
  IF Op->RunMod = 1 THEN
    IF OPEN CONS (FOR OUTPUT, AS #Fnr) THEN Deep = -1 : EXIT CONSTRUCTOR
  ELSE
    IF OPEN (BiNa FOR OUTPUT AS #Fnr) THEN
      ? " Unable to write: " & BiNa : Deep = -1 : EXIT CONSTRUCTOR
    END IF
  END IF
  IF LEN(Co->Start) THEN add(Co->Start & NL)
  IF Op->O.CD = 0 THEN
    add("#LANG ""fb""" & NL & "EXTERN ""C""" & EXTE_COMM)
  ELSEIF Op->O.BV = 0 THEN
    IF Op->O.CD THEN add("#LANG ""fb""" & LANG_COMM)
  END IF
END CONSTRUCTOR

' writes translation result into output file, does BAREP.rep replacements
' schreibt das Ergebnis der Wandlung in Datei, ggf. Replace
DESTRUCTOR BiWriter()
  IF Op->O.CD = 0 THEN PRINT #Fnr, NL & NL & "END EXTERN" & EXTE_COMM;
  IF LEN(Co->Ende) THEN PRINT #Fnr, NL & NL & Co->Ende;
  IF Op->RunMod = 1 THEN PRINT #Fnr, NL; : CLOSE #Fnr : EXIT DESTRUCTOR

  ? "       directory: "; CURDIR
  ? "     output file: "; BiNa
  ? "      Parameters: ";
  IF LEN(Co->CoLi) THEN ? Co->CoLi ELSE ? "none (default)"

  VAR az = LOF(Fnr) - LEN(Co->Start)
  PRINT #Fnr, NL & NL & "' Translated at " & FORMAT(NOW, "yy-mm-dd hh:mm:ss") & _
              ", by " & PROG_NAME & " (version " & PROG_VERS & "," & NL & _
              "' released under GPLv3 by Thomas[ dot ]Freiherr{ at }gmx[ dot ]net)" & NL;

  IF Op->FLP = 0 THEN CLOSE #Fnr : EXIT DESTRUCTOR
  IF Op->P.NA THEN PRINT #Fnr, NL & "'   Protocol: " & BiNa & NL;
  IF Op->P.PA THEN PRINT #Fnr, "' Parameters: "; COMMAND & CoLi & NL;
  IF Op->P.TI THEN PRINT #Fnr, ProNrOut("Process time [s]", STR(TIMER - Ti)) & NL;
  IF Op->P.BY THEN PRINT #Fnr, ProNrOut("Bytes translated", STR(az)) & NL;
  IF Op->P.DE THEN PRINT #Fnr, ProNrOut("Maximum deep", STR(Deep)) & NL;
  StackOut("SUB/FUNCTION names",     SuFu, Op->P.NS + 2 * Op->P.LS)
  StackOut("mangled TYPE names",     TyNa, Op->P.NX + 2 * Op->P.LX)
  StackOut(        "files done",     Fok , Op->P.NF + 2 * Op->P.LF)
  StackOut(      "files missed",     Fko , Op->P.NY + 2 * Op->P.LY)
  StackOut(         KEY_FOLDERS, Co->Fold, Op->P.ND + 2 * Op->P.LD)
  MacroOut(Op->P.NM + 2 * Op->P.LM)
  ReplaOut(KEY_HEADERS,   @Co->Head,      Co->AzHe, Op->P.NH + 2 * Op->P.LH)
  ReplaOut(KEY_TYPES,     @Co->Typ_, -Co->AzTy + 1, Op->P.NT + 2 * Op->P.LT)
  ReplaOut(KEY_POST_REPS, @CO->Post, CO->Post.Az(), Op->P.NP + 2 * Op->P.LP)
  CLOSE #Fnr
END DESTRUCTOR

' starts a new INCLUDE level, return error message if any
' Startet eine neue #INCLUDE Ebene, liefert ggf. Fehlermeldung
FUNCTION BiWriter.IncEbne(BYREF F AS STRING) AS CFileReader PTR
  IF LEN(F) THEN
    VAR er = checkFileNam(F)
    IF LEN(er) THEN F = er : RETURN 0
  END IF
  VAR r = NEW CFileReader(F) : IF LEN(r->Erro) THEN F = r->Erro : RETURN 0

  VAR Nam = In->FNam
  InStack &= MKI(CAST(INTEGER, In))
  In = r : Ebne += 1 : IF Ebne > Deep THEN Deep = Ebne
  IF Op->O.MF THEN add(FILE_START(Ebne) & Nam & " ==> " & In->FNam, 1)
  RETURN In
END FUNCTION

' returns from last INCLUDE level
' Kehrt aus INCULDE file zurueck
FUNCTION BiWriter.DecEbne() AS CFileReader PTR
  VAR Nam = In->FNam
  DELETE In
  In = CAST(CFileReader PTR, CVI(RIGHT(InStack, 4)))
  IF Op->O.MF THEN add(FILE_BACK(Ebne) & Nam & " ==> " & In->FNam, 1)
  Ebne -= 1 : InStack = LEFT(InStack, LEN(InStack) - 4)
  RETURN In
END FUNCTION

' generates a comment line with tab on screen and in .bi
' erzeugt eine Kommentarzeile mit Tabulator (fuer console und .bi-Datei)
FUNCTION BiWriter.ProNrOut(BYREF T AS STRING, BYREF N AS STRING) AS STRING
  VAR p = 50 - LEN(T) : IF p < 1 THEN p = 1
  VAR r = STRING(p, 32) & T & ": " & N : ? r : RETURN "'" & r
END FUNCTION

' callback, generating a line for REP in output file
' Rueckruf-Funktion generiert eine REP-Zeile in Ergebnisdatei
STATIC FUNCTION BiWriter.MacrRep(BYREF Su AS ZSTRING PTR, _
                                 BYREF Er AS ZSTRING PTR, _
                                 BYREF Az AS INTEGER, _
                                 BYVAL Po AS ANY PTR) AS INTEGER
  VAR b = CAST(BiWriter PTR, Po), e = INSTR(b->Count, b->Co->Macros, CHR(1))
  PRINT #b->Fnr, genKom(Az & ": " & MID(b->Co->Macros, b->Count, e - b->Count)) & NL;
  b->Count = e + 1 :  RETURN 0
END FUNCTION

' writes REP-definitions as comment to output file
' schreibt REP-Definitionen als Kommentar in die Ausgabedatei
SUB BiWriter.MacroOut(BYVAL Mo AS INTEGER)
  Count = 6
  IF BIT(Mo, 0) THEN PRINT #Fnr, ProNrOut(KEY_MACROS, STR(Ma->Def.az())) & NL;
  IF BIT(Mo, 1) THEN Ma->Def.list(@BiWriter.MacrRep, @THIS)
END SUB

' callback, generating a line for REP in output file
' Rueckruf-Funktion generiert eine REP-Zeile in Ergebnisdatei
STATIC FUNCTION BiWriter.NormRep(BYREF Se AS ZSTRING PTR, _
                                 BYREF Re AS ZSTRING PTR, _
                                 BYREF Az AS INTEGER, _
                                 BYVAL Po AS ANY PTR) AS INTEGER
  VAR t = ">", p = 0, bw = CAST(BiWriter PTR, Po)
  IF bw->Count < 0 THEN bw->Count = ABS(bw->Count) : RETURN 0
  bw->Count -= 1 : IF bw->Count < 0 THEN RETURN 1
  WHILE (*Se)[p] = (*Re)[p] '                            compare strings
    p += 1
    IF (*Se)[p] = 0 THEN
      t = "&" : Re += p + IIF(*(Re + p) = TYKENN, LEN(TYKENN), 0) : EXIT WHILE
    END IF : IF (*Re)[p] = 0 THEN EXIT WHILE
  WEND : PRINT #bw->Fnr, "' " & Az & ": " & *Se & t & *Re & NL; : RETURN 0
END FUNCTION

' writes REP-definitions as comment to output file
' schreibt REP-Definitionen als Kommentar in die Ausgabedatei
SUB BiWriter.ReplaOut(BYREF T AS STRING, BYVAL R AS RepData PTR, _
                      BYVAL N AS INTEGER, BYVAL Mo AS INTEGER)
  IF BIT(Mo, 0) THEN PRINT #Fnr, ProNrOut(T, STR(ABS(N))) & NL;
  IF BIT(Mo, 1) THEN Count = N : R->list(@BiWriter.NormRep, @THIS)
END SUB

' writes STACK-definitions as comment to output file
' schreibt STACK-Definitionen als Kommentar in die Ausgabedatei
SUB BiWriter.StackOut(BYREF T AS STRING, BYREF R AS STRING, BYVAL Mo AS INTEGER)
  IF BIT(Mo, 0) THEN PRINT #Fnr, ProNrOut(T, STR(CVI(LEFT(R, 4)))) & NL;
  IF BIT(Mo, 1) = 0 THEN EXIT SUB
  VAR a = 6, e = INSTR(a, R, CHR(1))
  WHILE e > a
    PRINT #Fnr, "' " & MID(R, a, e - a) & NL;
    a = e + 1 : e = INSTR(a, R, CHR(1))
  WEND
END SUB

' replaces words in basic source
' ersetzt Woerter im Basic Quelltext
SUB BiWriter.PostRepOut(BYREF T AS STRING)
  VAR w = "", l = 0, i = 0, lt = LEN(T)
  WHILE i < lt
    SELECT CASE AS CONST CHAR_TYP[T[i]]
    CASE 0 TO 2 : l += 1 '                                 "_", A-Z, a-z
    CASE 3 : IF l THEN l += 1 ELSE PRINT #Fnr, CHR(T[i]); '        0 - 9
    CASE ELSE
      IF l THEN w = MID(T, i - l + 1, l) : l = 0 : PRINT #Fnr, *Co->Post.rep(w);
      PRINT #Fnr, CHR(T[i]);
    END SELECT : i += 1
  WEND : IF l THEN w = MID(T, i - l + 1) : PRINT #Fnr, *Co->Post.rep(w);
END SUB

' stores new translation in RES
' speichert neues Uebersetzungergebnis in RES, FL<>0 -> kein PostRep
SUB BiWriter.add(BYREF T AS STRING, BYVAL Fl AS INTEGER = 0)
  VAR r = "", mo = Op->FLI AND &b11001100
  IF LaWo = CHR(1) THEN mo OR= &b1 : IF Op->I.BLCO THEN mo = BITRESET(mo, 2)
  IF BIT(mo, 2) THEN PRINT #Fnr, In->readCCom(mo + &b10);
  IF Er->FLE THEN IF Op->I.ER THEN r = NL : mo OR= &b1000
  IF LEN(T) THEN
    IF LEN(LaWo) THEN
      SELECT CASE AS CONST T[0]
      CASE ASC("'") : IF LEFT(LaWo, 1) <> "'" THEN r = NL
      CASE ASC("#")
        SELECT CASE LaWo
        CASE "#END" : IF LEFT(T, 4) = "#DEF" OR LEFT(T, 3) = "#IF" THEN r = NL
        CASE "#DEF" : IF LEFT(T, 3) = "#IF" THEN r = NL
        CASE ELSE : IF LEFT(LaWo, 1) <> "#" THEN r = NL
        END SELECT
      CASE ELSE : IF LaWo <> LEFT(T, 4) THEN r = NL
      END SELECT : PRINT #Fnr, r & NL;
    ENDIF
    IF LaWo = CHR(1) THEN LaWo = LCASE(LEFT(T, 4)) ELSE LaWo = LEFT(T, 4)
    IF mo AND &b1100 THEN r = In->readCCom(mo): IF LEN(r) THEN PRINT #Fnr, r & NL;

    IF Op->C.PO ANDALSO Fl = 0 THEN PostRepOut(T) ELSE PRINT #Fnr, T;
    PRINT #Fnr, Er->show();
  ELSE
    IF BIT(mo, 3) THEN
      r = TRIM(In->readCCom(mo), TRIMM)
      IF ASC(r) THEN
        IF LEFT(LaWo, 1) <> "'" THEN LaWo = "'" : PRINT #Fnr, NL;
        PRINT #Fnr, genKom(r);
      END IF
    END IF
  END IF : Op->I.COMM = Op->I.SHCC : Op->I.CODE = 0
END SUB

' checkes file by name (done, exists)
' pueft, ob Datei bereits bearbeitet wurde
FUNCTION BiWriter.checkFileNam(BYREF F AS STRING) AS STRING
  VAR r = F, p = Co->Head.rep(r), a = 0, e = 5
  IF p <> SADD(r) THEN '                     name in header replacements
    IF *CAST(INTEGER PTR, p - 4) > 1 THEN RETURN "' " & KEY_HEADERS & " already replaced: " & F
    IF p[0] = 0 THEN RETURN "' removed by " & KEY_HEADERS & ": " & F
    RETURN "#INCLUDE ONCE """ & *p & """ '" & KEY_HEADERS & ": " & F
  END IF
  DO
    IF FILEEXISTS(F) THEN '                                   file found
      IF STACK_FIN(Fok, F) THEN RETURN "' file already done: " & F
      STACK_ADD(Fok, F) : RETURN ""
    END IF
    a = e + 1 : e = INSTR(a, Co->Fold, CHR(1)) : IF e < a THEN EXIT DO
    F = MID(Co->Fold, a, e - a) & r '                    try next folder
  LOOP
  IF STACK_FIN(Fko, r) THEN RETURN "' file already missed: " & r
  STACK_ADD(Fko, r) : RETURN "' file not found: " & r
END FUNCTION