' This is file h_2_bi_CReader.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

TYPE CFileReader
  AS STRING Tex, FNam, Erro
  DECLARE FUNCTION readCCom(BYVAL Mo AS INTEGER = 0) AS STRING
  DECLARE SUB readTo(BYREF S AS STRING)
  DECLARE SUB readLine(BYVAL Mo AS INTEGER = 0)
  DECLARE SUB newTex()
  DECLARE SUB newBlock()
  DECLARE FUNCTION weGo() AS INTEGER
  DECLARE FUNCTION LaCh() AS UBYTE
  DECLARE CONSTRUCTOR(BYREF F AS STRING)
Private:
  DIM AS INTEGER Le, Ca, Po = -1
  AS STRING Buff
  DIM AS UBYTE Af
  DIM AS INTEGER Kl, Pa, CaBl, CeBl
END TYPE

CONSTRUCTOR CFileReader(BYREF F AS STRING)
  VAR fnr = FREEFILE
  IF LEN(F) THEN
    IF OPEN(F FOR BINARY ACCESS READ LOCK WRITE AS #fnr) THEN _
            Erro = "Cannot Open: " & F : EXIT CONSTRUCTOR
    Le = LOF(fnr)
    Buff = STRING(Le + 1, 0)
    IF GET(fnr, , Buff) THEN Erro = "I/O error while reading: " & F
    FNam = F
  ELSE
    IF OPEN CONS(FOR INPUT AS #fnr) THEN _
            Erro = "Cannot Open: GeanyBlock" : EXIT CONSTRUCTOR
    WHILE NOT EOF(fnr)
      IF GET(fnr, , Af) THEN Erro = "Error while reading: GeanyBlock" : EXIT WHILE
      Buff &= CHR(Af)
    WEND : Le = LEN(Buff) : FNam = "GeanyBlock"
  END IF : CLOSE #fnr
END CONSTRUCTOR

FUNCTION CFileReader.weGo() AS INTEGER : RETURN Po < Le
END FUNCTION

FUNCTION CFileReader.LaCh() AS UBYTE : RETURN Buff[Po]
END FUNCTION

SUB CFileReader.newTex() : Tex = "" : Ca = Po + 1
END SUB

SUB CFileReader.newBlock() : CaBl = Ca : CeBl = Po : Tex = ""
END SUB

' reads .h up to one of the characters S, counts ([{"''"}])
' liest bis zum naechsten Stop-Zeichen S, zaehlt Klammern
SUB CFileReader.readTo(BYREF S AS STRING)
  Po += 1 : IF Po < Le THEN Pa = Po : Af = 0 : Kl = 0 ELSE EXIT SUB
  VAR lf = 0
  DO
    IF Kl = 0 THEN IF Af = 0 THEN IF INSTR(S, MID(Buff, Po + 1, 1)) THEN EXIT DO
    SELECT CASE AS CONST CHAR_TYP(Buff[Po])
    CASE 1 '                                ASC("("), ASC("{"), ASC("[")
      lf = 0 : IF Af = 0 THEN Kl += 1
    CASE 2 '                                ASC(")"), ASC("}"), ASC("]")
      lf = 0 : IF Af = 0 THEN Kl -= 1
    CASE 3 '                                         ASC("'"), ASC("""")
      lf = 0 : checkAf(Af, Buff, Po)
    CASE 4 '                                          ASC("/"), ASC("*")
      IF Af = 0 ANDALSO Buff[Po] = ASC("/") _
                ANDALSO Po < Le ANDALSO CHAR_TYP(Buff[Po + 1]) = 4 THEN
        Tex &= MID(Buff, Pa + 1, Po - Pa)
        Pa = Po + 2
        IF Buff[Po + 1] = ASC("*") THEN '       /* multi line comment */
          DO
            WHILE Pa < Le
              IF Buff[Pa] <> ASC("/") THEN Pa += 1 ELSE EXIT WHILE
            WEND : Pa += 1 : IF Buff[Pa - 2] = ASC("*") THEN EXIT DO
          LOOP
        ELSE '                                    // single line comment
          WHILE Pa < Le
            IF Buff[Pa] <> ASC(!"\n") THEN Pa += 1 ELSE EXIT WHILE
          WEND
        END IF : Po = Pa - 1
      END IF : lf = 0
    CASE 10
      Tex &= RTRIM(MID(Buff, Pa + 1, Po - Pa + 1), TRIMM) : Pa = Po
      IF LEN(Tex) THEN
        IF lf = 0 THEN lf = 1 ELSE IF Kl = 0 THEN IF Af = 0 THEN EXIT DO
      END IF
    CASE 12 '                                       ignore vertical tabs
    CASE CHAR_TYPE_END : EXIT DO
    CASE ELSE : lf = 0
    END SELECT : Po += 1
  LOOP UNTIL Po >= Le : Tex &= MID(Buff, Pa + 1, Po - Pa)
END SUB

' reads .h up to NL character
' liest und komprimiert PreCo Zeile (bis NL, \ wird berücksichtigt)
SUB CFileReader.readLine(BYVAL Mo AS INTEGER = 0)
  Po += 1 : IF Po < Le THEN Af = 0 : Pa = Po ELSE EXIT SUB
  DO
    SELECT CASE AS CONST CHAR_TYP(Buff[Po])
    CASE 3 '                                         ASC("'"), ASC("""")
      checkAf(Af, Buff, Ca)
    CASE 4 '                                          ASC("/"), ASC("*")
      IF Af = 0 ANDALSO Buff[Po] = ASC("/") _
                ANDALSO Po < Le ANDALSO CHAR_TYP(Buff[Po + 1]) = 4 THEN
        Tex &=  MID(Buff, Pa + 1, Po - Pa)
        Pa = Po + 2
        IF Buff[Po + 1] = ASC("*") THEN '       /* multi line comment */
          DO
            WHILE Pa < Le
              IF Buff[Pa] <> ASC("/") THEN Pa += 1 ELSE EXIT WHILE
            WEND : Pa += 1 : IF Buff[Pa - 2] = ASC("*") THEN EXIT DO
          LOOP
        ELSE '                                    // single line comment
          IF Mo THEN Po -= 2 : EXIT SUB
          WHILE Pa < Le
            IF Buff[Pa] <> ASC(!"\n") THEN Pa += 1 ELSE EXIT WHILE
          WEND
        END IF : Po = Pa - 1
      END IF
    CASE 10 : Tex &= RTRIM(MID(Buff, Pa + 1, Po - Pa), TRIMM)
      Pa = Po : IF RIGHT(Tex, 1) <> "\" THEN EXIT SUB
    CASE CHAR_TYPE_END : EXIT DO
    END SELECT : Po += 1
  LOOP UNTIL Po >= Le : Tex &= MID(Buff, Pa + 1, Po - Pa)
END SUB

' reads .h comments from St (or Ca) to Po
' liest Kommentare von Ca (oder CaBl) bis Po
' Bit0: Start CaBl, end CeBl (default CA, Po)
' Bit1: End after first NL
' Bit2: C-comments
' Bit3: C-source
' Bit6: compress C-source
' Bit7: compress C-comments
FUNCTION CFileReader.readCCom(BYVAL Mo AS INTEGER = 0) AS STRING
'?"Hier";BIN(Mo,8)
  Ca = IIF((Mo AND &b01) = &b01, CaBl, Ca) : IF Ca < Po THEN Af = 0 : Pa = Ca ELSE RETURN ""
  VAR r = "", ee = Po
  IF BIT(Mo, 1) THEN Mo = BITRESET(Mo, 3)
  IF (Mo AND &b01100) = &b01100 THEN
    Ca = ee
  ELSE
    IF BIT(Mo, 0) THEN IF BIT(Mo, 3) = 0 THEN ee = CeBl
    WHILE Ca <= ee
      SELECT CASE AS CONST CHAR_TYP(Buff[Ca])
      CASE 3 '                                       ASC("'"), ASC("""")
        checkAf(Af, Buff, Ca)
      CASE 4 '                                        ASC("/"), ASC("*")
        IF Af = 0 ANDALSO Ca < Le ANDALSO _
          Buff[Ca] = ASC("/") ANDALSO CHAR_TYP(Buff[Ca + 1]) = 4 THEN
          IF BIT(Mo, 3) THEN r &= MID(Buff, Pa + 1, Ca - Pa)
          IF Buff[Ca + 1] = ASC("*") THEN '     /* multi line comment */
            IF BIT(Mo, 1) THEN Ca = Pa : RETURN ""
            Pa = Ca + 2
            DO
              WHILE Pa < ee
                IF Buff[Pa] <> ASC("/") THEN Pa += 1 ELSE EXIT WHILE
              WEND : Pa += 1 : IF Buff[Pa - 2] = ASC("*") THEN EXIT DO
            LOOP
            IF BIT(Mo, 3) = 0 THEN
              IF LEN(r) THEN IF RIGHT(r, 1) <> !"\n" THEN r &= NL
              r &= "/'" & MID(Buff, Ca + 3, Pa - Ca - 4) & "'/"
            END IF
          ELSE '                                  // single line comment
            Pa = Ca + 2
            WHILE Pa < ee
              IF Buff[Pa] <> ASC(!"\n") THEN Pa += 1 ELSE EXIT WHILE
            WEND
            IF BIT(Mo, 3) = 0 THEN
              IF LEN(r) = 0 THEN r = " "
              r &= "'" & MID(Buff, Ca + 3, Pa - Ca - 2)
              IF BIT(Mo, 1) THEN EXIT WHILE
            END IF
          END IF : Ca = Pa - 1
        END IF
      CASE 10 : IF BIT(Mo, 1) THEN Ca = Pa : RETURN ""
      END SELECT : Ca += 1
    WEND
    IF BIT(Mo, 3) = 0 THEN '                                     comment
      IF BIT(Mo, 7) THEN Kompri(r, -1)
      IF BIT(Mo, 1) THEN Ca = Pa
      RETURN r
    END IF
  END IF : r &= MID(Buff, Pa + 1, ee - Pa + 1) '                C source
  IF BIT(Mo, 6) THEN Kompri(r, -1)
  Ca = ee : RETURN genKom(r)
END FUNCTION