MODULE TextMappers;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- 20141027, center #19, full Unicode support for Component Pascal identifiers added
	- 20150130, center #27, Adding SET conversion to the module Strings
	- 20160115, center #95, making the Set procedure check the syntax more accurately
	- 20160205, center #103, bug fix in TextMappers.Scanner
	- 20160306, center #38, use IN for Formatter methods  to avoid incompatibilities with 1.6
	"
	issues	= "
	- ...
	"

**)

	IMPORT Strings, Views, Dialog, TextModels;

	CONST
		(** Scanner.opts **)
		returnCtrlChars* = 1;
		returnQualIdents* = 2; returnViews* = 3;
		interpretBools* = 4; interpretSets* = 5;
		maskViews* = 6;

		(** Scanner.type **)
		char* = 1; string* = 3; int* = 4; real* = 5;
		bool* = 6;	(** iff interpretBools IN opts **)
		set* = 7;	(** iff interpretSets IN opts **)
		view* = 8;	(** iff returnViews IN opts **)
		tab* = 9; line* = 10; para* = 11;	(** iff returnCtrlChars IN opts **)
		lint* = 16;
		eot* = 30;
		invalid* = 31;	(** last Scan hit lexically invalid sequence **)

		(** Formatter.WriteIntForm base **)
		charCode* = Strings.charCode; decimal* = Strings.decimal; hexadecimal* = Strings.hexadecimal;

		(** Formatter.WriteIntForm showBase **)
		hideBase* = Strings.hideBase; showBase* = Strings.showBase;

		VIEW = TextModels.viewcode;
		TAB = TextModels.tab; LINE = TextModels.line; PARA = TextModels.para;

		acceptUnderscores = TRUE;

	TYPE
		String* = ARRAY 256 OF CHAR;

		Scanner* = RECORD
			opts-: SET;
			rider-: TextModels.Reader;	(** prefetch state for single character look-ahead **)

			type*: INTEGER;
			start*, lines*, paras*: INTEGER;	(** update by Skip **)

			char*: CHAR;	(** valid iff type = char **)
			int*: INTEGER;	(** valid iff type = int **)
			base*: INTEGER;	(** valid iff type IN {int, lint} **)
			lint*: LONGINT;	(** valid iff type IN {int, lint} **)
			real*: REAL;	(** valid iff type = real **)
			bool*: BOOLEAN;	(** valid iff type = bool **)
			set*: SET;	(** valid iff type = set **)
			len*: INTEGER;	(** valid iff type IN {string, int, lint} **)
			string*: String;	(** valid iff type IN {string, int, lint, bool, char} **)
			view*: Views.View; w*, h*: INTEGER	(** valid iff type = view **)
		END;

		Formatter* = RECORD
			rider-: TextModels.Writer
		END;


	(** Scanner **)

	PROCEDURE ^ (VAR s: Scanner) SetPos* (pos: INTEGER), NEW;
	PROCEDURE ^ (VAR s: Scanner) SetOpts* (opts: SET), NEW;
	PROCEDURE ^ (VAR s: Scanner) Skip* (OUT ch: CHAR), NEW;
	PROCEDURE ^ (VAR s: Scanner) Scan*, NEW;


	PROCEDURE Get (VAR s: Scanner; OUT ch: CHAR);
	BEGIN
		s.rider.ReadChar(ch);
		IF ({returnViews, maskViews} * s.opts = {returnViews}) & (s.rider.view # NIL) THEN
			ch := VIEW; s.rider.char := VIEW
		END
	END Get;

	PROCEDURE Real (VAR s: Scanner);
		VAR res: INTEGER; ch: CHAR;
	BEGIN
		s.type := real;
		s.string[s.len] := "."; INC(s.len); Get(s, ch);
		WHILE ("0" <= ch) & (ch <= "9") & (s.len < LEN(s.string) - 1) DO
			s.string[s.len] := ch; INC(s.len); Get(s, ch)
		END;
		IF (ch = "E") OR (ch = "D") THEN
			s.string[s.len] := ch; INC(s.len); Get(s, ch);
			IF (ch = "-") OR (ch = "+") THEN s.string[s.len] := ch; INC(s.len); Get(s,ch) END;
			WHILE ("0" <= ch) & (ch <= "9") & (s.len < LEN(s.string) - 1) DO
				s.string[s.len] := ch; INC(s.len); Get(s, ch)
			END
		END;
		s.string[s.len] := 0X;
		Strings.StringToReal(s.string, s.real, res);
		IF res # 0 THEN s.type := invalid END
	END Real;

	PROCEDURE Integer (VAR s: Scanner);
		VAR n, k, res: INTEGER; ch: CHAR; hex: BOOLEAN;
	BEGIN
		s.type := int; hex := FALSE; ch := s.rider.char;
		IF ch = "%" THEN
			s.string[s.len] := "%"; INC(s.len); Get(s, ch); n:= 0;
			IF ("0" <= ch) & (ch <= "9") THEN
				k := ORD(ch) - ORD("0");
				REPEAT
					n := 10*n + k; s.string[s.len] := ch; INC(s.len);
					Get(s, ch); k := ORD(ch) - ORD("0")
				UNTIL (ch < "0") OR (ch > "9") OR (n > (MAX(INTEGER) - k) DIV 10) OR (s.len = LEN(s.string));
				IF ("0" <= ch) & (ch <= "9") THEN s.type := invalid ELSE s.base := n END
			ELSE s.type := invalid
			END
		ELSIF (ch = "H") OR (ch = "X") THEN
			hex := TRUE; s.base := 16;
			s.string[s.len] := ch; INC(s.len); Get(s, ch)
		ELSE
			s.base := 10
		END;
		s.string[s.len] := 0X;
		IF s.type # invalid THEN
			Strings.StringToInt(s.string, s.int, res);
			IF res = 0 THEN s.type := int;
				IF hex THEN (* Strings.StringToLInt(s.string, s.lint, res); ASSERT(res = 0, 100); *)
					IF s.int < 0 THEN s.lint := s.int + (LONG(MAX(INTEGER)) + 1) * 2
					ELSE s.lint := s.int
					END
				ELSE s.lint := s.int
				END
			ELSIF res = 1 THEN (* INTEGER overflow *)
				Strings.StringToLInt(s.string, s.lint, res);
				IF res = 0 THEN s.type := lint ELSE s.type := invalid END
			ELSE	(* syntax error *)
				s.type := invalid
			END
		END
	END Integer;

	PROCEDURE Number (VAR s: Scanner; neg: BOOLEAN);
		VAR m: INTEGER; ch: CHAR;
	BEGIN
		s.len := 0; m := 0; ch := s.rider.char;
		IF neg THEN s.string[s.len] := "-"; INC(s.len) END;
		REPEAT
			IF (m > 0) OR (ch # "0") THEN	(* ignore leading zeroes *)
				s.string[s.len] := ch; INC(s.len); INC(m)
			END;
			Get(s, ch)
		UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F")
			OR (s.len = LEN(s.string) - 1) OR s.rider.eot;
		IF (s.len = 0) OR (s.len = 1) & (s.string[0] = "-") THEN	(* compensate for ignoring leading zeroes *)
			s.string[s.len] := "0"; INC(s.len)
		END;
		s.string[s.len] := 0X;
		IF ch = "." THEN Real(s) ELSE Integer(s) END
	END Number;

	PROCEDURE Cardinal (VAR s: Scanner; OUT n: INTEGER);
		VAR k: INTEGER; ch: CHAR;
	BEGIN
		n := 0; s.Skip(ch);
		IF ("0" <= ch) & (ch <= "9") THEN
			k := ORD(ch) - ORD("0");
			REPEAT
				n := n * 10 + k;
				Get(s, ch); k := ORD(ch) - ORD("0")
			UNTIL (ch < "0") OR (ch > "9") OR (n > (MAX(INTEGER) - k) DIV 10);
			IF ("0" <= ch) & (ch <= "9") THEN s.type := invalid END
		ELSE s.type := invalid
		END
	END Cardinal;

	PROCEDURE Set (VAR s: Scanner);
		VAR n, m, start: INTEGER; ch: CHAR;
	BEGIN
		s.type := set; start := s.start; Get(s, ch); s.Skip(ch); s.set := {};
		WHILE ("0" <= ch) & (ch <= "9") & (s.type = set) DO
			Cardinal(s, n); s.Skip(ch);
			IF (MIN(SET) <= n) & (n <= MAX(SET)) THEN
				INCL(s.set, n);
				IF ch = "." THEN
					Get(s, ch);
					IF ch = "." THEN
						Get(s, ch); s.Skip(ch); Cardinal(s, m); s.Skip(ch);
						IF (n <= m) & (m <= MAX(SET)) THEN
							WHILE m > n DO INCL(s.set, m); DEC(m) END
						ELSE s.type := invalid
						END
					ELSE s.type := invalid
					END
				END;
				IF (s.type = set) & (ch = ",") THEN Get(s, ch); s.Skip(ch);
					IF ch = "}" THEN s.type := invalid END
				ELSIF ch # "}" THEN s.type := invalid
				END
			ELSE s.type := invalid
			END
		END;
		IF s.type = set THEN
			IF ch = "}" THEN Get(s, ch) ELSE s.type := invalid END
		ELSE s.type := invalid
		END;
		s.start := start
	END Set;

	PROCEDURE Boolean (VAR s: Scanner);
		VAR ch: CHAR;
	BEGIN
		s.type := bool; Get(s, ch);
		IF (ch = "T") OR (ch = "F") THEN
			s.Scan;
			IF (s.type = string) & (s.string = "TRUE") THEN s.type := bool; s.bool := TRUE
			ELSIF (s.type = string) & (s.string = "FALSE") THEN s.type := bool; s.bool := FALSE
			ELSE s.type := invalid
			END
		ELSE s.type := invalid
		END
	END Boolean;

	PROCEDURE Name (VAR s: Scanner);
		VAR max: INTEGER; ch: CHAR;
	BEGIN
		s.type := string; s.len := 0; ch := s.rider.char; max := LEN(s.string);
		REPEAT
			s.string[s.len] := ch; INC(s.len); Get(s, ch)
		UNTIL ~(Strings.IsIdent(ch) & (ch # "_") OR acceptUnderscores & (ch = "_")) OR (s.len = max);
		IF (returnQualIdents IN s.opts) & (ch = ".") & (s.len < max) THEN
			REPEAT
				s.string[s.len] := ch; INC(s.len); Get(s, ch)
			UNTIL
			~(Strings.IsIdent(ch) & (ch # "_") OR acceptUnderscores & (ch = "_")) OR (s.len = max)
		END;
		IF s.len = max THEN DEC(s.len); s.type := invalid END;	(* ident too long *)
		s.string[s.len] := 0X
	END Name;

	PROCEDURE DoubleQuotedString (VAR s: Scanner);
		VAR max, pos: INTEGER; ch: CHAR;
	BEGIN
		pos := s.rider.Pos();
		s.type := string; s.len := 0; max := LEN(s.string) - 1; Get(s, ch);
		WHILE (ch # '"') & (ch # 0X) & (s.len < max) DO
			s.string[s.len] := ch; INC(s.len);
			Get(s, ch)
		END;
		s.string[s.len] := 0X;
		IF ch = '"' THEN Get(s, ch)
		ELSE s.type := invalid; s.rider.SetPos(pos (* s.rider.Pos() - s.len - 1 *)); Get(s, ch)
		END
	END DoubleQuotedString;

	PROCEDURE SingleQuotedString (VAR s: Scanner);
		VAR max, pos: INTEGER; ch: CHAR;
	BEGIN
		pos := s.rider.Pos();
		s.type := string; s.len := 0; max := LEN(s.string) - 1; Get(s, ch);
		WHILE (ch # "'") & (ch # 0X) & (s.len < max) DO
			s.string[s.len] := ch; INC(s.len);
			Get(s, ch)
		END;
		s.string[s.len] := 0X;
		IF s.len = 1 THEN s.type := char; s.char := s.string[0] END;
		IF ch = "'" THEN Get(s, ch)
		ELSE s.type := invalid; s.rider.SetPos(pos (* s.rider.Pos() - s.len - 1 *)); Get(s, ch)
		END
	END SingleQuotedString;

	PROCEDURE Char (VAR s: Scanner);
		VAR ch: CHAR;
	BEGIN
		ch := s.rider.char;
		IF ch # 0X THEN
			s.type := char; s.char := ch; s.string[0] := ch; s.string[1] := 0X; Get(s, ch)
		ELSE s.type := invalid
		END
	END Char;

	PROCEDURE View (VAR s: Scanner);
		VAR ch: CHAR;
	BEGIN
		s.type := view; s.view := s.rider.view; s.w := s.rider.w; s.h := s.rider.h;
		IF maskViews IN s.opts THEN
			IF s.rider.char # TextModels.viewcode THEN
				s.type := char; s.char := s.rider.char; s.string[0] := s.char; s.string[1] := 0X
			END
		END;
		Get(s, ch)
	END View;


	PROCEDURE (VAR s: Scanner) ConnectTo* (text: TextModels.Model), NEW;
	BEGIN
		IF text # NIL THEN
			s.rider := text.NewReader(s.rider); s.SetPos(0); s.SetOpts({})
		ELSE
			s.rider := NIL
		END
	END ConnectTo;

	PROCEDURE (VAR s: Scanner) SetPos* (pos: INTEGER), NEW;
	BEGIN
		s.rider.SetPos(pos); s.start := pos;
		s.lines := 0; s.paras := 0; s.type := invalid
	END SetPos;

	PROCEDURE (VAR s: Scanner) SetOpts* (opts: SET), NEW;
	BEGIN
		s.opts := opts
	END SetOpts;

	PROCEDURE (VAR s: Scanner) Pos* (): INTEGER, NEW;
	BEGIN
		RETURN s.rider.Pos()
	END Pos;

	PROCEDURE (VAR s: Scanner) Skip* (OUT ch: CHAR), NEW;
		VAR c, v: BOOLEAN;
	BEGIN
		IF s.opts * {returnCtrlChars, returnViews} = {} THEN
			ch := s.rider.char;
			WHILE ((ch <= " ") OR (ch = TextModels.digitspace) OR (ch = TextModels.nbspace))
			& ~s.rider.eot DO
				IF ch = LINE THEN INC(s.lines)
				ELSIF ch = PARA THEN INC(s.paras)
				END;
				Get(s, ch)
			END
		ELSE
			c := returnCtrlChars IN s.opts;
			v := returnViews IN s.opts;
			ch := s.rider.char;
			WHILE ((ch <= " ") OR (ch = TextModels.digitspace) OR (ch = TextModels.nbspace))
			& ~s.rider.eot
			& (~c OR (ch # TAB) & (ch # LINE) & (ch # PARA))
			& (~v OR (ch # VIEW) OR (s.rider.view = NIL)) DO
				IF ch = LINE THEN INC(s.lines)
				ELSIF ch = PARA THEN INC(s.paras)
				END;
				Get(s, ch)
			END
		END;
		IF ~s.rider.eot THEN s.start := s.rider.Pos() - 1
		ELSE s.start := s.rider.Base().Length(); s.type := eot
		END
	END Skip;

	PROCEDURE (VAR s: Scanner) Scan*, NEW;
		VAR sign, neg: BOOLEAN; ch: CHAR;
	BEGIN
		s.Skip(ch);
		IF s.type # eot THEN
			neg := (ch = "-"); sign := neg OR (ch = "+");
			IF sign THEN s.char := ch; Get(s, ch) END;
			IF ("0" <= ch) & (ch <= "9") THEN Number(s, neg)
			ELSIF sign THEN s.type := char;	(* return prefetched sign w/o trailing number *)
				s.string[0] := s.char; s.string[1] := 0X
			ELSE
				IF Strings.IsAlpha(ch) THEN
					Name(s)
				ELSE
					CASE ch OF
					| '"': DoubleQuotedString(s)
					| "'": SingleQuotedString(s)
					| TAB: s.type := tab; Get(s, ch)
					| LINE: s.type := line; Get(s, ch)
					| PARA: s.type := para; Get(s, ch)
					| VIEW:
						IF s.rider.view # NIL THEN View(s) ELSE Char(s) END
					| "{":
						IF interpretSets IN s.opts THEN Set(s) ELSE Char(s) END
					| "$":
						IF interpretBools IN s.opts THEN Boolean(s) ELSE Char(s) END
					| "_":
						IF acceptUnderscores THEN Name(s) ELSE Char(s) END
					ELSE Char(s)
					END
				END
			END
		END
	END Scan;


	(** scanning utilities **)

	PROCEDURE IsQualIdent* (IN s: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		ch := s[0]; i := 1;
		IF Strings.IsIdentStart(ch) THEN
			REPEAT
				ch := s[i]; INC(i)
			UNTIL ~ Strings.IsIdent(ch);
			IF ch = "." THEN
				INC(i);
				REPEAT
					ch := s[i]; INC(i)
				UNTIL ~ Strings.IsIdent(ch);
				RETURN ch = 0X
			ELSE
				RETURN FALSE
			END
		ELSE
			RETURN FALSE
		END
	END IsQualIdent;

	PROCEDURE ScanQualIdent* (VAR s: Scanner; OUT x: ARRAY OF CHAR; OUT done: BOOLEAN);
		VAR mod: String; i, j, len, start: INTEGER; ch: CHAR;
	BEGIN
		done := FALSE;
		IF s.type = string THEN
			IF IsQualIdent(s.string) THEN
				IF s.len < LEN(x) THEN
					x := s.string$; done := TRUE
				END
			ELSE
				mod := s.string; len := s.len; start := s.start;
				s.Scan;
				IF (s.type = char) & (s.char = ".") THEN
					s.Scan;
					IF (s.type = string) & (len + 1 + s.len < LEN(x)) THEN
						i := 0; ch := mod[0]; WHILE ch # 0X DO x[i] := ch; INC(i); ch := mod[i] END;
						x[i] := "."; INC(i);
						j := 0; ch := s.string[0];
						WHILE ch # 0X DO x[i] := ch; INC(i); INC(j); ch := s.string[j] END;
						x[i] := 0X; done := TRUE
					END
				END;
				IF ~done THEN s.SetPos(start); s.Scan() END
			END
		END
	END ScanQualIdent;


	(** Formatter **)

	PROCEDURE ^ (IN f: Formatter) SetPos* (pos: INTEGER), NEW;
	PROCEDURE ^ (IN f: Formatter) WriteIntForm* (x: LONGINT;
														base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN), NEW;
	PROCEDURE ^ (IN f: Formatter) WriteRealForm* (x: REAL;
														precision, minW, expW: INTEGER; fillCh: CHAR), NEW;
	PROCEDURE ^ (IN f: Formatter) WriteViewForm* (v: Views.View; w, h: INTEGER), NEW;


	PROCEDURE (VAR f: Formatter) ConnectTo* (text: TextModels.Model), NEW;
	BEGIN
		IF text # NIL THEN
			f.rider := text.NewWriter(f.rider); f.SetPos(text.Length())
		ELSE
			f.rider := NIL
		END
	END ConnectTo;

	PROCEDURE (IN f: Formatter) SetPos* (pos: INTEGER), NEW;
	BEGIN
		f.rider.SetPos(pos)
	END SetPos;

	PROCEDURE (IN f: Formatter) Pos* (): INTEGER, NEW;
	BEGIN
		RETURN f.rider.Pos()
	END Pos;


	PROCEDURE (IN f: Formatter) WriteChar* (x: CHAR), NEW;
	BEGIN
		IF (x >= " ") & (x # 7FX) THEN
			f.rider.WriteChar(x)
		ELSE
			f.rider.WriteChar(" ");
			f.WriteIntForm(ORD(x), charCode, 3, "0", showBase);
			f.rider.WriteChar(" ")
		END
	END WriteChar;

	PROCEDURE (IN f: Formatter) WriteInt* (x: LONGINT), NEW;
	BEGIN
		f.WriteIntForm(x, decimal, 0, TextModels.digitspace, hideBase)
	END WriteInt;

	PROCEDURE (IN f: Formatter) WriteSString* (x: ARRAY OF SHORTCHAR), NEW;
		VAR i: INTEGER;
	BEGIN
		i := 0; WHILE x[i] # 0X DO f.WriteChar(x[i]); INC(i) END
	END WriteSString;

	PROCEDURE (IN f: Formatter) WriteString* (x: ARRAY OF CHAR), NEW;
		VAR i: INTEGER;
	BEGIN
		i := 0; WHILE x[i] # 0X DO f.WriteChar(x[i]); INC(i) END
	END WriteString;

	PROCEDURE (IN f: Formatter) WriteReal* (x: REAL), NEW;
		VAR m: ARRAY 256 OF CHAR;
	BEGIN
		Strings.RealToString(x, m); f.WriteString(m)
	END WriteReal;

	PROCEDURE (IN f: Formatter) WriteBool* (x: BOOLEAN), NEW;
	BEGIN
		IF x THEN f.WriteString("$TRUE") ELSE f.WriteString("$FALSE") END
	END WriteBool;

	PROCEDURE (IN f: Formatter) WriteSet* (x: SET), NEW;
		VAR str: ARRAY 128 OF CHAR;
	BEGIN
		Strings.SetToString(x, str); f.WriteString(str)
	END WriteSet;

	PROCEDURE (IN f: Formatter) WriteTab*, NEW;
	BEGIN
		f.rider.WriteChar(TAB)
	END WriteTab;

	PROCEDURE (IN f: Formatter) WriteLn*, NEW;
	BEGIN
		f.rider.WriteChar(LINE)
	END WriteLn;

	PROCEDURE (IN f: Formatter) WritePara*, NEW;
	BEGIN
		f.rider.WriteChar(PARA)
	END WritePara;

	PROCEDURE (IN f: Formatter) WriteView* (v: Views.View), NEW;
	BEGIN
		f.WriteViewForm(v, Views.undefined, Views.undefined)
	END WriteView;


	PROCEDURE (IN f: Formatter) WriteIntForm* (x: LONGINT;
		base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN
	), NEW;
		VAR s: ARRAY 80 OF CHAR;
	BEGIN
		Strings.IntToStringForm(x, base, minWidth, fillCh, showBase, s);
		f.WriteString(s)
	END WriteIntForm;

	PROCEDURE (IN f: Formatter) WriteRealForm* (x: REAL;
		precision, minW, expW: INTEGER; fillCh: CHAR
	), NEW;
		VAR s: ARRAY 256 OF CHAR;
	BEGIN
		Strings.RealToStringForm(x, precision, minW, expW, fillCh, s); f.WriteString(s)
	END WriteRealForm;


	PROCEDURE (IN f: Formatter) WriteViewForm* (v: Views.View; w, h: INTEGER), NEW;
	BEGIN
		f.rider.WriteView(v, w, h)
	END WriteViewForm;

	PROCEDURE (IN f: Formatter) WriteParamMsg* (msg, p0, p1, p2: ARRAY OF CHAR), NEW;
		VAR s: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR;
	BEGIN
		Dialog.MapParamString(msg, p0, p1, p2, s);
		i := 0; ch := s[0];
		WHILE ch # 0X DO
			IF ch = LINE THEN f.WriteLn
			ELSIF ch = PARA THEN f.WritePara
			ELSIF ch = TAB THEN f.WriteTab
			ELSIF ch >= " " THEN f.WriteChar(ch)
			END;
			INC(i); ch := s[i]
		END
	END WriteParamMsg;

	PROCEDURE (IN f: Formatter) WriteMsg* (msg: ARRAY OF CHAR), NEW;
	BEGIN
		f.WriteParamMsg(msg, "", "", "")
	END WriteMsg;

END TextMappers.
