blackbox-linux-console/BlackBox/Std/Mod/ETHConv.txt

MODULE StdETHConv;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/ETHConv.odc *)
	(* DO NOT EDIT *)

	IMPORT
		Fonts, Files, Stores, Ports, Views,
		TextModels, TextRulers, TextViews,
		Stamps := StdStamps, Clocks := StdClocks, StdFolds;

	CONST
		V2Tag = -4095; (* 01 F0 *)
		V4Tag = 496; (* F0 01 *)

	TYPE
		FontDesc = RECORD
			typeface: Fonts.Typeface;
			size: INTEGER;
			style: SET;
			weight: INTEGER
		END;

	VAR default: Fonts.Font;

	PROCEDURE Split (name: ARRAY OF CHAR; VAR d: FontDesc);
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := name[0];
		WHILE (ch < "0") OR (ch >"9") DO
			d.typeface[i] := ch; INC(i); ch := name[i]
		END;
		d.typeface[i] := 0X;
		d.size := 0;
		WHILE ("0" <= ch) & (ch <= "9") DO
			d.size := d.size * 10 + (ORD(ch) - 30H); INC(i); ch := name[i]
		END;
		CASE ch OF
		  "b": d.style := {}; d.weight := Fonts.bold
		| "i": d.style := {Fonts.italic}; d.weight := Fonts.normal
		| "j": d.style := {Fonts.italic}; d.weight := Fonts.bold
		| "m": d.style := {}; d.weight := Fonts.bold
		ELSE d.style := {}; d.weight := Fonts.normal	(* unknown style *)
		END
	END Split;

	PROCEDURE ThisFont (name: ARRAY OF CHAR): Fonts.Font; 
		VAR d: FontDesc;
	BEGIN
		Split(name, d);
		IF d.typeface = "Syntax" THEN d.typeface := default.typeface END;
		IF d.size = 10 THEN d.size := default.size
		ELSE d.size := (d.size - 2) * Ports.point
		END;
		RETURN Fonts.dir.This(d.typeface, d.size, d.style, d.weight)
	END ThisFont;

	PROCEDURE ThisChar (ch: CHAR): CHAR;
	BEGIN
		CASE ORD(ch) OF
		  80H: ch := 0C4X | 81H: ch := 0D6X | 82H: ch := 0DCX
		| 83H: ch := 0E4X | 84H: ch := 0F6X | 85H: ch := 0FCX
		| 86H: ch := 0E2X | 87H: ch := 0EAX | 88H: ch := 0EEX | 89H: ch := 0F4X | 8AH: ch := 0FBX
		| 8BH: ch := 0E0X | 8CH: ch := 0E8X | 8DH: ch := 0ECX | 8EH: ch := 0F2X | 8FH: ch := 0F9X
		| 90H: ch := 0E9X
		| 91H: ch := 0EBX | 92H: ch := 0EFX
		| 93H: ch := 0E7X
		| 94H: ch := 0E1X
		| 95H: ch := 0F1X
		| 9BH: ch := TextModels.hyphen
		| 9FH: ch := TextModels.nbspace
		| 0ABH: ch := 0DFX
		ELSE
			ch := 0BFX	(* use inverted question mark for unknown character codes *)
		END;
		RETURN ch
	END ThisChar;
	
	PROCEDURE ^ LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
	
	PROCEDURE StdFold (VAR r: Stores.Reader): Views.View;
		CONST colLeft = 0; colRight = 1; expRight = 2; expLeft = 3;
		VAR k: BYTE; state: BOOLEAN; hidden: TextModels.Model; fold: StdFolds.Fold;
	BEGIN
		r.ReadByte(k);
		CASE k MOD 4 OF
			| colLeft: state := StdFolds.collapsed
			| colRight: state := StdFolds.collapsed
			| expRight: state := StdFolds.expanded
			| expLeft: state := StdFolds.expanded
		END;
		IF (k MOD 4 IN {colLeft, expLeft}) & (k < 4) THEN
			hidden := TextModels.dir.New(); LoadTextBlock(r, hidden);
		ELSE hidden := NIL;
		END;
		fold := StdFolds.dir.New(state, "", hidden);
		RETURN fold;
	END StdFold;
	
	PROCEDURE LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
		VAR r0: Stores.Reader; wr: TextModels.Writer;
			org, len: INTEGER; en, ano, i, n: BYTE; col, voff, ch: CHAR; tag: INTEGER;
			fname: ARRAY 32 OF CHAR;
			attr: ARRAY 32 OF TextModels.Attributes;
			mod, proc: ARRAY 32 OF ARRAY 32 OF CHAR;

		PROCEDURE ReadNum (VAR n: INTEGER);
			VAR s: BYTE; ch: CHAR; y: INTEGER;
		BEGIN
			s := 0; y := 0; r.ReadXChar(ch);
			WHILE ch >= 80X DO
				INC(y, ASH(ORD(ch)-128, s)); INC(s, 7); r.ReadXChar(ch)
			END;
			n := ASH((ORD(ch) + 64) MOD 128 - 64, s) + y
		END ReadNum;

		PROCEDURE ReadSet (VAR s: SET);
			VAR x: INTEGER;
		BEGIN
			ReadNum(x); s := BITS(x)
		END ReadSet;

		PROCEDURE Elem (VAR r: Stores.Reader; span: INTEGER);
			VAR v: Views.View; end, ew, eh, n, indent: INTEGER; eno, version: BYTE;
				p: TextRulers.Prop; opts: SET;
		BEGIN
			r.ReadInt(ew); r.ReadInt(eh); r.ReadByte(eno);
			IF eno > en THEN en := eno; r.ReadXString(mod[eno]); r.ReadXString(proc[eno]) END;
			end := r.Pos() + span;
			IF (mod[eno] = "ParcElems") OR (mod[eno] = "StyleElems") THEN
				r.ReadByte(version);
				NEW(p);
				p.valid := {TextRulers.first .. TextRulers.tabs};
				ReadNum(indent); ReadNum(p.left);
				p.first := p.left + indent;
				ReadNum(n); p.right := p.left + n;
				ReadNum(p.lead);
				ReadNum(p.grid);
				ReadNum(p.dsc); p.asc := p.grid - p.dsc;
				ReadSet(opts); p.opts.val := {};
				IF ~(0 IN opts) THEN p.grid := 1 END;
				IF 1 IN opts THEN INCL(p.opts.val, TextRulers.leftAdjust) END;
				IF 2 IN opts THEN INCL(p.opts.val, TextRulers.rightAdjust) END;
				IF 3 IN opts THEN INCL(p.opts.val, TextRulers.pageBreak) END;
				INCL(p.opts.val, TextRulers.rightFixed);
				p.opts.mask := {TextRulers.leftAdjust .. TextRulers.pageBreak, TextRulers.rightFixed};
				ReadNum(n); p.tabs.len := n;
				i := 0; WHILE i < p.tabs.len DO ReadNum(p.tabs.tab[i].stop); INC(i) END;
				v := TextRulers.dir.NewFromProp(p);
				wr.WriteView(v, ew, eh)
			ELSIF mod[eno] = "StampElems" THEN
				v := Stamps.New();
				wr.WriteView(v, ew, eh)
			ELSIF mod[eno] = "ClockElems" THEN
				v := Clocks.New();
				wr.WriteView(v, ew, eh)
			ELSIF mod[eno] = "FoldElems" THEN
				v := StdFold(r);
				wr.WriteView(v, ew, eh);
			END;
			r.SetPos(end)
		END Elem;

	BEGIN
		(* skip inner text tags (legacy from V2) *)
		r.ReadXInt(tag);
		IF tag # V2Tag THEN r.SetPos(r.Pos()-2) END;
		(* load text block *)
		org := r.Pos(); r.ReadInt(len); INC(org, len - 2);
		r0.ConnectTo(r.rider.Base()); r0.SetPos(org);
		wr := t.NewWriter(NIL); wr.SetPos(0);
		n := 0; en := 0; r.ReadByte(ano);
		WHILE ano # 0 DO
			IF ano > n THEN
				n := ano; r.ReadXString(fname);
				attr[n] := TextModels.NewFont(wr.attr, ThisFont(fname))
			END;
			r.ReadXChar(col); r.ReadXChar(voff); r.ReadInt(len);
			wr.SetAttr(attr[ano]);
			IF len > 0 THEN
				WHILE len # 0 DO
					r0.ReadXChar(ch);
					IF ch >= 80X THEN ch := ThisChar(ch) END;
					IF (ch >= " ") OR (ch = TextModels.tab) OR (ch = TextModels.line) THEN
						wr.WriteChar(ch)
					END;
					DEC(len)
				END
			ELSE
				Elem(r, -len); r0.ReadXChar(ch)
			END;
			r.ReadByte(ano)
		END;
		r.ReadInt(len);
		r.SetPos(r.Pos() + len);
	END LoadTextBlock;

	PROCEDURE ImportOberon* (f: Files.File): TextModels.Model;
		VAR r: Stores.Reader; t: TextModels.Model; tag: INTEGER;
	BEGIN
		r.ConnectTo(f); r.SetPos(0);
		r.ReadXInt(tag);
		IF tag = ORD("o") + 256 * ORD("B") THEN
			(* ignore file header of Oberon for Windows and DOSOberon files *)
			r.SetPos(34); r.ReadXInt(tag)
		END;
		ASSERT((tag = V2Tag) OR (tag = V4Tag), 100);
		t := TextModels.dir.New();
		LoadTextBlock(r, t);
		RETURN t;
	END ImportOberon;
	

	PROCEDURE ImportETHDoc* (f: Files.File; OUT s: Stores.Store);
		VAR t: TextModels.Model;
	BEGIN
		ASSERT(f # NIL, 20);
		t := ImportOberon(f);
		IF t # NIL THEN s := TextViews.dir.New(t) END
	END ImportETHDoc;

BEGIN
	default := Fonts.dir.Default()
END StdETHConv.