' This is file h_2_bi_Helpers.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 STACK_NEW MKI(0) & CHR(1)
#DEFINE STACK_FIN(_S_, _P_) INSTR(5, _S_, CHR(1) & _P_ & CHR(1))
#DEFINE STACK_ADD(_S_, _P_) *CAST(INTEGER PTR, SADD(_S_)) += 1 : _S_ &= _P_ & CHR(1)

DIM SHARED AS BYTE CHAR_TYP(255)
CHAR_TYP(ASC("_")) = -5
FOR i AS INTEGER = ASC("A") TO ASC("Z") : CHAR_TYP(i) = -4 : NEXT
FOR i AS INTEGER = ASC("a") TO ASC("z") : CHAR_TYP(i) = -3 : NEXT
FOR i AS INTEGER = ASC("0") TO ASC("9") : CHAR_TYP(i) = -2 : NEXT
CHAR_TYP(ASC(".")) = -1
CHAR_TYP(ASC("(")) = 1 : CHAR_TYP(ASC("[")) = 1 : CHAR_TYP(ASC("{")) = 1
CHAR_TYP(ASC(")")) = 2 : CHAR_TYP(ASC("]")) = 2 : CHAR_TYP(ASC("}")) = 2
CHAR_TYP(ASC("'")) = 3 : CHAR_TYP(ASC("""")) = 3
CHAR_TYP(ASC("/")) = 4 : CHAR_TYP(ASC("*")) = 4
CHAR_TYP(ASC("#")) = 5
CHAR_TYP(ASC(":")) = 6
CHAR_TYP(ASC(";")) = 7
CHAR_TYP(ASC("-")) = 8
CHAR_TYP(ASC(" ")) = 9 : CHAR_TYP(ASC(!"\t")) = 9
CHAR_TYP(ASC(!"\n")) = 10
CHAR_TYP(ASC(",")) = 11 : CHAR_TYP(ASC("=")) = 11
CHAR_TYP(ASC(!"\r")) = 12 : CHAR_TYP(ASC(!"\f")) = 12 : CHAR_TYP(ASC(!"\v")) = 12
#DEFINE CHAR_TYPE_END 13
CHAR_TYP(0) = CHAR_TYPE_END


' Object for seach words (Su) and replacements (Er), incl counters
' Objekt zur Speicherung von Suchworten(Su) und deren Ersetzungen(Er)
' Anzahl Suchworte/Ersetzungen wird gezählt.
TYPE RepData
  AS STRING Er, Su = MKI(0) & CHR(1)
  DECLARE FUNCTION Az() AS INTEGER
  DECLARE FUNCTION add(BYREF T AS STRING, BYREF E AS STRING) AS ZSTRING PTR
  DECLARE FUNCTION rep(BYREF T AS STRING) AS ZSTRING PTR
  DECLARE SUB list(BYVAL Cb AS FUNCTION(BYREF S AS ZSTRING PTR, _
                                        BYREF E AS ZSTRING PTR, _
                                        BYREF Az AS INTEGER, _
                                        BYVAL Po AS ANY PTR)AS INTEGER, _
                   BYVAL Po AS ANY PTR)
END TYPE

' Number of search words
' Anzahl der Suchworte
FUNCTION RepData.Az() AS INTEGER : RETURN *CAST(INTEGER PTR, SADD(Su))
END FUNCTION

' List all elements, output by callback function
' Listet alle Elemente, Ausgabe durch Callback-Funktion
SUB RepData.list(BYVAL Cb AS FUNCTION(BYREF S AS ZSTRING PTR, _
                                      BYREF E AS ZSTRING PTR, _
                                      BYREF Az AS INTEGER, _
                                      BYVAL Po AS ANY PTR)AS INTEGER, _
                 BYVAL Po AS ANY PTR)
  VAR r = "", a = 6, e = INSTR(a, Su, CHR(2)), t = ""
  WHILE e > a
    VAR l = e - a, s = MID(Su, a, l) : e += 1
    VAR x = INSTR(e, Su, CHR(1)), z = SADD(Er) + VALINT("&h" & MID(Su, e, x - e))
    VAR n = *CAST(INTEGER PTR, z - 4) : IF Cb(SADD(s), z, n, Po) THEN EXIT SUB
    a = x + 1 : e = INSTR(a, Su, CHR(2))
  WEND
END SUB

' Add new element
' Fuegt neues Element hinzu
FUNCTION RepData.add(BYREF S AS STRING, BYREF E AS STRING) AS ZSTRING PTR
  IF S = "" THEN RETURN 0
  IF INSTR(S, ANY !"\000\001\002") THEN RETURN @"undefined char (search)"
  VAR c = CHR(1) & S & CHR(2) : IF INSTR(5, Su, c) THEN RETURN @"already defined"
  *CAST(INTEGER PTR, SADD(Su)) += 1 : Su &= MID(c, 2) & HEX(LEN(Er) + 4) & CHR(1)
  Er &= MKI(0) & E & CHR(0) : RETURN 0
END FUNCTION

' Search for word, sends PTR to replacement when found (else PTR to org)
' Sucht Wort, liefert PTR zur Ersetzung, sonst PTR zum Originaltext
FUNCTION RepData.rep(BYREF T AS STRING) AS ZSTRING PTR
  VAR a = INSTRREV(Su, CHR(1) & T & CHR(2)) : IF a THEN a += LEN(T) + 2 ELSE RETURN SADD(T)
  VAR e = INSTR(a, Su, CHR(1)) + 1
  DIM AS ZSTRING PTR z = SADD(Er) + VALINT("&h" & MID(Su, a, e - a))
  *CAST(INTEGER PTR, z - 4) += 1 : RETURN z
END FUNCTION



' replace I by S in STRING T
' erstetzt im String T die Zeichenkette I durch die Zeichenkette S
SUB STRreplace(BYREF T AS STRING, BYREF I AS STRING, BYREF S AS STRING)
  VAR a = INSTR(T, I), li = LEN(I), ls = LEN(S) : IF li = ls THEN li = 0
  WHILE a
    IF li THEN T = LEFT(T, a - 1) & S & MID(T, a + li) ELSE MID(T, a) = S
    a = INSTR(a + ls, T, I)
  WEND
END SUB

' check quote modus
' prueft Anfuehrungszeichenmodus
SUB checkAf(BYREF Af AS UBYTE, BYREF T AS STRING, BYVAL I AS INTEGER)
  IF Af = 0 THEN Af = T[I] : EXIT SUB
  IF Af <> T[I] THEN EXIT SUB
  FOR p AS INTEGER = I - 1 TO 0 STEP -1
    IF T[p] = ASC("\") THEN CONTINUE FOR
    IF BIT((I - p), 0) THEN Af = 0
    EXIT SUB
  NEXT : Af = 0
END SUB

' skip spaces, returns position of next character (or LEN - 1)
' ueberspring Leerzeichen, liefert POS naechstes Zeichen (od LEN - 1)
FUNCTION skipTrenn(BYREF T AS STRING, BYVAL X AS INTEGER, BYVAL E AS INTEGER) AS INTEGER
  IF X > E THEN RETURN E
  FOR i AS INTEGER = X TO E - 1
    IF T[i] = ASC("\") THEN IF T[i + 1] = ASC(!"\n") THEN i += 1 ELSE RETURN i
    IF INSTR(!" \t\r\n\f\v\\", CHR(T[i])) = 0 THEN RETURN i
  NEXT : RETURN E
END FUNCTION

' return next word of T (I is set to lst char of word)
' liefert das naechste Wort (I zeigt auf letztes Zeichen des Wortes)
FUNCTION nextWord(BYREF T AS STRING, BYREF I AS INTEGER = 0) AS STRING
  VAR a = 0, lt = LEN(T) - 1 : IF I > lt THEN RETURN ""
  WHILE CHAR_TYP(T[I]) > -3 : I += 1 : IF I > lt THEN RETURN ""
  WEND : I += 1 : a = I
  WHILE I <= lt
    IF CHAR_TYP(T[I]) > -2 THEN RETURN MID(T, a, I - a + 1)
    I += 1
  WEND : RETURN MID(T, a, I - a + 1)
END FUNCTION

' search for the end of a block
' sucht das Ende eines Blockes
FUNCTION findBlockEnd(BYREF T AS STRING, _
                      BYVAL A AS INTEGER, _
                      BYVAL E AS INTEGER = -1, _
                      BYVAL Z AS UBYTE = 0) AS INTEGER
  DIM AS UBYTE su, af
  DIM AS INTEGER kl, i, st = IIF(E = -1, 1, IIF(E > A, 1, -1))
  IF Z THEN
    su = Z
    i = INSTR("({[]})", CHR(Z)) : IF i THEN kl = IIF(i > 3, 1, - 1)
  ELSE
    i = INSTR("""'({[<)}]>", CHR(T[A]))
    st = IIF(i > 6, -1, IIF(i > 2, 1, st))
    su = ASC(MID("""')}]>({[<", i, 1))
  END IF : IF su = 0 THEN RETURN -1

  FOR i = A TO IIF(E >= 0, E, IIF(st < 0, 0, LEN(T) - 1)) STEP st
    SELECT CASE AS CONST CHAR_TYP(T[i])
    CASE 1 : IF af = 0 THEN kl += 1
    CASE 2 : IF af = 0 THEN kl -= 1
    CASE 3 : checkAf(af, T, i)
    END SELECT : IF T[i] = su THEN IF af = 0 THEN IF kl = 0 THEN RETURN i
  NEXT : RETURN -2
END FUNCTION

' read int number, return position of next character
' liest Integer-Zahl, liefert Position des naechsten Zeichens
FUNCTION getNumber(BYREF T AS STRING, BYREF I AS INTEGER, BYVAL Lt AS INTEGER) AS UINTEGER
  STATIC AS STRING*10 z = "0123456789"
  VAR a = INSTR(I + 1, T, ANY "&" & z) : IF a = 0 THEN RETURN 0
  VAR p = 0, l = 0
  IF T[a - 1] = ASC("&") THEN
    IF a > Lt THEN I = a : RETURN 0
    SELECT CASE AS CONST T[a]
    CASE ASC("h"), ASC("H") : l = 2 : z += "abcdefABCDEF"
    CASE ASC("o"), ASC("O") : l = 2 : z = LEFT(z, 8)
    CASE ASC("b"), ASC("B") : l = 2 : z = LEFT(z, 2)
    CASE ELSE : I = a : RETURN 0
    END SELECT
  END IF
  FOR p = a + l TO Lt
    IF INSTR(z, CHR(T[p])) THEN l += 1 ELSE EXIT FOR
  NEXT : I = p : RETURN VALUINT(MID(T, a, l + 1))
END FUNCTION

' remove spaces, tabs
' entfernt Leerzeichen/Tabs
' Mo: 0 = no comp, -1 = comp with indent, 1 = no indent comp
SUB Kompri(BYREF T AS STRING, BYVAL Mo AS INTEGER = 1)
  IF Mo = 0 THEN EXIT SUB
  DIM AS UINTEGER l, fl, in = 1, i, lt = LEN(T)
  DIM AS UBYTE af
  IF lt = 0 THEN EXIT SUB
  FOR i = 0 TO lt - 1
    SELECT CASE AS CONST CHAR_TYP(T[i])
    CASE 127
    CASE 10, 12
      IF Mo = 1 THEN
        IF l THEN
          fl = 1
          IF T[l - 1] = ASC("\") THEN
            l -= 1 : IF l THEN IF T[l - 1] = ASC(" ") THEN l -= 1
          END IF
        END IF
      ELSE
        in = 1 : T[l] = T[i] : l += 1 : fl = 0
      END IF
    CASE 9
      IF af THEN
        T[l] = T[i] : l += 1
      ELSE
        IF l THEN IF in THEN T[l] = T[i] : l += 1 ELSE fl = 1
      END IF
    CASE ELSE
      IF l THEN IF fl THEN T[l] = ASC(" ") : l += 1 : fl = 0
      SELECT CASE AS CONST CHAR_TYP(T[i])
      CASE 3 : checkAf(af, T, i)
      CASE 7, 11 : IF l THEN IF T[l - 1] = ASC(" ") THEN l -= 1
      END SELECT : T[l] = T[i] : l += 1 : in = 0
    END SELECT
  NEXT : T = LEFT(T, l)
END SUB

' generate (maybe multi line) comment for RES
' liefert (ggf. mehrzeiligen) Kommentar fuer RES
FUNCTION genKom(BYREF T AS STRING) AS STRING
  VAR r = TRIM(T, TRIMM) : IF LEN(r) = 0 THEN RETURN ""
  STRreplace(r, !"\n", !"\n\' ") : RETURN "' " & r
END FUNCTION

' check for standard h2bi files, may write an empty one
' prueft Exixtenz von Standard-Konfigurationsdatei, schreibt sie ggf.
FUNCTION checkH2Bi(BYREF F AS STRING, BYVAL Mo AS INTEGER) AS INTEGER
  IF LEN(F) THEN
    IF FILEEXISTS(F & H2BI_FILE_SUFFIX) THEN RETURN 1
    ? NL & "  Unable to read: " & F & H2BI_FILE_SUFFIX
    IF Mo THEN RETURN 0
  ELSE
    IF Mo THEN RETURN 0
    ? NL & "  No config-file specified -> searching:"
    F = DIR_NAME
    ? "  testing " & F & H2BI_FILE_SUFFIX & " -> ";
    IF FILEEXISTS(F & H2BI_FILE_SUFFIX) THEN ? "found!" : RETURN 1
    ? "not found!"
    F = PROG_NAME
    ? "  testing " & F & H2BI_FILE_SUFFIX & " -> ";
    IF FILEEXISTS(F & H2BI_FILE_SUFFIX) THEN ? "found!" : RETURN 1
    ? "not found!"
    F = DIR_NAME
  END IF : F &= H2BI_FILE_SUFFIX
  ? NL & "Generate an empty '" & F & "' file? (y/n)";
  IF INSTR("yYjJ", CHR(GETKEY AND &hFF)) = 0 THEN ? " -> No, abort!" : RETURN 0
  DIM AS INTEGER fnr = FREEFILE
  IF OPEN (F FOR OUTPUT AS #fnr) THEN ? "Yes." & NL & " Unable to write: " & F : RETURN 0
  PRINT #fnr, "/* place the name of the start file here */" & NL
  PRINT #fnr, KEY_PARAMETERS & FLAGS_SUFFIX & NL & NL & _
              KEY_FOLDERS & FLAGS_SUFFIX & NL & NL & _
              KEY_HEADERS & FLAGS_SUFFIX & NL & NL & _
              KEY_TYPES & FLAGS_SUFFIX & NL & NL & _
              KEY_MACROS & FLAGS_SUFFIX & NL & NL & _
              KEY_POST_REPS & FLAGS_SUFFIX & NL & NL & _
              KEY_START & FLAGS_SUFFIX
  PRINT #fnr, "#IFDEF __FB_WIN32__"
  PRINT #fnr, "#PRAGMA push(msbitfields)"
  PRINT #fnr, "#ENDIF" & NL
  PRINT #fnr, "#INCLIB """" ' place the name of your lib into quotes"
  PRINT #fnr, NL & KEY_END & FLAGS_SUFFIX
  PRINT #fnr, "#IFDEF __FB_WIN32__"
  PRINT #fnr, "#PRAGMA pop(msbitfields)"
  PRINT #fnr, "#ENDIF"
  CLOSE #fnr : ? " -> Yes, done!" : RETURN 0
END FUNCTION

' writes *_test.bas files
' schreibt die Testdatei _test.bas
SUB genTestBas(BYREF F AS STRING, BYVAL N AS STRING)
  VAR na = F & "_Test.bas", fnr = FREEFILE
  IF NOT FILEEXISTS(na) THEN
    IF OPEN (na FOR OUTPUT AS #fnr) THEN
      ? " Unable to write: " & na
    ELSE
      VAR a2 = 1, e2 = INSTR(a2, N, ";")
      WHILE e2 > a2
        VAR a1 = INSTRREV(N, ANY "\/", e2) + 1, e1 = INSTRREV(N, ".", e2)
        IF a1 < a2 THEN a1 = a2
        PRINT #Fnr, "#INCLUDE """ & MID(N, a1, e1 - a1) & BI_FILE_SUFFIX & """"
        a2 = e2 + 1 : e2 = INSTR(a2, N, ";")
      WEND
      CLOSE #Fnr
    END IF
  END IF
END SUB