|
@@ -0,0 +1,1155 @@
|
|
|
+MODULE HostTextConv;
|
|
|
+
|
|
|
+ (* THIS IS TEXT COPY OF HostTextConv.odc *)
|
|
|
+ (* DO NOT EDIT *)
|
|
|
+
|
|
|
+ IMPORT
|
|
|
+ SYSTEM, (* WinApi, WinOle, COM, *)
|
|
|
+ Files, Fonts, Ports, Stores, Views, Properties,
|
|
|
+ HostFonts, (* HostClipboard, *) TextModels,
|
|
|
+ TextRulers, TextViews, TextMappers;
|
|
|
+
|
|
|
+ CONST
|
|
|
+ CR = 0DX; LF = 0AX; FF = 0EX; TAB = 09X;
|
|
|
+ halfpoint = Ports.point DIV 2;
|
|
|
+ twips = Ports.point DIV 20;
|
|
|
+
|
|
|
+ TYPE
|
|
|
+ Context = POINTER TO RECORD
|
|
|
+ next: Context;
|
|
|
+ dest: INTEGER;
|
|
|
+ uniCnt : INTEGER;
|
|
|
+ attr: TextModels.Attributes;
|
|
|
+ pattr: TextRulers.Attributes
|
|
|
+ END;
|
|
|
+ MemReader = POINTER TO RECORD (Files.Reader)
|
|
|
+ adr, pos: INTEGER
|
|
|
+ END;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ debug*: BOOLEAN;
|
|
|
+
|
|
|
+
|
|
|
+ (* MemReader *)
|
|
|
+
|
|
|
+ PROCEDURE (r: MemReader) Base (): Files.File;
|
|
|
+ BEGIN
|
|
|
+ RETURN NIL
|
|
|
+ END Base;
|
|
|
+
|
|
|
+ PROCEDURE (r: MemReader) Pos (): INTEGER;
|
|
|
+ BEGIN
|
|
|
+ RETURN r.pos
|
|
|
+ END Pos;
|
|
|
+
|
|
|
+ PROCEDURE (r: MemReader) SetPos (pos: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ r.pos := pos
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ PROCEDURE (r: MemReader) ReadByte (OUT x: BYTE);
|
|
|
+ BEGIN
|
|
|
+ SYSTEM.GET(r.adr + r.pos, x); INC(r.pos)
|
|
|
+ END ReadByte;
|
|
|
+
|
|
|
+ PROCEDURE (r: MemReader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ HALT(126)
|
|
|
+ END ReadBytes;
|
|
|
+
|
|
|
+(*
|
|
|
+ PROCEDURE GenGlobalMedium (hg: WinApi.HGLOBAL; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
|
|
|
+ BEGIN
|
|
|
+ sm.tymed := WinOle.TYMED_HGLOBAL;
|
|
|
+ sm.u.hGlobal := hg;
|
|
|
+ sm.pUnkForRelease := unk
|
|
|
+ END GenGlobalMedium;
|
|
|
+
|
|
|
+ PROCEDURE MediumGlobal (VAR sm: WinOle.STGMEDIUM): WinApi.HGLOBAL;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(sm.tymed = WinOle.TYMED_HGLOBAL, 20);
|
|
|
+ RETURN sm.u.hGlobal
|
|
|
+ END MediumGlobal;
|
|
|
+*)
|
|
|
+
|
|
|
+ PROCEDURE WriteWndChar (wr: TextModels.Writer; ch: CHAR);
|
|
|
+ BEGIN
|
|
|
+ CASE ch OF
|
|
|
+ | CR, TAB, " "..7EX, 0A0X..0FFX: wr.WriteChar(ch)
|
|
|
+ | LF:
|
|
|
+ | 80X: wr.WriteChar(20ACX) (* euro *)
|
|
|
+ | 82X: wr.WriteChar(201AX)
|
|
|
+ | 83X: wr.WriteChar(0192X)
|
|
|
+ | 84X: wr.WriteChar(201EX)
|
|
|
+ | 85X: wr.WriteChar(2026X)
|
|
|
+ | 86X: wr.WriteChar(2020X)
|
|
|
+ | 87X: wr.WriteChar(2021X)
|
|
|
+ | 88X: wr.WriteChar(02C6X)
|
|
|
+ | 89X: wr.WriteChar(2030X)
|
|
|
+ | 8AX: wr.WriteChar(0160X)
|
|
|
+ | 8BX: wr.WriteChar(2039X)
|
|
|
+ | 8CX: wr.WriteChar(0152X)
|
|
|
+ | 91X: wr.WriteChar(2018X)
|
|
|
+ | 92X: wr.WriteChar(2019X)
|
|
|
+ | 93X: wr.WriteChar(201CX)
|
|
|
+ | 94X: wr.WriteChar(201DX)
|
|
|
+ | 95X: wr.WriteChar(2022X)
|
|
|
+ | 96X: wr.WriteChar(2013X)
|
|
|
+ | 97X: wr.WriteChar(2014X)
|
|
|
+ | 98X: wr.WriteChar(02DCX)
|
|
|
+ | 99X: wr.WriteChar(2122X)
|
|
|
+ | 9AX: wr.WriteChar(0161X)
|
|
|
+ | 9BX: wr.WriteChar(203AX)
|
|
|
+ | 9CX: wr.WriteChar(0153X)
|
|
|
+ | 9FX: wr.WriteChar(0178X)
|
|
|
+ | 0X..8X, 0BX, 0CX, 0EX..1FX, 7FX, 81X, 8DX..90X, 9DX, 9EX:
|
|
|
+ wr.WriteChar(CHR(0EF00H + ORD(ch)))
|
|
|
+ END
|
|
|
+ END WriteWndChar;
|
|
|
+
|
|
|
+ PROCEDURE ThisWndChar (ch: CHAR): CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF ch >= 100X THEN
|
|
|
+ IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H)
|
|
|
+ ELSIF ch = 20ACX THEN ch := 80X (* euro *)
|
|
|
+ ELSIF ch = 201AX THEN ch := 82X
|
|
|
+ ELSIF ch = 0192X THEN ch := 83X
|
|
|
+ ELSIF ch = 201EX THEN ch := 84X
|
|
|
+ ELSIF ch = 2026X THEN ch := 85X
|
|
|
+ ELSIF ch = 2020X THEN ch := 86X
|
|
|
+ ELSIF ch = 2021X THEN ch := 87X
|
|
|
+ ELSIF ch = 02C6X THEN ch := 88X
|
|
|
+ ELSIF ch = 2030X THEN ch := 89X
|
|
|
+ ELSIF ch = 0160X THEN ch := 8AX
|
|
|
+ ELSIF ch = 2039X THEN ch := 8BX
|
|
|
+ ELSIF ch = 0152X THEN ch := 8CX
|
|
|
+ ELSIF ch = 2018X THEN ch := 91X
|
|
|
+ ELSIF ch = 2019X THEN ch := 92X
|
|
|
+ ELSIF ch = 201CX THEN ch := 93X
|
|
|
+ ELSIF ch = 201DX THEN ch := 94X
|
|
|
+ ELSIF ch = 2022X THEN ch := 95X
|
|
|
+ ELSIF ch = 2013X THEN ch := 96X
|
|
|
+ ELSIF ch = 2014X THEN ch := 97X
|
|
|
+ ELSIF ch = 02DCX THEN ch := 98X
|
|
|
+ ELSIF ch = 2122X THEN ch := 99X
|
|
|
+ ELSIF ch = 0161X THEN ch := 9AX
|
|
|
+ ELSIF ch = 203AX THEN ch := 9BX
|
|
|
+ ELSIF ch = 0153X THEN ch := 9CX
|
|
|
+ ELSIF ch = 0178X THEN ch := 9FX
|
|
|
+ ELSE ch := "?"
|
|
|
+ END
|
|
|
+ ELSIF ch = 08FX THEN ch := " " (* digit space *)
|
|
|
+ END;
|
|
|
+ RETURN ch
|
|
|
+ END ThisWndChar;
|
|
|
+
|
|
|
+ PROCEDURE ParseRichText (rd: Files.Reader; wr: TextModels.Writer; VAR defRuler: TextRulers.Ruler);
|
|
|
+ TYPE
|
|
|
+ FontInfo = POINTER TO RECORD id: INTEGER; f: Fonts.Typeface; next: FontInfo END;
|
|
|
+ ColorInfo = POINTER TO RECORD id: INTEGER; c: Ports.Color; next: ColorInfo END;
|
|
|
+ CONST text = 0; fonttab = 1; colortab = 2; skip = 3;
|
|
|
+ VAR ch: CHAR; tabStyle: SET;
|
|
|
+ fact, val, defFont, dest, idx, fnum, cnum, paraPos, i: INTEGER;
|
|
|
+ fonts, font: FontInfo; colors: ColorInfo;
|
|
|
+ hasNum, remPar, skipDest: BOOLEAN;
|
|
|
+ f: Fonts.Font; comm: ARRAY 32 OF CHAR;
|
|
|
+ c, con: Context; p0: Properties.Property; p: TextRulers.Prop;
|
|
|
+ ruler: TextRulers.Ruler;
|
|
|
+ pattr: TextRulers.Attributes;
|
|
|
+ skipCnt, uniCnt : INTEGER;
|
|
|
+
|
|
|
+ PROCEDURE Color(i: INTEGER): ColorInfo;
|
|
|
+ VAR c: ColorInfo;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(colors # NIL, 20);
|
|
|
+ c := colors;
|
|
|
+ WHILE (c # NIL) & (c.id # i) DO c := c.next END;
|
|
|
+ ASSERT(c # NIL, 100);
|
|
|
+ RETURN c
|
|
|
+ END Color;
|
|
|
+
|
|
|
+ PROCEDURE SetColor(i: INTEGER; c: Ports.Color);
|
|
|
+ VAR ci: ColorInfo;
|
|
|
+ BEGIN
|
|
|
+ NEW(ci); ci.id := i; ci.c := c; ci.next := colors; colors := ci
|
|
|
+ END SetColor;
|
|
|
+
|
|
|
+ PROCEDURE Font(i: INTEGER): FontInfo;
|
|
|
+ VAR f: FontInfo;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(fonts # NIL, 20);
|
|
|
+ f := fonts;
|
|
|
+ WHILE (f # NIL) & (f.id # i) DO f := f.next END;
|
|
|
+ ASSERT(f # NIL, 100);
|
|
|
+ RETURN f
|
|
|
+ END Font;
|
|
|
+
|
|
|
+ PROCEDURE SetFont(i: INTEGER; tf: Fonts.Typeface);
|
|
|
+ VAR f: FontInfo;
|
|
|
+ BEGIN
|
|
|
+ NEW(f); f.id := i; f.f := tf; f.next := fonts; fonts := f
|
|
|
+ END SetFont;
|
|
|
+
|
|
|
+ PROCEDURE Next (VAR ch: CHAR);
|
|
|
+ VAR b: BYTE;
|
|
|
+ BEGIN
|
|
|
+ rd.ReadByte(b); ch := CHR(b MOD 256)
|
|
|
+ END Next;
|
|
|
+
|
|
|
+ PROCEDURE Write (ch: CHAR);
|
|
|
+ BEGIN
|
|
|
+ IF skipCnt > 0 THEN
|
|
|
+ DEC(skipCnt)
|
|
|
+ ELSIF dest = text THEN
|
|
|
+ IF ch < 100X THEN WriteWndChar(wr, ch)
|
|
|
+ ELSE wr.WriteChar(ch)
|
|
|
+ END
|
|
|
+ ELSIF dest = fonttab THEN
|
|
|
+ ASSERT(font # NIL, 20);
|
|
|
+ font.f[idx] := ch; INC(idx); font.f[idx] := 0X
|
|
|
+ END
|
|
|
+ END Write;
|
|
|
+
|
|
|
+ PROCEDURE Paragraph;
|
|
|
+ VAR v: Views.View;
|
|
|
+ BEGIN
|
|
|
+ IF ~pattr.Equals(ruler.style.attr) THEN (* new ruler needed *)
|
|
|
+ wr.SetPos(paraPos);
|
|
|
+ v := Views.CopyOf(ruler, Views.deep); ruler := v(TextRulers.Ruler);
|
|
|
+ ruler.style.SetAttr(pattr);
|
|
|
+ wr.WriteView(ruler, Views.undefined, Views.undefined);
|
|
|
+ wr.SetPos(wr.Base().Length())
|
|
|
+ ELSIF (pattr.first # pattr.left)
|
|
|
+ OR (pattr.lead > 0)
|
|
|
+ OR (TextRulers.pageBreak IN pattr.opts) THEN (* paragraph marker needed *)
|
|
|
+ wr.SetPos(paraPos);
|
|
|
+ wr.WriteChar(FF);
|
|
|
+ wr.SetPos(wr.Base().Length())
|
|
|
+ END;
|
|
|
+ wr.WriteChar(CR);
|
|
|
+ paraPos := wr.Pos()
|
|
|
+ END Paragraph;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ defFont := 0; fnum := 1; f := Fonts.dir.Default(); NEW(fonts); fonts.f := f.typeface; skipCnt := 0; uniCnt := 1;
|
|
|
+ cnum := 1; NEW(colors); SetColor(0, Ports.defaultColor);
|
|
|
+ dest := text; con := NIL; paraPos := 0; remPar := FALSE; skipDest := FALSE;
|
|
|
+ defRuler := TextRulers.dir.New(NIL); ruler := defRuler; pattr := defRuler.style.attr; tabStyle := {};
|
|
|
+ Next(ch);
|
|
|
+ WHILE ch # 0X DO
|
|
|
+ IF ch = "{" THEN
|
|
|
+ skipCnt := 0;
|
|
|
+ NEW(c); c.dest := dest; c.attr := wr.attr; c.pattr := pattr; c.uniCnt := uniCnt; c.next := con; con := c;
|
|
|
+ Next(ch)
|
|
|
+ ELSIF ch = "}" THEN
|
|
|
+ skipCnt := 0;
|
|
|
+ IF con # NIL THEN
|
|
|
+ dest := con.dest; uniCnt := con.uniCnt; wr.SetAttr(con.attr); pattr := con.pattr; con := con.next
|
|
|
+ END;
|
|
|
+ Next(ch)
|
|
|
+ ELSIF ch = "\" THEN
|
|
|
+ Next(ch); i := 0; val := 0;
|
|
|
+ IF (ch >= "a") & (ch <= "z") THEN
|
|
|
+ WHILE (ch >= "a") & (ch <= "z") DO comm[i] := ch; INC(i); Next(ch) END;
|
|
|
+ comm[i] := 0X; fact := 1; hasNum := FALSE;
|
|
|
+ IF ch = "-" THEN fact := -1; Next(ch) END;
|
|
|
+ WHILE (ch >= "0") & (ch <= "9") DO
|
|
|
+ val := 10 * val + ORD(ch) - ORD("0"); Next(ch); hasNum := TRUE
|
|
|
+ END;
|
|
|
+ val := val * fact;
|
|
|
+ IF ch = " " THEN Next(ch) END;
|
|
|
+ (* special characters *)
|
|
|
+ IF skipCnt > 0 THEN DEC(skipCnt) (* command skipped as single character *)
|
|
|
+ ELSIF comm = "tab" THEN Write(TAB)
|
|
|
+ ELSIF comm = "line" THEN Write(CR)
|
|
|
+ ELSIF comm = "par" THEN Paragraph
|
|
|
+ ELSIF comm = "sect" THEN Paragraph
|
|
|
+ ELSIF comm = "ldblquote" THEN Write(201CX) (* unicode: left double quote *)
|
|
|
+ ELSIF comm = "rdblquote" THEN Write(201DX) (* unicode: right double quote *)
|
|
|
+ ELSIF comm = "lquote" THEN Write(2018X) (* unicode: left single quote *)
|
|
|
+ ELSIF comm = "rquote" THEN Write(2019X) (* unicode: right single quote *)
|
|
|
+ ELSIF comm = "enspace" THEN Write(2002X) (* unicode: en space *)
|
|
|
+ ELSIF comm = "emspace" THEN Write(2003X) (* unicode: em space *)
|
|
|
+ ELSIF comm = "endash" THEN Write(2013X) (* unicode: en dash *)
|
|
|
+ ELSIF comm = "emdash" THEN Write(2014X) (* unicode: em dash *)
|
|
|
+ ELSIF comm = "page" THEN
|
|
|
+ Paragraph; NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.pageBreak}; p.opts.mask := p.opts.val;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ (* character attributes *)
|
|
|
+ ELSIF comm = "plain" THEN
|
|
|
+ wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.normal));
|
|
|
+ wr.SetAttr(TextModels.NewStyle(wr.attr, {}));
|
|
|
+ wr.SetAttr(TextModels.NewTypeface(wr.attr, Font(defFont).f));
|
|
|
+ wr.SetAttr(TextModels.NewSize(wr.attr, 24 * halfpoint));
|
|
|
+ wr.SetAttr(TextModels.NewColor(wr.attr, Ports.defaultColor));
|
|
|
+ wr.SetAttr(TextModels.NewOffset(wr.attr, 0))
|
|
|
+ ELSIF comm = "b" THEN
|
|
|
+ IF hasNum & (val = 0) THEN wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.normal))
|
|
|
+ ELSE wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.bold))
|
|
|
+ END
|
|
|
+ ELSIF comm = "i" THEN
|
|
|
+ IF hasNum & (val = 0) THEN
|
|
|
+ wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.italic}))
|
|
|
+ ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.italic}))
|
|
|
+ END
|
|
|
+ ELSIF comm = "ul" THEN
|
|
|
+ IF hasNum & (val = 0) THEN
|
|
|
+ wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.underline}))
|
|
|
+ ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.underline}))
|
|
|
+ END
|
|
|
+ ELSIF comm = "strike" THEN
|
|
|
+ IF hasNum & (val = 0) THEN
|
|
|
+ wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.strikeout}))
|
|
|
+ ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.strikeout}))
|
|
|
+ END
|
|
|
+ ELSIF comm = "f" THEN
|
|
|
+ IF ~hasNum THEN val := defFont END;
|
|
|
+ IF dest = fonttab THEN
|
|
|
+ fnum := val; idx := 0; NEW(font); font.id := val; font.next := fonts; fonts := font
|
|
|
+ ELSE
|
|
|
+ wr.SetAttr(TextModels.NewTypeface(wr.attr, Font(val).f))
|
|
|
+ END
|
|
|
+ ELSIF comm = "fs" THEN
|
|
|
+ IF ~hasNum THEN val := 24 END;
|
|
|
+ wr.SetAttr(TextModels.NewSize(wr.attr, val * halfpoint))
|
|
|
+ ELSIF comm = "cf" THEN
|
|
|
+ wr.SetAttr(TextModels.NewColor(wr.attr, Color(val).c))
|
|
|
+ ELSIF comm = "dn" THEN
|
|
|
+ IF ~hasNum THEN val := 6 END;
|
|
|
+ wr.SetAttr(TextModels.NewOffset(wr.attr, -(val * halfpoint)))
|
|
|
+ ELSIF comm = "up" THEN
|
|
|
+ IF ~hasNum THEN val := 6 END;
|
|
|
+ wr.SetAttr(TextModels.NewOffset(wr.attr, val * halfpoint))
|
|
|
+ (* paragraph attributes *)
|
|
|
+ ELSIF comm = "pard" THEN
|
|
|
+ pattr := defRuler.style.attr; tabStyle := {}
|
|
|
+ ELSIF comm = "fi" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.first}; p.first := pattr.left + val * twips;
|
|
|
+ IF p.first < 0 THEN (* change left indent to make the value legal *)
|
|
|
+ p.valid := {TextRulers.left, TextRulers.first};
|
|
|
+ p.left := pattr.left - p.first; p.first := 0
|
|
|
+ END;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "li" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.left, TextRulers.first};
|
|
|
+ p.left := val * twips; p.first := p.left + pattr.first - pattr.left;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "ql" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.leftAdjust};
|
|
|
+ p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "qr" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.rightAdjust};
|
|
|
+ p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "qc" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {};
|
|
|
+ p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "qj" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.leftAdjust, TextRulers.rightAdjust};
|
|
|
+ p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "sb" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.lead}; p.lead := val * twips;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "sl" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.grid}; p.grid := val * twips;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "tqc" THEN
|
|
|
+ tabStyle := {TextRulers.centerTab}
|
|
|
+ ELSIF (comm = "tqr") OR (comm="tqdec") THEN
|
|
|
+ tabStyle := {TextRulers.rightTab}
|
|
|
+ ELSIF comm = "tb" THEN
|
|
|
+ p0 := pattr.Prop(); p := p0(TextRulers.Prop);
|
|
|
+ p.valid := {TextRulers.tabs};
|
|
|
+ p.tabs.tab[p.tabs.len].stop := val * twips;
|
|
|
+ p.tabs.tab[p.tabs.len].type := {TextRulers.barTab}; tabStyle := {};
|
|
|
+ INC(p.tabs.len);
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "tx" THEN
|
|
|
+ p0 := pattr.Prop(); p := p0(TextRulers.Prop);
|
|
|
+ p.valid := {TextRulers.tabs};
|
|
|
+ p.tabs.tab[p.tabs.len].stop := val * twips;
|
|
|
+ p.tabs.tab[p.tabs.len].type := tabStyle; tabStyle := {};
|
|
|
+ INC(p.tabs.len);
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ ELSIF comm = "pagebb" THEN
|
|
|
+ NEW(p);
|
|
|
+ p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.pageBreak}; p.opts.mask := p.opts.val;
|
|
|
+ pattr := TextRulers.ModifiedAttr(pattr, p)
|
|
|
+ (* header *)
|
|
|
+ ELSIF comm = "deff" THEN
|
|
|
+ IF hasNum THEN defFont := val END
|
|
|
+ ELSIF comm = "fonttbl" THEN
|
|
|
+ IF dest # skip THEN dest := fonttab END
|
|
|
+ ELSIF comm = "colortbl" THEN
|
|
|
+ IF dest # skip THEN dest := colortab; cnum := 0; SetColor(0, 0) END
|
|
|
+ ELSIF comm = "red" THEN
|
|
|
+ IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256) END
|
|
|
+ ELSIF comm = "green" THEN
|
|
|
+ IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256 * 256) END
|
|
|
+ ELSIF comm = "blue" THEN
|
|
|
+ IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256 * 65536) END
|
|
|
+ ELSIF comm = "rtf" THEN
|
|
|
+ ELSIF comm = "ansi" THEN
|
|
|
+ ELSIF comm = "lang" THEN
|
|
|
+ ELSIF comm = "langfe" THEN
|
|
|
+ ELSIF comm = "loch" THEN
|
|
|
+ ELSIF comm = "ltrch" THEN
|
|
|
+ ELSIF comm = "rtlch" THEN
|
|
|
+ ELSIF comm = "ansicpg" THEN
|
|
|
+ (* misc *)
|
|
|
+ ELSIF comm = "bin" THEN rd.SetPos(rd.Pos() + val - 1); Next(ch)
|
|
|
+ (* unicode *)
|
|
|
+ ELSIF comm = "u" THEN Write(CHR(val)); skipCnt := uniCnt
|
|
|
+ ELSIF comm = "uc" THEN IF hasNum THEN uniCnt := val END
|
|
|
+ ELSIF comm = "upr" THEN dest := skip (* skip ANSI part *)
|
|
|
+ ELSIF comm = "ud" THEN dest := text (* use Unicode part *)
|
|
|
+ (* unhandled destinations *)
|
|
|
+ ELSIF comm = "author" THEN dest := skip
|
|
|
+ ELSIF comm = "buptim" THEN dest := skip
|
|
|
+ ELSIF comm = "comment" THEN dest := skip
|
|
|
+ ELSIF comm = "creatim" THEN dest := skip
|
|
|
+ ELSIF comm = "doccomm" THEN dest := skip
|
|
|
+ ELSIF comm = "footer" THEN dest := skip
|
|
|
+ ELSIF comm = "footerl" THEN dest := skip
|
|
|
+ ELSIF comm = "footerr" THEN dest := skip
|
|
|
+ ELSIF comm = "footerf" THEN dest := skip
|
|
|
+ ELSIF comm = "footnote" THEN dest := skip
|
|
|
+ ELSIF comm = "ftnsep" THEN dest := skip
|
|
|
+ ELSIF comm = "ftnsepc" THEN dest := skip
|
|
|
+ ELSIF comm = "ftncn" THEN dest := skip
|
|
|
+ ELSIF comm = "header" THEN dest := skip
|
|
|
+ ELSIF comm = "headerl" THEN dest := skip
|
|
|
+ ELSIF comm = "headerr" THEN dest := skip
|
|
|
+ ELSIF comm = "headerf" THEN dest := skip
|
|
|
+ ELSIF comm = "info" THEN dest := skip
|
|
|
+ ELSIF comm = "keywords" THEN dest := skip
|
|
|
+ ELSIF comm = "object" THEN dest := skip
|
|
|
+ ELSIF comm = "operator" THEN dest := skip
|
|
|
+ ELSIF comm = "pict" THEN dest := skip
|
|
|
+ ELSIF comm = "printim" THEN dest := skip
|
|
|
+ ELSIF comm = "private1" THEN dest := skip
|
|
|
+ ELSIF comm = "revtim" THEN dest := skip
|
|
|
+ ELSIF comm = "rxe" THEN dest := skip
|
|
|
+ ELSIF comm = "stylesheet" THEN dest := skip
|
|
|
+ ELSIF comm = "subject" THEN dest := skip
|
|
|
+ ELSIF comm = "tc" THEN dest := skip
|
|
|
+ ELSIF comm = "title" THEN dest := skip
|
|
|
+ ELSIF comm = "txe" THEN dest := skip
|
|
|
+ ELSIF comm = "xe" THEN dest := skip
|
|
|
+ ELSE (* unknown *)
|
|
|
+ IF skipDest & (con # NIL) & (con.next # NIL) THEN dest := skip END
|
|
|
+ END;
|
|
|
+ skipDest := FALSE
|
|
|
+ ELSIF ch = "'" THEN
|
|
|
+ Next(ch);
|
|
|
+ IF ch <= "9" THEN val := ORD(ch) - ORD("0") ELSE val := ORD(CAP(ch)) - ORD("A") + 10 END;
|
|
|
+ Next(ch);
|
|
|
+ IF ch <= "9" THEN val := 16 * val + ORD(ch) - ORD("0")
|
|
|
+ ELSE val := 16 * val + ORD(CAP(ch)) - ORD("A") + 10
|
|
|
+ END;
|
|
|
+ Write(CHR(val)); Next(ch)
|
|
|
+ ELSE
|
|
|
+ IF ch = "~" THEN Write(0A0X) (* nonbreaking space *)
|
|
|
+ ELSIF ch = "-" THEN Write(0ADX) (* soft hyphen *)
|
|
|
+ ELSIF ch = "_" THEN Write(2011X) (* nonbreaking hyphen *)
|
|
|
+ ELSIF ch = "*" THEN skipDest := TRUE
|
|
|
+ ELSIF (ch = LF) OR (ch = CR) THEN Paragraph
|
|
|
+ ELSIF (ch = "{") OR (ch = "}") OR (ch = "\") THEN Write(ch)
|
|
|
+ END;
|
|
|
+ Next(ch)
|
|
|
+ END
|
|
|
+ ELSIF ch = ";" THEN
|
|
|
+ IF dest = fonttab THEN font := Font(fnum); font.f[idx] := 0X; INC(idx)
|
|
|
+ ELSIF dest = colortab THEN INC(cnum); SetColor(cnum, 0)
|
|
|
+ ELSIF dest = text THEN Write(";")
|
|
|
+ END;
|
|
|
+ Next(ch)
|
|
|
+ ELSIF ch >= " " THEN
|
|
|
+ Write(ch); Next(ch)
|
|
|
+ ELSE
|
|
|
+ Next(ch)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END ParseRichText;
|
|
|
+
|
|
|
+ PROCEDURE ConvertToRichText (in: TextViews.View; beg, end: INTEGER; VAR out: TextModels.Model);
|
|
|
+ VAR r: TextModels.Reader; w: TextMappers.Formatter; ch: CHAR; f: Fonts.Font;
|
|
|
+ attr, attr0: TextModels.Attributes; col: Ports.Color; tf, atf: Fonts.Typeface; p, size, asize, offs: INTEGER;
|
|
|
+ style, astyle: SET; weight, aweight: INTEGER; rattr, rattr0: TextRulers.Attributes; ruler: TextRulers.Ruler;
|
|
|
+ text: TextModels.Model; firstLine, firstLine0: BOOLEAN; fonts: ARRAY 256 OF Fonts.Typeface;
|
|
|
+ colors: ARRAY 256 OF Ports.Color; fnum, cnum, i: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ out := TextModels.dir.New(); w.ConnectTo(out);
|
|
|
+ f := Fonts.dir.Default(); tf := f.typeface;
|
|
|
+ fnum := 1; fonts[0] := tf;
|
|
|
+ cnum := 1; colors[0] := Ports.defaultColor;
|
|
|
+ col := Ports.defaultColor; size := 12 * Ports.point;
|
|
|
+ offs := 0; style := {}; weight := Fonts.normal;
|
|
|
+ attr0 := NIL; rattr0 := NIL; firstLine := TRUE; firstLine0 := FALSE;
|
|
|
+ text := in.ThisModel(); r := text.NewReader(NIL);
|
|
|
+ ruler := TextViews.ThisRuler(in, beg); rattr := ruler.style.attr;
|
|
|
+ r.SetPos(beg); r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot & (r.Pos() <= end) DO
|
|
|
+ attr := r.attr;
|
|
|
+ IF (r.view # NIL) & (r.view IS TextRulers.Ruler) THEN
|
|
|
+ ruler := r.view(TextRulers.Ruler); rattr := ruler.style.attr;
|
|
|
+ firstLine := TRUE
|
|
|
+ ELSIF ch = FF THEN firstLine := TRUE
|
|
|
+ END;
|
|
|
+ IF (rattr # rattr0) OR (firstLine # firstLine0) THEN
|
|
|
+ IF (rattr # rattr0) OR (rattr.first # rattr.left) OR (rattr.lead # 0) OR (TextRulers.pageBreak IN rattr.opts)
|
|
|
+ THEN
|
|
|
+ w.WriteSString("\pard");
|
|
|
+ IF rattr.left # 0 THEN
|
|
|
+ w.WriteSString("\li"); w.WriteInt(rattr.left DIV twips)
|
|
|
+ END;
|
|
|
+ IF firstLine & (rattr.first # rattr.left) THEN
|
|
|
+ w.WriteSString("\fi"); w.WriteInt((rattr.first - rattr.left) DIV twips)
|
|
|
+ END;
|
|
|
+ IF firstLine & (rattr.lead # 0) THEN
|
|
|
+ w.WriteSString("\sb"); w.WriteInt(rattr.lead DIV twips)
|
|
|
+ END;
|
|
|
+ IF rattr.grid > Ports.point THEN
|
|
|
+ w.WriteSString("\sl"); w.WriteInt(rattr.grid DIV twips); w.WriteSString("\slmult1")
|
|
|
+ END;
|
|
|
+ IF {TextRulers.leftAdjust, TextRulers.rightAdjust} - rattr.opts = {} THEN w.WriteSString("\qj")
|
|
|
+ ELSIF TextRulers.rightAdjust IN rattr.opts THEN w.WriteSString("\qr")
|
|
|
+ ELSIF ~(TextRulers.leftAdjust IN rattr.opts) THEN w.WriteSString("\qc")
|
|
|
+ END;
|
|
|
+ IF firstLine & (TextRulers.pageBreak IN rattr.opts) THEN
|
|
|
+ w.WriteSString("\pagebb")
|
|
|
+ END;
|
|
|
+ i := 0;
|
|
|
+ WHILE i < rattr.tabs.len DO
|
|
|
+ IF TextRulers.centerTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tqc") END;
|
|
|
+ IF TextRulers.rightTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tqr") END;
|
|
|
+ IF TextRulers.barTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tb") END;
|
|
|
+ w.WriteSString("\tx"); w.WriteInt(rattr.tabs.tab[i].stop DIV twips);
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ w.WriteChar(" ")
|
|
|
+ END;
|
|
|
+ rattr0 := rattr; firstLine0 := firstLine
|
|
|
+ END;
|
|
|
+ IF attr # attr0 THEN
|
|
|
+ p := w.Pos();
|
|
|
+ IF attr.color # col THEN
|
|
|
+ i := 0; WHILE (i < cnum) & (colors[i] # attr.color) DO INC(i) END;
|
|
|
+ IF i = cnum THEN colors[i] := attr.color; INC(cnum) END;
|
|
|
+ w.WriteSString("\cf"); w.WriteInt(i);
|
|
|
+ col := attr.color
|
|
|
+ END;
|
|
|
+ atf := attr.font.typeface$; asize := attr.font.size; astyle := attr.font.style; aweight := attr.font.weight;
|
|
|
+ IF atf # tf THEN
|
|
|
+ i := 0; WHILE (i < fnum) & (fonts[i] # atf) DO INC(i) END;
|
|
|
+ IF i = fnum THEN fonts[i] := atf; INC(fnum) END;
|
|
|
+ w.WriteSString("\f"); w.WriteInt(i);
|
|
|
+ tf := atf
|
|
|
+ END;
|
|
|
+ IF asize # size THEN
|
|
|
+ w.WriteSString("\fs"); w.WriteInt(asize DIV halfpoint);
|
|
|
+ size := asize
|
|
|
+ END;
|
|
|
+ IF astyle # style THEN
|
|
|
+ IF (Fonts.italic IN astyle) & ~(Fonts.italic IN style) THEN w.WriteSString("\i")
|
|
|
+ ELSIF ~(Fonts.italic IN astyle) & (Fonts.italic IN style) THEN w.WriteSString("\i0")
|
|
|
+ END;
|
|
|
+ IF (Fonts.underline IN astyle) & ~(Fonts.underline IN style) THEN w.WriteSString("\ul")
|
|
|
+ ELSIF ~(Fonts.underline IN astyle) & (Fonts.underline IN style) THEN w.WriteSString("\ul0")
|
|
|
+ END;
|
|
|
+ IF (Fonts.strikeout IN astyle) & ~(Fonts.strikeout IN style) THEN w.WriteSString("\strike")
|
|
|
+ ELSIF ~(Fonts.strikeout IN astyle) & (Fonts.strikeout IN style) THEN w.WriteSString("\strike0")
|
|
|
+ END;
|
|
|
+ style := astyle
|
|
|
+ END;
|
|
|
+ IF aweight # weight THEN
|
|
|
+ IF (aweight > Fonts.normal) & (weight = Fonts.normal) THEN w.WriteSString("\b")
|
|
|
+ ELSIF (aweight = Fonts.normal) & (weight > Fonts.normal) THEN w.WriteSString("\b0")
|
|
|
+ END;
|
|
|
+ weight := aweight
|
|
|
+ END;
|
|
|
+ IF attr.offset # offs THEN
|
|
|
+ IF attr.offset > 0 THEN w.WriteSString("\up"); w.WriteInt(attr.offset DIV halfpoint)
|
|
|
+ ELSIF attr.offset < 0 THEN w.WriteSString("\dn"); w.WriteInt(-(attr.offset DIV halfpoint))
|
|
|
+ ELSIF offs > 0 THEN w.WriteSString("\up0")
|
|
|
+ ELSE w.WriteSString("\dn0")
|
|
|
+ END;
|
|
|
+ offs := attr.offset
|
|
|
+ END;
|
|
|
+ IF w.Pos() # p THEN w.WriteChar(" ") END;
|
|
|
+ attr0 := attr
|
|
|
+ END;
|
|
|
+ IF ch >= 100X THEN
|
|
|
+ IF ch = 2002X THEN w.WriteSString("\enspace ")
|
|
|
+ ELSIF ch = 2003X THEN w.WriteSString("\emspace ")
|
|
|
+ ELSIF ch = 2013X THEN w.WriteSString("\endash ")
|
|
|
+ ELSIF ch = 2014X THEN w.WriteSString("\emdash ")
|
|
|
+ ELSIF ch = 2010X THEN w.WriteChar("-")
|
|
|
+ ELSIF ch = 2011X THEN w.WriteSString("\_")
|
|
|
+ ELSIF ch = 201CX THEN (* unicode: left double quote *) w.WriteSString("\ldblquote ")
|
|
|
+ ELSIF ch = 201DX THEN (* unicode: right double quote *) w.WriteSString("\rdblquote ")
|
|
|
+ ELSIF ch = 2018X THEN (* unicode: left single quote *) w.WriteSString("\lquote ")
|
|
|
+ ELSIF ch = 2019X THEN (* unicode: right single quote *) w.WriteSString("\rquote ")
|
|
|
+ ELSE
|
|
|
+ w.WriteSString("\u"); w.WriteInt(ORD(ch));
|
|
|
+ ch := ThisWndChar(ch);
|
|
|
+ IF ch >= 80X THEN
|
|
|
+ w.WriteSString("\'");
|
|
|
+ w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE)
|
|
|
+ ELSE
|
|
|
+ w.WriteChar(ch)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ CASE ch OF
|
|
|
+ | TAB: w.WriteSString("\tab ")
|
|
|
+ | CR: w.WriteSString("\par "); w.WriteLn; firstLine := FALSE
|
|
|
+ | " ".."[", "]".."z", "|", "~": w.WriteChar(ch)
|
|
|
+ | "\": w.WriteSString("\\")
|
|
|
+ | "{": w.WriteSString("\{")
|
|
|
+ | "}": w.WriteSString("\}")
|
|
|
+ | 8FX: (* digit space *) w.WriteChar(" ")
|
|
|
+ | 90X: (* hyphen *) w.WriteChar("-")
|
|
|
+ | 91X: (* non-breaking hyphen *) w.WriteSString("\_")
|
|
|
+ | 0A0X: (* non-breaking space *) w.WriteSString("\~")
|
|
|
+ | 0ADX: (* soft hyphen *) w.WriteSString("\-")
|
|
|
+ | 0A1X..0ACX, 0AEX..0FFX:
|
|
|
+ w.WriteSString("\'"); w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE)
|
|
|
+ ELSE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END;
|
|
|
+ w.WriteChar("}");
|
|
|
+ (* header *)
|
|
|
+ w.SetPos(0);
|
|
|
+ w.WriteSString("{\rtf1\ansi\ansicpg1252\deff0");
|
|
|
+ w.WriteSString("{\fonttbl"); i := 0;
|
|
|
+ WHILE i < fnum DO
|
|
|
+ IF fonts[i] = Fonts.default THEN fonts[i] := HostFonts.defFont.alias$ END;
|
|
|
+ w.WriteSString("{\f"); w.WriteInt(i); w.WriteSString("\fnil "); w.WriteString(fonts[i]); w.WriteSString(";}");
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ w.WriteChar("}"); w.WriteLn;
|
|
|
+ w.WriteSString("{\colortbl;"); i := 1;
|
|
|
+ WHILE i < cnum DO
|
|
|
+ w.WriteSString("\red"); w.WriteInt(colors[i] MOD 256);
|
|
|
+ w.WriteSString("\green"); w.WriteInt(colors[i] DIV 256 MOD 256);
|
|
|
+ w.WriteSString("\blue"); w.WriteInt(colors[i] DIV 65536 MOD 256);
|
|
|
+ w.WriteChar(";"); INC(i)
|
|
|
+ END;
|
|
|
+ w.WriteChar("}"); w.WriteLn;
|
|
|
+ w.WriteSString("\deftab216 ");
|
|
|
+ w.WriteSString("\plain")
|
|
|
+ END ConvertToRichText;
|
|
|
+
|
|
|
+(*
|
|
|
+ PROCEDURE ImportDText* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
|
|
|
+ OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
|
|
|
+ VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; ch: SHORTCHAR;
|
|
|
+ hnd: WinApi.HANDLE; attr: TextModels.Attributes; p: Properties.StdProp; pref: Properties.BoundsPref;
|
|
|
+ BEGIN
|
|
|
+ hnd := MediumGlobal(med);
|
|
|
+ ASSERT(hnd # 0, 20);
|
|
|
+ adr := WinApi.GlobalLock(hnd);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ IF HostClipboard.cloneAttributes THEN
|
|
|
+ Properties.CollectStdProp(p);
|
|
|
+ NEW(attr); attr.InitFromProp(p);
|
|
|
+ wr.SetAttr(attr)
|
|
|
+ END;
|
|
|
+ SYSTEM.GET(adr, ch);
|
|
|
+ WHILE ch # 0X DO
|
|
|
+ WriteWndChar(wr, ch);
|
|
|
+ INC(adr); SYSTEM.GET(adr, ch)
|
|
|
+ END;
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ v := TextViews.dir.New(t);
|
|
|
+ pref.w := Views.undefined; pref.h := Views.undefined;
|
|
|
+ Views.HandlePropMsg(v, pref);
|
|
|
+ w := pref.w; h := pref.h; isSingle := FALSE
|
|
|
+ END ImportDText;
|
|
|
+
|
|
|
+ PROCEDURE ImportDRichText* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
|
|
|
+ OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
|
|
|
+ VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; rd: MemReader;
|
|
|
+ hnd: WinApi.HANDLE; ruler: TextRulers.Ruler; pref: Properties.BoundsPref;
|
|
|
+ BEGIN
|
|
|
+ IF debug THEN
|
|
|
+ ImportDText(med, v, w, h, isSingle);
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ hnd := MediumGlobal(med);
|
|
|
+ ASSERT(hnd # 0, 20);
|
|
|
+ adr := WinApi.GlobalLock(hnd);
|
|
|
+ NEW(rd); rd.adr := adr; rd.pos := 0;
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ ParseRichText(rd, wr, ruler);
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ v := TextViews.dir.New(t);
|
|
|
+ v(TextViews.View).SetDefaults(ruler, TextModels.dir.attr);
|
|
|
+ pref.w := Views.undefined; pref.h := Views.undefined;
|
|
|
+ Views.HandlePropMsg(v, pref);
|
|
|
+ w := pref.w; h := pref.h; isSingle := FALSE
|
|
|
+ END ImportDRichText;
|
|
|
+
|
|
|
+ PROCEDURE ImportDUnicode* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
|
|
|
+ OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
|
|
|
+ VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; uc: CHAR;
|
|
|
+ hnd: WinApi.HANDLE; attr: TextModels.Attributes; p: Properties.StdProp; pref: Properties.BoundsPref;
|
|
|
+ BEGIN
|
|
|
+ hnd := MediumGlobal(med);
|
|
|
+ ASSERT(hnd # 0, 20);
|
|
|
+ adr := WinApi.GlobalLock(hnd);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ IF HostClipboard.cloneAttributes THEN
|
|
|
+ Properties.CollectStdProp(p);
|
|
|
+ NEW(attr); attr.InitFromProp(p);
|
|
|
+ wr.SetAttr(attr)
|
|
|
+ END;
|
|
|
+ SYSTEM.GET(adr, uc);
|
|
|
+ WHILE uc # 0X DO
|
|
|
+ ASSERT(uc # 0FFFEX, 100);
|
|
|
+ IF uc < 100X THEN WriteWndChar(wr, uc)
|
|
|
+ ELSIF uc # 0FEFFX THEN wr.WriteChar(uc)
|
|
|
+ END;
|
|
|
+ INC(adr, 2); SYSTEM.GET(adr, uc)
|
|
|
+ END;
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ v := TextViews.dir.New(t);
|
|
|
+ pref.w := Views.undefined; pref.h := Views.undefined;
|
|
|
+ Views.HandlePropMsg(v, pref);
|
|
|
+ w := pref.w; h := pref.h; isSingle := FALSE
|
|
|
+ END ImportDUnicode;
|
|
|
+
|
|
|
+ PROCEDURE ExportDText* (
|
|
|
+ v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
|
|
|
+ );
|
|
|
+ VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
|
|
|
+ res, len, adr: INTEGER; hnd: WinApi.HANDLE;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(v # NIL, 20);
|
|
|
+ WITH v: TextViews.View DO
|
|
|
+ t := v.ThisModel();
|
|
|
+ hnd := WinApi.GlobalAlloc({1, 13}, 2 * t.Length() + 1); (* movable, sharable *)
|
|
|
+ IF hnd # 0 THEN
|
|
|
+ adr := WinApi.GlobalLock(hnd); len := 0;
|
|
|
+ r := t.NewReader(NIL); r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
|
|
|
+ ch := ThisWndChar(ch);
|
|
|
+ SYSTEM.PUT(adr, SHORT(ch)); INC(adr); INC(len);
|
|
|
+ IF ch = CR THEN SYSTEM.PUT(adr, LF); INC(adr); INC(len) END
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END;
|
|
|
+ SYSTEM.PUT(adr, 0X); INC(len);
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ hnd := WinApi.GlobalReAlloc(hnd, len, {});
|
|
|
+ GenGlobalMedium(hnd, NIL, med)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ END
|
|
|
+ END ExportDText;
|
|
|
+
|
|
|
+ PROCEDURE ExportDRichText* (
|
|
|
+ v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
|
|
|
+ );
|
|
|
+ VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; res, adr: INTEGER; hnd: WinApi.HANDLE;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(v # NIL, 20);
|
|
|
+ WITH v: TextViews.View DO
|
|
|
+ ConvertToRichText(v, 0, MAX(INTEGER), t);
|
|
|
+ hnd := WinApi.GlobalAlloc({1, 13}, t.Length() + 1); (* movable, sharable *)
|
|
|
+ IF hnd # 0 THEN
|
|
|
+ adr := WinApi.GlobalLock(hnd);
|
|
|
+ r := t.NewReader(NIL); r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ SYSTEM.PUT(adr, SHORT(ch)); INC(adr);
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END;
|
|
|
+ SYSTEM.PUT(adr, 0X);
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ GenGlobalMedium(hnd, NIL, med)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ END
|
|
|
+ END ExportDRichText;
|
|
|
+
|
|
|
+ PROCEDURE ExportDUnicode* (
|
|
|
+ v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
|
|
|
+ );
|
|
|
+ VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; res, len, adr: INTEGER; hnd: WinApi.HANDLE;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(v # NIL, 20);
|
|
|
+ WITH v: TextViews.View DO
|
|
|
+ t := v.ThisModel();
|
|
|
+ hnd := WinApi.GlobalAlloc({1, 13}, 4 * t.Length() + 2); (* movable, sharable *)
|
|
|
+ IF hnd # 0 THEN
|
|
|
+ adr := WinApi.GlobalLock(hnd); len := 0;
|
|
|
+ r := t.NewReader(NIL); r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ IF ch = CR THEN
|
|
|
+ SYSTEM.PUT(adr, LONG(CR)); INC(adr, 2); INC(len, 2);
|
|
|
+ SYSTEM.PUT(adr, LONG(LF)); INC(adr, 2); INC(len, 2)
|
|
|
+ ELSIF (ch >= " ") OR (ch = TAB) THEN
|
|
|
+ IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H) END;
|
|
|
+ SYSTEM.PUT(adr, ch); INC(adr, 2); INC(len, 2)
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END;
|
|
|
+ SYSTEM.PUT(adr, LONG(0X)); INC(len, 2);
|
|
|
+ res := WinApi.GlobalUnlock(hnd);
|
|
|
+ hnd := WinApi.GlobalReAlloc(hnd, len, {});
|
|
|
+ GenGlobalMedium(hnd, NIL, med)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ END
|
|
|
+ END ExportDUnicode;
|
|
|
+*)
|
|
|
+
|
|
|
+ PROCEDURE ImportText* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(f # NIL, 20);
|
|
|
+ r.ConnectTo(f); r.SetPos(0);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ r.ReadSChar(ch);
|
|
|
+ WHILE ~r.rider.eof DO
|
|
|
+ r.ReadSChar(nch);
|
|
|
+ IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
|
|
|
+ ELSIF ch = LF THEN ch := CR
|
|
|
+ END;
|
|
|
+ WriteWndChar(wr, ch); ch := nch
|
|
|
+ END;
|
|
|
+ s := TextViews.dir.New(t)
|
|
|
+ END ImportText;
|
|
|
+
|
|
|
+ PROCEDURE ImportTabText* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(f # NIL, 20);
|
|
|
+ r.ConnectTo(f); r.SetPos(0);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ r.ReadSChar(ch);
|
|
|
+ WHILE ~r.rider.eof DO
|
|
|
+ r.ReadSChar(nch);
|
|
|
+ IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
|
|
|
+ ELSIF ch = LF THEN ch := CR
|
|
|
+ ELSIF (ch = " ") & (nch = " ") THEN ch := TAB; r.ReadSChar(nch)
|
|
|
+ END;
|
|
|
+ WriteWndChar(wr, ch); ch := nch
|
|
|
+ END;
|
|
|
+ s := TextViews.dir.New(t)
|
|
|
+ END ImportTabText;
|
|
|
+
|
|
|
+ PROCEDURE ImportRichText* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR t: TextModels.Model; wr: TextModels.Writer; rd: Files.Reader; ruler: TextRulers.Ruler;
|
|
|
+ BEGIN
|
|
|
+ rd := f.NewReader(NIL); rd.SetPos(0);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ ParseRichText(rd, wr, ruler);
|
|
|
+ s := TextViews.dir.New(t);
|
|
|
+ s(TextViews.View).SetDefaults(ruler, TextModels.dir.attr)
|
|
|
+ END ImportRichText;
|
|
|
+
|
|
|
+ PROCEDURE ImportUnicode* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR r: Stores.Reader; t: TextModels.Model; v: TextViews.View; w: TextModels.Writer;
|
|
|
+ ch0, ch1: SHORTCHAR; len, res: INTEGER; uc: CHAR; rev: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(f # NIL, 20);
|
|
|
+ r.ConnectTo(f); r.SetPos(0);
|
|
|
+ len := f.Length(); rev := FALSE;
|
|
|
+ t := TextModels.dir.New(); w := t.NewWriter(NIL); w.SetPos(0);
|
|
|
+ WHILE len > 0 DO
|
|
|
+ r.ReadSChar(ch0); r.ReadSChar(ch1);
|
|
|
+ IF rev THEN uc := CHR(ORD(ch1) + 256 * ORD(ch0))
|
|
|
+ ELSE uc := CHR(ORD(ch0) + 256 * ORD(ch1))
|
|
|
+ END;
|
|
|
+ DEC(len, 2);
|
|
|
+ IF uc = 0FFFEX THEN rev := ~rev
|
|
|
+ ELSIF uc < 100X THEN WriteWndChar(w, uc)
|
|
|
+ ELSIF uc # 0FEFFX THEN w.WriteChar(uc)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ v := TextViews.dir.New(t);
|
|
|
+ s := v
|
|
|
+ END ImportUnicode;
|
|
|
+
|
|
|
+ PROCEDURE ImportDosText* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
|
|
|
+
|
|
|
+ PROCEDURE ConvertChar (wr: TextModels.Writer; ch: CHAR);
|
|
|
+ (* PC Code Page Mappings M4 (Latin) to Unicode Encoding *)
|
|
|
+ (* Reference: The Unicode Standard, Version 1.0, Vol 1, Addison Wesley, p. 536 *)
|
|
|
+ BEGIN
|
|
|
+ CASE ch OF
|
|
|
+ | CR, TAB, " "..7EX: wr.WriteChar(ch)
|
|
|
+ | LF:
|
|
|
+ | 080X: wr.WriteChar(0C7X)
|
|
|
+ | 081X: wr.WriteChar(0FCX)
|
|
|
+ | 082X: wr.WriteChar(0E9X)
|
|
|
+ | 083X: wr.WriteChar(0E2X)
|
|
|
+ | 084X: wr.WriteChar(0E4X)
|
|
|
+ | 085X: wr.WriteChar(0E0X)
|
|
|
+ | 086X: wr.WriteChar(0E5X)
|
|
|
+ | 087X: wr.WriteChar(0E7X)
|
|
|
+ | 088X: wr.WriteChar(0EAX)
|
|
|
+ | 089X: wr.WriteChar(0EBX)
|
|
|
+ | 08AX: wr.WriteChar(0E8X)
|
|
|
+ | 08BX: wr.WriteChar(0EFX)
|
|
|
+ | 08CX: wr.WriteChar(0EEX)
|
|
|
+ | 08DX: wr.WriteChar(0ECX)
|
|
|
+ | 08EX: wr.WriteChar(0C4X)
|
|
|
+ | 08FX: wr.WriteChar(0C5X)
|
|
|
+ | 090X: wr.WriteChar(0C9X)
|
|
|
+ | 091X: wr.WriteChar(0E6X)
|
|
|
+ | 092X: wr.WriteChar(0C6X)
|
|
|
+ | 093X: wr.WriteChar(0F4X)
|
|
|
+ | 094X: wr.WriteChar(0F6X)
|
|
|
+ | 095X: wr.WriteChar(0F2X)
|
|
|
+ | 096X: wr.WriteChar(0FBX)
|
|
|
+ | 097X: wr.WriteChar(0F9X)
|
|
|
+ | 098X: wr.WriteChar(0FFX)
|
|
|
+ | 099X: wr.WriteChar(0D6X)
|
|
|
+ | 09AX: wr.WriteChar(0DCX)
|
|
|
+ | 09BX: wr.WriteChar(0F8X)
|
|
|
+ | 09CX: wr.WriteChar(0A3X)
|
|
|
+ | 09DX: wr.WriteChar(0D8X)
|
|
|
+ | 09EX: wr.WriteChar(0D7X)
|
|
|
+ | 09FX: wr.WriteChar(0192X)
|
|
|
+ | 0A0X: wr.WriteChar(0E1X)
|
|
|
+ | 0A1X: wr.WriteChar(0EDX)
|
|
|
+ | 0A2X: wr.WriteChar(0F3X)
|
|
|
+ | 0A3X: wr.WriteChar(0FAX)
|
|
|
+ | 0A4X: wr.WriteChar(0F1X)
|
|
|
+ | 0A5X: wr.WriteChar(0D1X)
|
|
|
+ | 0A6X: wr.WriteChar(0AAX)
|
|
|
+ | 0A7X: wr.WriteChar(0BAX)
|
|
|
+ | 0A8X: wr.WriteChar(0BFX)
|
|
|
+ | 0A9X: wr.WriteChar(0AEX)
|
|
|
+ | 0AAX: wr.WriteChar(0ACX)
|
|
|
+ | 0ABX: wr.WriteChar(0BDX)
|
|
|
+ | 0ACX: wr.WriteChar(0BCX)
|
|
|
+ | 0ADX: wr.WriteChar(0A1X)
|
|
|
+ | 0AEX: wr.WriteChar(0ABX)
|
|
|
+ | 0AFX: wr.WriteChar(0BBX)
|
|
|
+ | 0B5X: wr.WriteChar(0C1X)
|
|
|
+ | 0B6X: wr.WriteChar(0C2X)
|
|
|
+ | 0B7X: wr.WriteChar(0C0X)
|
|
|
+ | 0B8X: wr.WriteChar(0A9X)
|
|
|
+ | 0BDX: wr.WriteChar(0A2X)
|
|
|
+ | 0BEX: wr.WriteChar(0A5X)
|
|
|
+ | 0C6X: wr.WriteChar(0E3X)
|
|
|
+ | 0C7X: wr.WriteChar(0C3X)
|
|
|
+ | 0CFX: wr.WriteChar(0A4X)
|
|
|
+ | 0D0X: wr.WriteChar(0F0X)
|
|
|
+ | 0D1X: wr.WriteChar(0D0X)
|
|
|
+ | 0D2X: wr.WriteChar(0CAX)
|
|
|
+ | 0D3X: wr.WriteChar(0CBX)
|
|
|
+ | 0D4X: wr.WriteChar(0C8X)
|
|
|
+ | 0D5X: wr.WriteChar(0131X)
|
|
|
+ | 0D6X: wr.WriteChar(0CDX)
|
|
|
+ | 0D7X: wr.WriteChar(0CEX)
|
|
|
+ | 0D8X: wr.WriteChar(0CFX)
|
|
|
+ | 0DDX: wr.WriteChar(0A6X)
|
|
|
+ | 0DEX: wr.WriteChar(0CCX)
|
|
|
+ | 0E0X: wr.WriteChar(0D3X)
|
|
|
+ | 0E1X: wr.WriteChar(0DFX)
|
|
|
+ | 0E2X: wr.WriteChar(0D4X)
|
|
|
+ | 0E3X: wr.WriteChar(0D2X)
|
|
|
+ | 0E4X: wr.WriteChar(0F5X)
|
|
|
+ | 0E5X: wr.WriteChar(0D5X)
|
|
|
+ | 0E6X: wr.WriteChar(0B5X)
|
|
|
+ | 0E7X: wr.WriteChar(0FEX)
|
|
|
+ | 0E8X: wr.WriteChar(0DEX)
|
|
|
+ | 0E9X: wr.WriteChar(0DAX)
|
|
|
+ | 0EAX: wr.WriteChar(0DBX)
|
|
|
+ | 0EBX: wr.WriteChar(0D9X)
|
|
|
+ | 0ECX: wr.WriteChar(0FDX)
|
|
|
+ | 0EDX: wr.WriteChar(0DDX)
|
|
|
+ | 0EEX: wr.WriteChar(0AFX)
|
|
|
+ | 0EFX: wr.WriteChar(0B4X)
|
|
|
+ | 0F0X: wr.WriteChar(0ADX)
|
|
|
+ | 0F1X: wr.WriteChar(0B1X)
|
|
|
+ | 0F2X: wr.WriteChar(02017X)
|
|
|
+ | 0F3X: wr.WriteChar(0BEX)
|
|
|
+ | 0F4X: wr.WriteChar(0B6X)
|
|
|
+ | 0F5X: wr.WriteChar(0A7X)
|
|
|
+ | 0F6X: wr.WriteChar(0F7X)
|
|
|
+ | 0F7X: wr.WriteChar(0B8X)
|
|
|
+ | 0F8X: wr.WriteChar(0B0X)
|
|
|
+ | 0F9X: wr.WriteChar(0A8X)
|
|
|
+ | 0FAX: wr.WriteChar(0B7X)
|
|
|
+ | 0FBX: wr.WriteChar(0B9X)
|
|
|
+ | 0FCX: wr.WriteChar(0B3X)
|
|
|
+ | 0FDX: wr.WriteChar(0B2X)
|
|
|
+ | 0X..8X, 0BX, 0CX, 0EX..1FX, 7FX,
|
|
|
+ 0B0X..0B4X, 0B9X..0BCX, 0BFX..0C5X, 0C8X..0CEX, 0D9X..0DCX, 0DFX, 0FEX, 0FFX:
|
|
|
+ wr.WriteChar(CHR(0EF00H + ORD(ch)))
|
|
|
+ END
|
|
|
+ END ConvertChar;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ ASSERT(f # NIL, 20);
|
|
|
+ r.ConnectTo(f); r.SetPos(0);
|
|
|
+ t := TextModels.dir.New(); wr := t.NewWriter(NIL);
|
|
|
+ r.ReadSChar(ch);
|
|
|
+ WHILE ~r.rider.eof DO
|
|
|
+ r.ReadSChar(nch);
|
|
|
+ IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
|
|
|
+ ELSIF ch = LF THEN ch := CR
|
|
|
+ END;
|
|
|
+ ConvertChar(wr, ch); ch := nch
|
|
|
+ END;
|
|
|
+ s := TextViews.dir.New(t)
|
|
|
+ END ImportDosText;
|
|
|
+
|
|
|
+ PROCEDURE TextView(s: Stores.Store): Stores.Store;
|
|
|
+ BEGIN
|
|
|
+ IF s IS Views.View THEN RETURN Properties.ThisType(s(Views.View), "TextViews.View")
|
|
|
+ ELSE RETURN NIL
|
|
|
+ END
|
|
|
+ END TextView;
|
|
|
+
|
|
|
+ PROCEDURE ExportText* (s: Stores.Store; f: Files.File);
|
|
|
+ VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
|
|
|
+ s := TextView(s);
|
|
|
+ IF s # NIL THEN
|
|
|
+ w.ConnectTo(f); w.SetPos(0);
|
|
|
+ t := s(TextViews.View).ThisModel();
|
|
|
+ IF t # NIL THEN
|
|
|
+ r := t.NewReader(NIL);
|
|
|
+ r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
|
|
|
+ ch := ThisWndChar(ch);
|
|
|
+ w.WriteSChar(SHORT(ch));
|
|
|
+ IF ch = CR THEN w.WriteSChar(LF) END
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END ExportText;
|
|
|
+
|
|
|
+ PROCEDURE ExportTabText* (s: Stores.Store; f: Files.File);
|
|
|
+ VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
|
|
|
+ s := TextView(s);
|
|
|
+ IF s # NIL THEN
|
|
|
+ w.ConnectTo(f); w.SetPos(0);
|
|
|
+ t := s(TextViews.View).ThisModel();
|
|
|
+ IF t # NIL THEN
|
|
|
+ r := t.NewReader(NIL);
|
|
|
+ r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
|
|
|
+ ch := ThisWndChar(ch);
|
|
|
+ IF ch = CR THEN w.WriteSChar(CR); w.WriteSChar(LF)
|
|
|
+ ELSIF ch = TAB THEN w.WriteSChar(" "); w.WriteSChar(" ")
|
|
|
+ ELSE w.WriteSChar(SHORT(ch))
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END ExportTabText;
|
|
|
+
|
|
|
+ PROCEDURE ExportRichText* (s: Stores.Store; f: Files.File);
|
|
|
+ VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; w: Stores.Writer;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
|
|
|
+ WITH s: TextViews.View DO
|
|
|
+ ConvertToRichText(s, 0, MAX(INTEGER), t);
|
|
|
+ w.ConnectTo(f); w.SetPos(0);
|
|
|
+ r := t.NewReader(NIL); r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ w.WriteSChar(SHORT(ch)); r.ReadChar(ch)
|
|
|
+ END
|
|
|
+(*
|
|
|
+ w.WriteSChar(0X)
|
|
|
+*)
|
|
|
+ ELSE
|
|
|
+ END
|
|
|
+ END ExportRichText;
|
|
|
+
|
|
|
+ PROCEDURE ExportUnicode* (s: Stores.Store; f: Files.File);
|
|
|
+ VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
|
|
|
+ s := TextView(s);
|
|
|
+ IF s # NIL THEN
|
|
|
+ w.ConnectTo(f); w.SetPos(0);
|
|
|
+ w.WriteChar(0FEFFX); (* little endian *)
|
|
|
+ t := s(TextViews.View).ThisModel();
|
|
|
+ IF t # NIL THEN
|
|
|
+ r := t.NewReader(NIL);
|
|
|
+ r.ReadChar(ch);
|
|
|
+ WHILE ~r.eot DO
|
|
|
+ IF ch = CR THEN
|
|
|
+ w.WriteChar(CR); w.WriteChar(LF)
|
|
|
+ ELSIF (ch >= " ") OR (ch = TAB) THEN
|
|
|
+ IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H) END;
|
|
|
+ w.WriteChar(ch)
|
|
|
+ END;
|
|
|
+ r.ReadChar(ch)
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END ExportUnicode;
|
|
|
+
|
|
|
+ PROCEDURE ImportHex* (f: Files.File; OUT s: Stores.Store);
|
|
|
+ VAR r: Stores.Reader; t: TextModels.Model; w: TextMappers.Formatter; ch: SHORTCHAR; a: INTEGER;
|
|
|
+ i: INTEGER; str: ARRAY 17 OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ ASSERT(f # NIL, 20);
|
|
|
+ r.ConnectTo(f); r.SetPos(0);
|
|
|
+ t := TextModels.dir.New();
|
|
|
+ w.ConnectTo(t); w.SetPos(0);
|
|
|
+ r.ReadSChar(ch); a := 0;
|
|
|
+ WHILE ~r.rider.eof DO
|
|
|
+ IF a MOD 16 = 0 THEN
|
|
|
+ w.WriteChar("[");
|
|
|
+ w.WriteIntForm(a, TextMappers.hexadecimal, 8, "0", FALSE);
|
|
|
+ w.WriteSString("]���")
|
|
|
+ END;
|
|
|
+ w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE);
|
|
|
+ IF ch > 20X THEN str[a MOD 16] := ch ELSE str[a MOD 16] := "�" END;
|
|
|
+ INC(a);
|
|
|
+ IF a MOD 16 = 0 THEN
|
|
|
+ str[16] := 0X; w.WriteString("����"); w.WriteString(str);
|
|
|
+ w.WriteLn
|
|
|
+ ELSIF a MOD 4 = 0 THEN
|
|
|
+ w.WriteString("��")
|
|
|
+ ELSE
|
|
|
+ w.WriteChar("�")
|
|
|
+ END;
|
|
|
+ r.ReadSChar(ch)
|
|
|
+ END;
|
|
|
+ IF a MOD 16 # 0 THEN
|
|
|
+ str[a MOD 16] := 0X;
|
|
|
+ i := (16 - a MOD 16) * 3 + (3 - a MOD 16 DIV 4) + 3;
|
|
|
+ WHILE i # 0 DO w.WriteChar("�"); DEC(i) END;
|
|
|
+ w.WriteString(str)
|
|
|
+ END;
|
|
|
+ s := TextViews.dir.New(t)
|
|
|
+ END ImportHex;
|
|
|
+
|
|
|
+END HostTextConv.
|