(*
    Copyright 2021-2023 Anton Krotov

    This file is part of CEdit.

    CEdit is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    CEdit is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with CEdit. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE Languages;

IMPORT Lines, Utils;


CONST

    langText* = 0; langC* = 1; langOberon* = 2; langPascal* = 3;
    langFasm* = 4; langLua* = 5; langIni* = 6; langJSON* = 7;

    csLang = {langC, langOberon, langLua, langIni, langJSON};
    escLang* = {langC, langLua, langJSON};

TYPE

    tLine = Lines.tLine;

    tKeyWords = RECORD
        words: ARRAY 200, 32 OF WCHAR; cnt: INTEGER
    END;

    tDelimiters = ARRAY 256 OF BOOLEAN;

    procGetStr = PROCEDURE (secName, keyName: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);


VAR

	KW: ARRAY 8 OF ARRAY 3 OF tKeyWords;
	Delim: ARRAY 8 OF tDelimiters;

    currentLang: INTEGER;

    fileExt: ARRAY 11 OF RECORD ext: ARRAY 8 OF CHAR; lang: INTEGER END;


PROCEDURE isCS* (lang: INTEGER): BOOLEAN;
    RETURN lang IN csLang
END isCS;


PROCEDURE checkKW (s: ARRAY OF WCHAR; KW: tKeyWords): BOOLEAN;
VAR
    i: INTEGER;
BEGIN
    i := KW.cnt - 1;
    WHILE (i >= 0) & (s # KW.words[i]) DO
        DEC(i)
    END
    RETURN i >= 0
END checkKW;


PROCEDURE isKey* (s: ARRAY OF WCHAR; lang, kwSet: INTEGER): BOOLEAN;
    RETURN checkKW(s, KW[lang][kwSet - 1])
END isKey;


PROCEDURE isDelim* (c: WCHAR): BOOLEAN;
VAR
	res: BOOLEAN;
BEGIN
	IF c <= 0FFX THEN
		res := Delim[currentLang][ORD(c)]
	ELSE
		res := FALSE
	END
	RETURN res
END isDelim;


PROCEDURE SkipString* (line: tLine; VAR pos: INTEGER; n: INTEGER; lang: INTEGER);
VAR
    quot, cur, prev: WCHAR;
BEGIN
    quot := Lines.getChar(line, pos);
    cur := quot;
    prev := 0X;
    INC(pos);
    WHILE pos <= n DO
    	IF lang IN escLang THEN
    		prev := cur
    	END;
    	cur := Lines.getChar(line, pos);
    	IF (cur = "\") & (prev = "\") THEN
    		cur := 0X
    	ELSIF (cur = quot) & (prev # "\") THEN
    		n := 0; (* exit *)
    		DEC(pos)
    	END;
    	INC(pos)
    END
END SkipString;


PROCEDURE SkipEsc* (line: tLine; VAR pos: INTEGER; n: INTEGER; lang: INTEGER);
VAR
	c, c1: WCHAR;
	k: INTEGER;
BEGIN
	IF pos < n THEN
		c := Lines.getChar(line, pos + 1);
		CASE lang OF
		|langC:
			IF Utils.inString(c, "abfnrtv\'?" + '"') THEN
				INC(pos)
			ELSIF Utils.isOct(c) THEN
				k := 0;
				REPEAT
					INC(pos);
					IF Utils.isOct(Lines.getChar(line, pos)) THEN
						INC(k)
					ELSE
						k := 0
					END
				UNTIL (k = 0) OR (k = 4);
				DEC(pos)
			ELSIF (c = "x") OR (c = "u") OR (c = "U") THEN
				c1 := c;
				k := 0;
				INC(pos);
				REPEAT
					INC(pos);
					c := Lines.getChar(line, pos);
					IF Utils.upper(c) THEN END;
					IF Utils.isHex(c) THEN
						INC(k)
					ELSE
						k := 0
					END;
					IF (c1 = "u") & (k = 5) OR (c1 = "U") & (k = 9) THEN
						k := 0
					END
				UNTIL k = 0;
				DEC(pos)
			END
		|langLua:
			IF Utils.inString(c, "abfnrtv\'[]" + '"') THEN
				INC(pos)
			END
		|langJSON:
			IF Utils.inString(c, 'bfnrt\/"') THEN
				INC(pos)
			ELSIF c = "u" THEN
				k := 0;
				INC(pos);
				REPEAT
					INC(pos);
					c := Lines.getChar(line, pos);
					IF Utils.upper(c) THEN END;
					IF Utils.isHex(c) THEN
						INC(k)
					ELSE
						k := 0
					END
				UNTIL (k = 0) OR (k = 5);
				DEC(pos)
			END
		END
	END
END SkipEsc;


PROCEDURE C (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
    c: WCHAR;
BEGIN
    c := Lines.getChar(line, pos);
    IF depth = 0 THEN
        IF c = "/" THEN
            IF cond = 0 THEN
                cond := 1
            ELSE
                cond := 0;
                pos := n
            END
        ELSIF (c = "*") & (cond = 1) THEN
            depth := 1;
            cond := 0
        ELSIF (c = "'") OR (c = '"') THEN
            SkipString(line, pos, n, langC);
            cond := 0
        ELSE
            cond := 0
        END
    ELSIF depth = 1 THEN
        IF c = "*" THEN
            cond := 1
        ELSIF (c = "/") & (cond = 1) THEN
            cond := 0;
            depth := 0
        ELSE
            cond := 0
        END
    END
END C;


PROCEDURE LuaLong* (line: tLine; pos: INTEGER): INTEGER;
VAR
    res: INTEGER;
BEGIN
    res := -1;
    IF Lines.getChar(line, pos) = "[" THEN
        INC(pos);
        WHILE Lines.getChar(line, pos) = "=" DO
            INC(res);
            INC(pos)
        END;
        IF Lines.getChar(line, pos) = "[" THEN
            INC(res)
        ELSE
            res := -1
        END
    END
    RETURN res
END LuaLong;


PROCEDURE Lua (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
    c: WCHAR;
    k: INTEGER;
BEGIN
    c := Lines.getChar(line, pos);
    IF depth = 0 THEN
        IF c = "-" THEN
            IF cond = 0 THEN
                cond := 1
            ELSE
                cond := 0;
                k := LuaLong(line, pos + 1);
                IF k >= 0 THEN
                    depth := k*2 + 1
                ELSE
                    pos := n
                END
            END
        ELSIF c = "[" THEN
            cond := 0;
            k := LuaLong(line, pos);
            IF k >= 0 THEN
                depth := (k + 1)*2
            END
        ELSIF (c = "'") OR (c = '"') THEN
            SkipString(line, pos, n, langLua);
            cond := 0
        ELSE
            cond := 0
        END
    ELSIF depth > 0 THEN
        IF (cond = 0) & (c = "]") THEN
            cond := 1
        ELSIF (cond >= 1) & (c = "=") THEN
            INC(cond)
        ELSIF (cond >= 1) & (c = "]") & (cond*2 - depth MOD 2 = depth) THEN
            depth := 0;
            cond := 0
        ELSE
            cond := 0
        END
    END
END Lua;


PROCEDURE Pascal (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
    c: WCHAR;
BEGIN
    c := Lines.getChar(line, pos);
    IF depth = 0 THEN
        IF c = "(" THEN
            cond := 1
        ELSIF c = "/" THEN
            IF cond = 2 THEN
                cond := 0;
                pos := n
            ELSE
                cond := 2
            END
        ELSIF (c = "*") & (cond = 1) THEN
            depth := 2;
            cond := 0
        ELSIF c = "'" THEN
            SkipString(line, pos, n, langPascal);
            cond := 0
        ELSIF c = "{" THEN
            IF Lines.getChar(line, pos + 1) = "$" THEN
                depth := 3
            ELSE
                depth := 1
            END;
            cond := 0
        ELSE
            cond := 0
        END
    ELSIF depth IN {1, 3} THEN
        IF c = "}" THEN
            depth := 0
        END
    ELSIF depth = 2 THEN
        IF c = "*" THEN
            cond := 1
        ELSIF (c = ")") & (cond = 1) THEN
            depth := 0;
            cond := 0
        ELSE
            cond := 0
        END
    END
END Pascal;


PROCEDURE Oberon (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
    c: WCHAR;
BEGIN
    c := Lines.getChar(line, pos);
    IF (depth = 0) & (c = "/") THEN
        IF cond = 3 THEN
            cond := 0;
            pos := n
        ELSE
            cond := 3
        END
    ELSIF (depth = 0) & ((c = "'") OR (c = '"')) THEN
        SkipString(line, pos, n, langOberon);
        cond := 0
    ELSIF c = "(" THEN
        cond := 1
    ELSIF c = "*" THEN
        IF cond = 1 THEN
            INC(depth);
            cond := 0
        ELSE
            cond := 2
        END
    ELSIF c = ")" THEN
        IF cond = 2 THEN
            IF depth > 0 THEN
                DEC(depth)
            END
        END;
        cond := 0
    ELSE
        cond := 0
    END;
END Oberon;


PROCEDURE Ini (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER);
VAR
    c: WCHAR;
BEGIN
    cond := 0;
    c := Lines.getChar(line, pos);
    IF depth = 0 THEN
        IF c = ";" THEN
            pos := n
        ELSIF c = '"' THEN
            SkipString(line, pos, n, langIni)
        ELSIF c = "[" THEN
            depth := 1
        END
    ELSIF depth = 1 THEN
        IF c = "]" THEN
            depth := 0
        END
    END
END Ini;


PROCEDURE comments* (line: tLine; VAR depth, cond, pos: INTEGER; n: INTEGER; lang: INTEGER);
BEGIN
    CASE lang OF
    |langText:
    |langFasm:
    |langC,
     langJSON:    C(line, depth, cond, pos, n)
    |langOberon:  Oberon(line, depth, cond, pos, n)
    |langPascal:  Pascal(line, depth, cond, pos, n)
    |langLua:     Lua(line, depth, cond, pos, n)
    |langIni:     Ini(line, depth, cond, pos, n)
    END
END comments;


PROCEDURE EnterKW (s: ARRAY OF CHAR; VAR KW: tKeyWords);
CONST
    SPACE = 20X; CR = 0DX; LF = 0AX; TAB = 9X; COMMA = ",";
VAR
    i, j, k: INTEGER;

    PROCEDURE delim (c: CHAR): BOOLEAN;
        RETURN (c = COMMA) OR (c = SPACE) OR (c = CR) OR (c = LF) OR (c = TAB)
    END delim;

BEGIN
    k := KW.cnt;
    i := 0;
    REPEAT
        j := 0;
        WHILE (s[i] # 0X) & ~delim(s[i]) DO
            KW.words[k, j] := WCHR(ORD(s[i]));
            INC(i);
            INC(j)
        END;
        KW.words[k, j] := 0X;
        INC(k);
        WHILE delim(s[i]) DO
            INC(i)
        END
    UNTIL s[i] = 0X;
    KW.cnt := k
END EnterKW;


PROCEDURE loadKW (lang: INTEGER; VAR KW: ARRAY OF tKeyWords; VAR delim: tDelimiters; getStr: procGetStr;
					lang_name: ARRAY OF CHAR);
VAR
    s: ARRAY 16*1024 OF CHAR;
    key: ARRAY 4 OF CHAR;
    i, j, k: INTEGER;
    w: WCHAR;
BEGIN
	FOR i := 0 TO LEN(delim) - 1 DO
		delim[i] := FALSE
	END;
	getStr(lang_name, "delim", s);
	i := 0;
	WHILE s[i] # 0X DO
		delim[ORD(s[i])] := TRUE;
		INC(i)
	END;
    key := "KW1";
    FOR i := 0 TO 2 DO
        KW[i].cnt := 0;
        key[2] := CHR(ORD("1") + i);
        getStr(lang_name, key, s);
        IF ~(lang IN csLang) THEN
        	Utils.lowcase8(s)
        END;
        IF lang = langOberon THEN
	        k := LENGTH(s);
    	    s[k] := ",";
	        FOR j := 0 TO k - 1 DO
		        s[j + k + 1] := s[j];
		        w := WCHR(ORD(s[j]));
		        IF Utils.lower(w) THEN
		        	s[j + k + 1] := CHR(ORD(w) MOD 256)
		        END
    	    END;
    	    k := 2*k + 1;
    	    s[k] := 0X
        END;
        EnterKW(s, KW[i])
    END
END loadKW;


PROCEDURE setCurLang* (lang: INTEGER);
BEGIN
	currentLang := lang
END setCurLang;


PROCEDURE getLang* (ext: ARRAY OF CHAR): INTEGER;
VAR
	i: INTEGER;
BEGIN
	i := 0;
	WHILE (i < LEN(fileExt)) & (fileExt[i].ext # ext) DO
		INC(i)
	END;
	IF i < LEN(fileExt) THEN
		i := fileExt[i].lang
	ELSE
		i := langText
	END
	RETURN i
END getLang;


PROCEDURE getExt* (lang: INTEGER; VAR ext: ARRAY OF CHAR);
VAR
	i: INTEGER;
BEGIN
	i := 0;
	WHILE fileExt[i].lang # lang DO
		INC(i)
	END;
	COPY(fileExt[i].ext, ext)
END getExt;


PROCEDURE init* (getStr: procGetStr);
BEGIN
	currentLang := langText;
	loadKW(langText,   KW[langText],   Delim[langText],   getStr, "lang_Text");
    loadKW(langOberon, KW[langOberon], Delim[langOberon], getStr, "lang_Oberon");
    loadKW(langC,      KW[langC],      Delim[langC],      getStr, "lang_C");
    loadKW(langPascal, KW[langPascal], Delim[langPascal], getStr, "lang_Pascal");
    loadKW(langLua,    KW[langLua],    Delim[langLua],    getStr, "lang_Lua");
    loadKW(langIni,    KW[langIni],    Delim[langIni],    getStr, "lang_Ini");
    loadKW(langFasm,   KW[langFasm],   Delim[langFasm],   getStr, "lang_Fasm");
    loadKW(langJSON,   KW[langJSON],   Delim[langJSON],   getStr, "lang_JSON");

    fileExt[ 0].ext := "ob07"; fileExt[ 0].lang := langOberon;
    fileExt[ 1].ext := "c";    fileExt[ 1].lang := langC;
    fileExt[ 2].ext := "h";    fileExt[ 2].lang := langC;
    fileExt[ 3].ext := "cpp";  fileExt[ 3].lang := langC;
    fileExt[ 4].ext := "pas";  fileExt[ 4].lang := langPascal;
    fileExt[ 5].ext := "pp";   fileExt[ 5].lang := langPascal;
    fileExt[ 6].ext := "asm";  fileExt[ 6].lang := langFasm;
    fileExt[ 7].ext := "lua";  fileExt[ 7].lang := langLua;
    fileExt[ 8].ext := "ini";  fileExt[ 8].lang := langIni;
    fileExt[ 9].ext := "json"; fileExt[ 9].lang := langJSON;
    fileExt[10].ext := "txt";  fileExt[10].lang := langText;
END init;


END Languages.