1 MODULE HostTextConv;
3 (* THIS IS TEXT COPY OF TextConv.odc *)
4 (* DO NOT EDIT *)
6 IMPORT
7 SYSTEM, (* WinApi, WinOle, COM, *)
8 Files, Fonts, Ports, Stores, Views, Properties,
9 HostFonts, (* HostClipboard, *) TextModels,
10 TextRulers, TextViews, TextMappers;
12 CONST
13 CR = 0DX; LF = 0AX; FF = 0EX; TAB = 09X;
14 halfpoint = Ports.point DIV 2;
15 twips = Ports.point DIV 20;
17 TYPE
18 Context = POINTER TO RECORD
19 next: Context;
20 dest: INTEGER;
21 uniCnt : INTEGER;
22 attr: TextModels.Attributes;
23 pattr: TextRulers.Attributes
24 END;
25 MemReader = POINTER TO RECORD (Files.Reader)
26 adr, pos: INTEGER
27 END;
29 VAR
30 debug*: BOOLEAN;
33 (* MemReader *)
35 PROCEDURE (r: MemReader) Base (): Files.File;
36 BEGIN
37 RETURN NIL
38 END Base;
40 PROCEDURE (r: MemReader) Pos (): INTEGER;
41 BEGIN
42 RETURN r.pos
43 END Pos;
45 PROCEDURE (r: MemReader) SetPos (pos: INTEGER);
46 BEGIN
47 r.pos := pos
48 END SetPos;
50 PROCEDURE (r: MemReader) ReadByte (OUT x: BYTE);
51 BEGIN
52 SYSTEM.GET(r.adr + r.pos, x); INC(r.pos)
53 END ReadByte;
55 PROCEDURE (r: MemReader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
56 BEGIN
57 HALT(126)
58 END ReadBytes;
60 (*
61 PROCEDURE GenGlobalMedium (hg: WinApi.HGLOBAL; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
62 BEGIN
63 sm.tymed := WinOle.TYMED_HGLOBAL;
64 sm.u.hGlobal := hg;
65 sm.pUnkForRelease := unk
66 END GenGlobalMedium;
68 PROCEDURE MediumGlobal (VAR sm: WinOle.STGMEDIUM): WinApi.HGLOBAL;
69 BEGIN
70 ASSERT(sm.tymed = WinOle.TYMED_HGLOBAL, 20);
71 RETURN sm.u.hGlobal
72 END MediumGlobal;
73 *)
75 PROCEDURE WriteWndChar (wr: TextModels.Writer; ch: CHAR);
76 BEGIN
77 CASE ch OF
78 | CR, TAB, " "..7EX, 0A0X..0FFX: wr.WriteChar(ch)
79 | LF:
80 | 80X: wr.WriteChar(20ACX) (* euro *)
81 | 82X: wr.WriteChar(201AX)
82 | 83X: wr.WriteChar(0192X)
83 | 84X: wr.WriteChar(201EX)
84 | 85X: wr.WriteChar(2026X)
85 | 86X: wr.WriteChar(2020X)
86 | 87X: wr.WriteChar(2021X)
87 | 88X: wr.WriteChar(02C6X)
88 | 89X: wr.WriteChar(2030X)
89 | 8AX: wr.WriteChar(0160X)
90 | 8BX: wr.WriteChar(2039X)
91 | 8CX: wr.WriteChar(0152X)
92 | 91X: wr.WriteChar(2018X)
93 | 92X: wr.WriteChar(2019X)
94 | 93X: wr.WriteChar(201CX)
95 | 94X: wr.WriteChar(201DX)
96 | 95X: wr.WriteChar(2022X)
97 | 96X: wr.WriteChar(2013X)
98 | 97X: wr.WriteChar(2014X)
99 | 98X: wr.WriteChar(02DCX)
100 | 99X: wr.WriteChar(2122X)
101 | 9AX: wr.WriteChar(0161X)
102 | 9BX: wr.WriteChar(203AX)
103 | 9CX: wr.WriteChar(0153X)
104 | 9FX: wr.WriteChar(0178X)
105 | 0X..8X, 0BX, 0CX, 0EX..1FX, 7FX, 81X, 8DX..90X, 9DX, 9EX:
106 wr.WriteChar(CHR(0EF00H + ORD(ch)))
107 END
108 END WriteWndChar;
110 PROCEDURE ThisWndChar (ch: CHAR): CHAR;
111 BEGIN
112 IF ch >= 100X THEN
113 IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H)
114 ELSIF ch = 20ACX THEN ch := 80X (* euro *)
115 ELSIF ch = 201AX THEN ch := 82X
116 ELSIF ch = 0192X THEN ch := 83X
117 ELSIF ch = 201EX THEN ch := 84X
118 ELSIF ch = 2026X THEN ch := 85X
119 ELSIF ch = 2020X THEN ch := 86X
120 ELSIF ch = 2021X THEN ch := 87X
121 ELSIF ch = 02C6X THEN ch := 88X
122 ELSIF ch = 2030X THEN ch := 89X
123 ELSIF ch = 0160X THEN ch := 8AX
124 ELSIF ch = 2039X THEN ch := 8BX
125 ELSIF ch = 0152X THEN ch := 8CX
126 ELSIF ch = 2018X THEN ch := 91X
127 ELSIF ch = 2019X THEN ch := 92X
128 ELSIF ch = 201CX THEN ch := 93X
129 ELSIF ch = 201DX THEN ch := 94X
130 ELSIF ch = 2022X THEN ch := 95X
131 ELSIF ch = 2013X THEN ch := 96X
132 ELSIF ch = 2014X THEN ch := 97X
133 ELSIF ch = 02DCX THEN ch := 98X
134 ELSIF ch = 2122X THEN ch := 99X
135 ELSIF ch = 0161X THEN ch := 9AX
136 ELSIF ch = 203AX THEN ch := 9BX
137 ELSIF ch = 0153X THEN ch := 9CX
138 ELSIF ch = 0178X THEN ch := 9FX
139 ELSE ch := "?"
140 END
141 ELSIF ch = 08FX THEN ch := " " (* digit space *)
142 END;
143 RETURN ch
144 END ThisWndChar;
146 PROCEDURE ParseRichText (rd: Files.Reader; wr: TextModels.Writer; VAR defRuler: TextRulers.Ruler);
147 TYPE
148 FontInfo = POINTER TO RECORD id: INTEGER; f: Fonts.Typeface; next: FontInfo END;
149 ColorInfo = POINTER TO RECORD id: INTEGER; c: Ports.Color; next: ColorInfo END;
150 CONST text = 0; fonttab = 1; colortab = 2; skip = 3;
151 VAR ch: CHAR; tabStyle: SET;
152 fact, val, defFont, dest, idx, fnum, cnum, paraPos, i: INTEGER;
153 fonts, font: FontInfo; colors: ColorInfo;
154 hasNum, remPar, skipDest: BOOLEAN;
155 f: Fonts.Font; comm: ARRAY 32 OF CHAR;
156 c, con: Context; p0: Properties.Property; p: TextRulers.Prop;
157 ruler: TextRulers.Ruler;
158 pattr: TextRulers.Attributes;
159 skipCnt, uniCnt : INTEGER;
161 PROCEDURE Color(i: INTEGER): ColorInfo;
162 VAR c: ColorInfo;
163 BEGIN
164 ASSERT(colors # NIL, 20);
165 c := colors;
166 WHILE (c # NIL) & (c.id # i) DO c := c.next END;
167 ASSERT(c # NIL, 100);
168 RETURN c
169 END Color;
171 PROCEDURE SetColor(i: INTEGER; c: Ports.Color);
172 VAR ci: ColorInfo;
173 BEGIN
174 NEW(ci); ci.id := i; ci.c := c; ci.next := colors; colors := ci
175 END SetColor;
177 PROCEDURE Font(i: INTEGER): FontInfo;
178 VAR f: FontInfo;
179 BEGIN
180 ASSERT(fonts # NIL, 20);
181 f := fonts;
182 WHILE (f # NIL) & (f.id # i) DO f := f.next END;
183 ASSERT(f # NIL, 100);
184 RETURN f
185 END Font;
187 PROCEDURE SetFont(i: INTEGER; tf: Fonts.Typeface);
188 VAR f: FontInfo;
189 BEGIN
190 NEW(f); f.id := i; f.f := tf; f.next := fonts; fonts := f
191 END SetFont;
193 PROCEDURE Next (VAR ch: CHAR);
194 VAR b: BYTE;
195 BEGIN
196 rd.ReadByte(b); ch := CHR(b MOD 256)
197 END Next;
199 PROCEDURE Write (ch: CHAR);
200 BEGIN
201 IF skipCnt > 0 THEN
202 DEC(skipCnt)
203 ELSIF dest = text THEN
204 IF ch < 100X THEN WriteWndChar(wr, ch)
205 ELSE wr.WriteChar(ch)
206 END
207 ELSIF dest = fonttab THEN
208 ASSERT(font # NIL, 20);
209 font.f[idx] := ch; INC(idx); font.f[idx] := 0X
210 END
211 END Write;
213 PROCEDURE Paragraph;
214 VAR v: Views.View;
215 BEGIN
216 IF ~pattr.Equals(ruler.style.attr) THEN (* new ruler needed *)
217 wr.SetPos(paraPos);
218 v := Views.CopyOf(ruler, Views.deep); ruler := v(TextRulers.Ruler);
219 ruler.style.SetAttr(pattr);
220 wr.WriteView(ruler, Views.undefined, Views.undefined);
221 wr.SetPos(wr.Base().Length())
222 ELSIF (pattr.first # pattr.left)
223 OR (pattr.lead > 0)
224 OR (TextRulers.pageBreak IN pattr.opts) THEN (* paragraph marker needed *)
225 wr.SetPos(paraPos);
226 wr.WriteChar(FF);
227 wr.SetPos(wr.Base().Length())
228 END;
229 wr.WriteChar(CR);
230 paraPos := wr.Pos()
231 END Paragraph;
233 BEGIN
234 defFont := 0; fnum := 1; f := Fonts.dir.Default(); NEW(fonts); fonts.f := f.typeface; skipCnt := 0; uniCnt := 1;
235 cnum := 1; NEW(colors); SetColor(0, Ports.defaultColor);
236 dest := text; con := NIL; paraPos := 0; remPar := FALSE; skipDest := FALSE;
237 defRuler := TextRulers.dir.New(NIL); ruler := defRuler; pattr := defRuler.style.attr; tabStyle := {};
238 Next(ch);
239 WHILE ch # 0X DO
240 IF ch = "{" THEN
241 skipCnt := 0;
242 NEW(c); c.dest := dest; c.attr := wr.attr; c.pattr := pattr; c.uniCnt := uniCnt; c.next := con; con := c;
243 Next(ch)
244 ELSIF ch = "}" THEN
245 skipCnt := 0;
246 IF con # NIL THEN
247 dest := con.dest; uniCnt := con.uniCnt; wr.SetAttr(con.attr); pattr := con.pattr; con := con.next
248 END;
249 Next(ch)
250 ELSIF ch = "\" THEN
251 Next(ch); i := 0; val := 0;
252 IF (ch >= "a") & (ch <= "z") THEN
253 WHILE (ch >= "a") & (ch <= "z") DO comm[i] := ch; INC(i); Next(ch) END;
254 comm[i] := 0X; fact := 1; hasNum := FALSE;
255 IF ch = "-" THEN fact := -1; Next(ch) END;
256 WHILE (ch >= "0") & (ch <= "9") DO
257 val := 10 * val + ORD(ch) - ORD("0"); Next(ch); hasNum := TRUE
258 END;
259 val := val * fact;
260 IF ch = " " THEN Next(ch) END;
261 (* special characters *)
262 IF skipCnt > 0 THEN DEC(skipCnt) (* command skipped as single character *)
263 ELSIF comm = "tab" THEN Write(TAB)
264 ELSIF comm = "line" THEN Write(CR)
265 ELSIF comm = "par" THEN Paragraph
266 ELSIF comm = "sect" THEN Paragraph
267 ELSIF comm = "ldblquote" THEN Write(201CX) (* unicode: left double quote *)
268 ELSIF comm = "rdblquote" THEN Write(201DX) (* unicode: right double quote *)
269 ELSIF comm = "lquote" THEN Write(2018X) (* unicode: left single quote *)
270 ELSIF comm = "rquote" THEN Write(2019X) (* unicode: right single quote *)
271 ELSIF comm = "enspace" THEN Write(2002X) (* unicode: en space *)
272 ELSIF comm = "emspace" THEN Write(2003X) (* unicode: em space *)
273 ELSIF comm = "endash" THEN Write(2013X) (* unicode: en dash *)
274 ELSIF comm = "emdash" THEN Write(2014X) (* unicode: em dash *)
275 ELSIF comm = "page" THEN
276 Paragraph; NEW(p);
277 p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.pageBreak}; p.opts.mask := p.opts.val;
278 pattr := TextRulers.ModifiedAttr(pattr, p)
279 (* character attributes *)
280 ELSIF comm = "plain" THEN
281 wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.normal));
282 wr.SetAttr(TextModels.NewStyle(wr.attr, {}));
283 wr.SetAttr(TextModels.NewTypeface(wr.attr, Font(defFont).f));
284 wr.SetAttr(TextModels.NewSize(wr.attr, 24 * halfpoint));
285 wr.SetAttr(TextModels.NewColor(wr.attr, Ports.defaultColor));
286 wr.SetAttr(TextModels.NewOffset(wr.attr, 0))
287 ELSIF comm = "b" THEN
288 IF hasNum & (val = 0) THEN wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.normal))
289 ELSE wr.SetAttr(TextModels.NewWeight(wr.attr, Fonts.bold))
290 END
291 ELSIF comm = "i" THEN
292 IF hasNum & (val = 0) THEN
293 wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.italic}))
294 ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.italic}))
295 END
296 ELSIF comm = "ul" THEN
297 IF hasNum & (val = 0) THEN
298 wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.underline}))
299 ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.underline}))
300 END
301 ELSIF comm = "strike" THEN
302 IF hasNum & (val = 0) THEN
303 wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style - {Fonts.strikeout}))
304 ELSE wr.SetAttr(TextModels.NewStyle(wr.attr, wr.attr.font.style + {Fonts.strikeout}))
305 END
306 ELSIF comm = "f" THEN
307 IF ~hasNum THEN val := defFont END;
308 IF dest = fonttab THEN
309 fnum := val; idx := 0; NEW(font); font.id := val; font.next := fonts; fonts := font
310 ELSE
311 wr.SetAttr(TextModels.NewTypeface(wr.attr, Font(val).f))
312 END
313 ELSIF comm = "fs" THEN
314 IF ~hasNum THEN val := 24 END;
315 wr.SetAttr(TextModels.NewSize(wr.attr, val * halfpoint))
316 ELSIF comm = "cf" THEN
317 wr.SetAttr(TextModels.NewColor(wr.attr, Color(val).c))
318 ELSIF comm = "dn" THEN
319 IF ~hasNum THEN val := 6 END;
320 wr.SetAttr(TextModels.NewOffset(wr.attr, -(val * halfpoint)))
321 ELSIF comm = "up" THEN
322 IF ~hasNum THEN val := 6 END;
323 wr.SetAttr(TextModels.NewOffset(wr.attr, val * halfpoint))
324 (* paragraph attributes *)
325 ELSIF comm = "pard" THEN
326 pattr := defRuler.style.attr; tabStyle := {}
327 ELSIF comm = "fi" THEN
328 NEW(p);
329 p.valid := {TextRulers.first}; p.first := pattr.left + val * twips;
330 IF p.first < 0 THEN (* change left indent to make the value legal *)
331 p.valid := {TextRulers.left, TextRulers.first};
332 p.left := pattr.left - p.first; p.first := 0
333 END;
334 pattr := TextRulers.ModifiedAttr(pattr, p)
335 ELSIF comm = "li" THEN
336 NEW(p);
337 p.valid := {TextRulers.left, TextRulers.first};
338 p.left := val * twips; p.first := p.left + pattr.first - pattr.left;
339 pattr := TextRulers.ModifiedAttr(pattr, p)
340 ELSIF comm = "ql" THEN
341 NEW(p);
342 p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.leftAdjust};
343 p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
344 pattr := TextRulers.ModifiedAttr(pattr, p)
345 ELSIF comm = "qr" THEN
346 NEW(p);
347 p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.rightAdjust};
348 p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
349 pattr := TextRulers.ModifiedAttr(pattr, p)
350 ELSIF comm = "qc" THEN
351 NEW(p);
352 p.valid := {TextRulers.opts}; p.opts.val := {};
353 p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
354 pattr := TextRulers.ModifiedAttr(pattr, p)
355 ELSIF comm = "qj" THEN
356 NEW(p);
357 p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.leftAdjust, TextRulers.rightAdjust};
358 p.opts.mask := {TextRulers.leftAdjust, TextRulers.rightAdjust};
359 pattr := TextRulers.ModifiedAttr(pattr, p)
360 ELSIF comm = "sb" THEN
361 NEW(p);
362 p.valid := {TextRulers.lead}; p.lead := val * twips;
363 pattr := TextRulers.ModifiedAttr(pattr, p)
364 ELSIF comm = "sl" THEN
365 NEW(p);
366 p.valid := {TextRulers.grid}; p.grid := val * twips;
367 pattr := TextRulers.ModifiedAttr(pattr, p)
368 ELSIF comm = "tqc" THEN
369 tabStyle := {TextRulers.centerTab}
370 ELSIF (comm = "tqr") OR (comm="tqdec") THEN
371 tabStyle := {TextRulers.rightTab}
372 ELSIF comm = "tb" THEN
373 p0 := pattr.Prop(); p := p0(TextRulers.Prop);
374 p.valid := {TextRulers.tabs};
375 p.tabs.tab[p.tabs.len].stop := val * twips;
376 p.tabs.tab[p.tabs.len].type := {TextRulers.barTab}; tabStyle := {};
377 INC(p.tabs.len);
378 pattr := TextRulers.ModifiedAttr(pattr, p)
379 ELSIF comm = "tx" THEN
380 p0 := pattr.Prop(); p := p0(TextRulers.Prop);
381 p.valid := {TextRulers.tabs};
382 p.tabs.tab[p.tabs.len].stop := val * twips;
383 p.tabs.tab[p.tabs.len].type := tabStyle; tabStyle := {};
384 INC(p.tabs.len);
385 pattr := TextRulers.ModifiedAttr(pattr, p)
386 ELSIF comm = "pagebb" THEN
387 NEW(p);
388 p.valid := {TextRulers.opts}; p.opts.val := {TextRulers.pageBreak}; p.opts.mask := p.opts.val;
389 pattr := TextRulers.ModifiedAttr(pattr, p)
390 (* header *)
391 ELSIF comm = "deff" THEN
392 IF hasNum THEN defFont := val END
393 ELSIF comm = "fonttbl" THEN
394 IF dest # skip THEN dest := fonttab END
395 ELSIF comm = "colortbl" THEN
396 IF dest # skip THEN dest := colortab; cnum := 0; SetColor(0, 0) END
397 ELSIF comm = "red" THEN
398 IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256) END
399 ELSIF comm = "green" THEN
400 IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256 * 256) END
401 ELSIF comm = "blue" THEN
402 IF dest = colortab THEN SetColor(cnum, Color(cnum).c + val MOD 256 * 65536) END
403 ELSIF comm = "rtf" THEN
404 ELSIF comm = "ansi" THEN
405 ELSIF comm = "lang" THEN
406 ELSIF comm = "langfe" THEN
407 ELSIF comm = "loch" THEN
408 ELSIF comm = "ltrch" THEN
409 ELSIF comm = "rtlch" THEN
410 ELSIF comm = "ansicpg" THEN
411 (* misc *)
412 ELSIF comm = "bin" THEN rd.SetPos(rd.Pos() + val - 1); Next(ch)
413 (* unicode *)
414 ELSIF comm = "u" THEN Write(CHR(val)); skipCnt := uniCnt
415 ELSIF comm = "uc" THEN IF hasNum THEN uniCnt := val END
416 ELSIF comm = "upr" THEN dest := skip (* skip ANSI part *)
417 ELSIF comm = "ud" THEN dest := text (* use Unicode part *)
418 (* unhandled destinations *)
419 ELSIF comm = "author" THEN dest := skip
420 ELSIF comm = "buptim" THEN dest := skip
421 ELSIF comm = "comment" THEN dest := skip
422 ELSIF comm = "creatim" THEN dest := skip
423 ELSIF comm = "doccomm" THEN dest := skip
424 ELSIF comm = "footer" THEN dest := skip
425 ELSIF comm = "footerl" THEN dest := skip
426 ELSIF comm = "footerr" THEN dest := skip
427 ELSIF comm = "footerf" THEN dest := skip
428 ELSIF comm = "footnote" THEN dest := skip
429 ELSIF comm = "ftnsep" THEN dest := skip
430 ELSIF comm = "ftnsepc" THEN dest := skip
431 ELSIF comm = "ftncn" THEN dest := skip
432 ELSIF comm = "header" THEN dest := skip
433 ELSIF comm = "headerl" THEN dest := skip
434 ELSIF comm = "headerr" THEN dest := skip
435 ELSIF comm = "headerf" THEN dest := skip
436 ELSIF comm = "info" THEN dest := skip
437 ELSIF comm = "keywords" THEN dest := skip
438 ELSIF comm = "object" THEN dest := skip
439 ELSIF comm = "operator" THEN dest := skip
440 ELSIF comm = "pict" THEN dest := skip
441 ELSIF comm = "printim" THEN dest := skip
442 ELSIF comm = "private1" THEN dest := skip
443 ELSIF comm = "revtim" THEN dest := skip
444 ELSIF comm = "rxe" THEN dest := skip
445 ELSIF comm = "stylesheet" THEN dest := skip
446 ELSIF comm = "subject" THEN dest := skip
447 ELSIF comm = "tc" THEN dest := skip
448 ELSIF comm = "title" THEN dest := skip
449 ELSIF comm = "txe" THEN dest := skip
450 ELSIF comm = "xe" THEN dest := skip
451 ELSE (* unknown *)
452 IF skipDest & (con # NIL) & (con.next # NIL) THEN dest := skip END
453 END;
454 skipDest := FALSE
455 ELSIF ch = "'" THEN
456 Next(ch);
457 IF ch <= "9" THEN val := ORD(ch) - ORD("0") ELSE val := ORD(CAP(ch)) - ORD("A") + 10 END;
458 Next(ch);
459 IF ch <= "9" THEN val := 16 * val + ORD(ch) - ORD("0")
460 ELSE val := 16 * val + ORD(CAP(ch)) - ORD("A") + 10
461 END;
462 Write(CHR(val)); Next(ch)
463 ELSE
464 IF ch = "~" THEN Write(0A0X) (* nonbreaking space *)
465 ELSIF ch = "-" THEN Write(0ADX) (* soft hyphen *)
466 ELSIF ch = "_" THEN Write(2011X) (* nonbreaking hyphen *)
467 ELSIF ch = "*" THEN skipDest := TRUE
468 ELSIF (ch = LF) OR (ch = CR) THEN Paragraph
469 ELSIF (ch = "{") OR (ch = "}") OR (ch = "\") THEN Write(ch)
470 END;
471 Next(ch)
472 END
473 ELSIF ch = ";" THEN
474 IF dest = fonttab THEN font := Font(fnum); font.f[idx] := 0X; INC(idx)
475 ELSIF dest = colortab THEN INC(cnum); SetColor(cnum, 0)
476 ELSIF dest = text THEN Write(";")
477 END;
478 Next(ch)
479 ELSIF ch >= " " THEN
480 Write(ch); Next(ch)
481 ELSE
482 Next(ch)
483 END
484 END
485 END ParseRichText;
487 PROCEDURE ConvertToRichText (in: TextViews.View; beg, end: INTEGER; VAR out: TextModels.Model);
488 VAR r: TextModels.Reader; w: TextMappers.Formatter; ch: CHAR; f: Fonts.Font;
489 attr, attr0: TextModels.Attributes; col: Ports.Color; tf, atf: Fonts.Typeface; p, size, asize, offs: INTEGER;
490 style, astyle: SET; weight, aweight: INTEGER; rattr, rattr0: TextRulers.Attributes; ruler: TextRulers.Ruler;
491 text: TextModels.Model; firstLine, firstLine0: BOOLEAN; fonts: ARRAY 256 OF Fonts.Typeface;
492 colors: ARRAY 256 OF Ports.Color; fnum, cnum, i: INTEGER;
493 BEGIN
494 out := TextModels.dir.New(); w.ConnectTo(out);
495 f := Fonts.dir.Default(); tf := f.typeface;
496 fnum := 1; fonts[0] := tf;
497 cnum := 1; colors[0] := Ports.defaultColor;
498 col := Ports.defaultColor; size := 12 * Ports.point;
499 offs := 0; style := {}; weight := Fonts.normal;
500 attr0 := NIL; rattr0 := NIL; firstLine := TRUE; firstLine0 := FALSE;
501 text := in.ThisModel(); r := text.NewReader(NIL);
502 ruler := TextViews.ThisRuler(in, beg); rattr := ruler.style.attr;
503 r.SetPos(beg); r.ReadChar(ch);
504 WHILE ~r.eot & (r.Pos() <= end) DO
505 attr := r.attr;
506 IF (r.view # NIL) & (r.view IS TextRulers.Ruler) THEN
507 ruler := r.view(TextRulers.Ruler); rattr := ruler.style.attr;
508 firstLine := TRUE
509 ELSIF ch = FF THEN firstLine := TRUE
510 END;
511 IF (rattr # rattr0) OR (firstLine # firstLine0) THEN
512 IF (rattr # rattr0) OR (rattr.first # rattr.left) OR (rattr.lead # 0) OR (TextRulers.pageBreak IN rattr.opts)
513 THEN
514 w.WriteSString("\pard");
515 IF rattr.left # 0 THEN
516 w.WriteSString("\li"); w.WriteInt(rattr.left DIV twips)
517 END;
518 IF firstLine & (rattr.first # rattr.left) THEN
519 w.WriteSString("\fi"); w.WriteInt((rattr.first - rattr.left) DIV twips)
520 END;
521 IF firstLine & (rattr.lead # 0) THEN
522 w.WriteSString("\sb"); w.WriteInt(rattr.lead DIV twips)
523 END;
524 IF rattr.grid > Ports.point THEN
525 w.WriteSString("\sl"); w.WriteInt(rattr.grid DIV twips); w.WriteSString("\slmult1")
526 END;
527 IF {TextRulers.leftAdjust, TextRulers.rightAdjust} - rattr.opts = {} THEN w.WriteSString("\qj")
528 ELSIF TextRulers.rightAdjust IN rattr.opts THEN w.WriteSString("\qr")
529 ELSIF ~(TextRulers.leftAdjust IN rattr.opts) THEN w.WriteSString("\qc")
530 END;
531 IF firstLine & (TextRulers.pageBreak IN rattr.opts) THEN
532 w.WriteSString("\pagebb")
533 END;
534 i := 0;
535 WHILE i < rattr.tabs.len DO
536 IF TextRulers.centerTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tqc") END;
537 IF TextRulers.rightTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tqr") END;
538 IF TextRulers.barTab IN rattr.tabs.tab[i].type THEN w.WriteSString("\tb") END;
539 w.WriteSString("\tx"); w.WriteInt(rattr.tabs.tab[i].stop DIV twips);
540 INC(i)
541 END;
542 w.WriteChar(" ")
543 END;
544 rattr0 := rattr; firstLine0 := firstLine
545 END;
546 IF attr # attr0 THEN
547 p := w.Pos();
548 IF attr.color # col THEN
549 i := 0; WHILE (i < cnum) & (colors[i] # attr.color) DO INC(i) END;
550 IF i = cnum THEN colors[i] := attr.color; INC(cnum) END;
551 w.WriteSString("\cf"); w.WriteInt(i);
552 col := attr.color
553 END;
554 atf := attr.font.typeface$; asize := attr.font.size; astyle := attr.font.style; aweight := attr.font.weight;
555 IF atf # tf THEN
556 i := 0; WHILE (i < fnum) & (fonts[i] # atf) DO INC(i) END;
557 IF i = fnum THEN fonts[i] := atf; INC(fnum) END;
558 w.WriteSString("\f"); w.WriteInt(i);
559 tf := atf
560 END;
561 IF asize # size THEN
562 w.WriteSString("\fs"); w.WriteInt(asize DIV halfpoint);
563 size := asize
564 END;
565 IF astyle # style THEN
566 IF (Fonts.italic IN astyle) & ~(Fonts.italic IN style) THEN w.WriteSString("\i")
567 ELSIF ~(Fonts.italic IN astyle) & (Fonts.italic IN style) THEN w.WriteSString("\i0")
568 END;
569 IF (Fonts.underline IN astyle) & ~(Fonts.underline IN style) THEN w.WriteSString("\ul")
570 ELSIF ~(Fonts.underline IN astyle) & (Fonts.underline IN style) THEN w.WriteSString("\ul0")
571 END;
572 IF (Fonts.strikeout IN astyle) & ~(Fonts.strikeout IN style) THEN w.WriteSString("\strike")
573 ELSIF ~(Fonts.strikeout IN astyle) & (Fonts.strikeout IN style) THEN w.WriteSString("\strike0")
574 END;
575 style := astyle
576 END;
577 IF aweight # weight THEN
578 IF (aweight > Fonts.normal) & (weight = Fonts.normal) THEN w.WriteSString("\b")
579 ELSIF (aweight = Fonts.normal) & (weight > Fonts.normal) THEN w.WriteSString("\b0")
580 END;
581 weight := aweight
582 END;
583 IF attr.offset # offs THEN
584 IF attr.offset > 0 THEN w.WriteSString("\up"); w.WriteInt(attr.offset DIV halfpoint)
585 ELSIF attr.offset < 0 THEN w.WriteSString("\dn"); w.WriteInt(-(attr.offset DIV halfpoint))
586 ELSIF offs > 0 THEN w.WriteSString("\up0")
587 ELSE w.WriteSString("\dn0")
588 END;
589 offs := attr.offset
590 END;
591 IF w.Pos() # p THEN w.WriteChar(" ") END;
592 attr0 := attr
593 END;
594 IF ch >= 100X THEN
595 IF ch = 2002X THEN w.WriteSString("\enspace ")
596 ELSIF ch = 2003X THEN w.WriteSString("\emspace ")
597 ELSIF ch = 2013X THEN w.WriteSString("\endash ")
598 ELSIF ch = 2014X THEN w.WriteSString("\emdash ")
599 ELSIF ch = 2010X THEN w.WriteChar("-")
600 ELSIF ch = 2011X THEN w.WriteSString("\_")
601 ELSIF ch = 201CX THEN (* unicode: left double quote *) w.WriteSString("\ldblquote ")
602 ELSIF ch = 201DX THEN (* unicode: right double quote *) w.WriteSString("\rdblquote ")
603 ELSIF ch = 2018X THEN (* unicode: left single quote *) w.WriteSString("\lquote ")
604 ELSIF ch = 2019X THEN (* unicode: right single quote *) w.WriteSString("\rquote ")
605 ELSE
606 w.WriteSString("\u"); w.WriteInt(ORD(ch));
607 ch := ThisWndChar(ch);
608 IF ch >= 80X THEN
609 w.WriteSString("\'");
610 w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE)
611 ELSE
612 w.WriteChar(ch)
613 END
614 END
615 ELSE
616 CASE ch OF
617 | TAB: w.WriteSString("\tab ")
618 | CR: w.WriteSString("\par "); w.WriteLn; firstLine := FALSE
619 | " ".."[", "]".."z", "|", "~": w.WriteChar(ch)
620 | "\": w.WriteSString("\\")
621 | "{": w.WriteSString("\{")
622 | "}": w.WriteSString("\}")
623 | 8FX: (* digit space *) w.WriteChar(" ")
624 | 90X: (* hyphen *) w.WriteChar("-")
625 | 91X: (* non-breaking hyphen *) w.WriteSString("\_")
626 | 0A0X: (* non-breaking space *) w.WriteSString("\~")
627 | 0ADX: (* soft hyphen *) w.WriteSString("\-")
628 | 0A1X..0ACX, 0AEX..0FFX:
629 w.WriteSString("\'"); w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE)
630 ELSE
631 END
632 END;
633 r.ReadChar(ch)
634 END;
635 w.WriteChar("}");
636 (* header *)
637 w.SetPos(0);
638 w.WriteSString("{\rtf1\ansi\ansicpg1252\deff0");
639 w.WriteSString("{\fonttbl"); i := 0;
640 WHILE i < fnum DO
641 IF fonts[i] = Fonts.default THEN fonts[i] := HostFonts.defFont.alias$ END;
642 w.WriteSString("{\f"); w.WriteInt(i); w.WriteSString("\fnil "); w.WriteString(fonts[i]); w.WriteSString(";}");
643 INC(i)
644 END;
645 w.WriteChar("}"); w.WriteLn;
646 w.WriteSString("{\colortbl;"); i := 1;
647 WHILE i < cnum DO
648 w.WriteSString("\red"); w.WriteInt(colors[i] MOD 256);
649 w.WriteSString("\green"); w.WriteInt(colors[i] DIV 256 MOD 256);
650 w.WriteSString("\blue"); w.WriteInt(colors[i] DIV 65536 MOD 256);
651 w.WriteChar(";"); INC(i)
652 END;
653 w.WriteChar("}"); w.WriteLn;
654 w.WriteSString("\deftab216 ");
655 w.WriteSString("\plain")
656 END ConvertToRichText;
658 (*
659 PROCEDURE ImportDText* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
660 OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
661 VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; ch: SHORTCHAR;
662 hnd: WinApi.HANDLE; attr: TextModels.Attributes; p: Properties.StdProp; pref: Properties.BoundsPref;
663 BEGIN
664 hnd := MediumGlobal(med);
665 ASSERT(hnd # 0, 20);
666 adr := WinApi.GlobalLock(hnd);
667 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
668 IF HostClipboard.cloneAttributes THEN
669 Properties.CollectStdProp(p);
670 NEW(attr); attr.InitFromProp(p);
671 wr.SetAttr(attr)
672 END;
673 SYSTEM.GET(adr, ch);
674 WHILE ch # 0X DO
675 WriteWndChar(wr, ch);
676 INC(adr); SYSTEM.GET(adr, ch)
677 END;
678 res := WinApi.GlobalUnlock(hnd);
679 v := TextViews.dir.New(t);
680 pref.w := Views.undefined; pref.h := Views.undefined;
681 Views.HandlePropMsg(v, pref);
682 w := pref.w; h := pref.h; isSingle := FALSE
683 END ImportDText;
685 PROCEDURE ImportDRichText* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
686 OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
687 VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; rd: MemReader;
688 hnd: WinApi.HANDLE; ruler: TextRulers.Ruler; pref: Properties.BoundsPref;
689 BEGIN
690 IF debug THEN
691 ImportDText(med, v, w, h, isSingle);
692 RETURN
693 END;
694 hnd := MediumGlobal(med);
695 ASSERT(hnd # 0, 20);
696 adr := WinApi.GlobalLock(hnd);
697 NEW(rd); rd.adr := adr; rd.pos := 0;
698 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
699 ParseRichText(rd, wr, ruler);
700 res := WinApi.GlobalUnlock(hnd);
701 v := TextViews.dir.New(t);
702 v(TextViews.View).SetDefaults(ruler, TextModels.dir.attr);
703 pref.w := Views.undefined; pref.h := Views.undefined;
704 Views.HandlePropMsg(v, pref);
705 w := pref.w; h := pref.h; isSingle := FALSE
706 END ImportDRichText;
708 PROCEDURE ImportDUnicode* (VAR med: WinOle.STGMEDIUM; OUT v: Views.View;
709 OUT w, h: INTEGER; OUT isSingle: BOOLEAN);
710 VAR t: TextModels.Model; res, adr: INTEGER; wr: TextModels.Writer; uc: CHAR;
711 hnd: WinApi.HANDLE; attr: TextModels.Attributes; p: Properties.StdProp; pref: Properties.BoundsPref;
712 BEGIN
713 hnd := MediumGlobal(med);
714 ASSERT(hnd # 0, 20);
715 adr := WinApi.GlobalLock(hnd);
716 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
717 IF HostClipboard.cloneAttributes THEN
718 Properties.CollectStdProp(p);
719 NEW(attr); attr.InitFromProp(p);
720 wr.SetAttr(attr)
721 END;
722 SYSTEM.GET(adr, uc);
723 WHILE uc # 0X DO
724 ASSERT(uc # 0FFFEX, 100);
725 IF uc < 100X THEN WriteWndChar(wr, uc)
726 ELSIF uc # 0FEFFX THEN wr.WriteChar(uc)
727 END;
728 INC(adr, 2); SYSTEM.GET(adr, uc)
729 END;
730 res := WinApi.GlobalUnlock(hnd);
731 v := TextViews.dir.New(t);
732 pref.w := Views.undefined; pref.h := Views.undefined;
733 Views.HandlePropMsg(v, pref);
734 w := pref.w; h := pref.h; isSingle := FALSE
735 END ImportDUnicode;
737 PROCEDURE ExportDText* (
738 v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
739 );
740 VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
741 res, len, adr: INTEGER; hnd: WinApi.HANDLE;
742 BEGIN
743 ASSERT(v # NIL, 20);
744 WITH v: TextViews.View DO
745 t := v.ThisModel();
746 hnd := WinApi.GlobalAlloc({1, 13}, 2 * t.Length() + 1); (* movable, sharable *)
747 IF hnd # 0 THEN
748 adr := WinApi.GlobalLock(hnd); len := 0;
749 r := t.NewReader(NIL); r.ReadChar(ch);
750 WHILE ~r.eot DO
751 IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
752 ch := ThisWndChar(ch);
753 SYSTEM.PUT(adr, SHORT(ch)); INC(adr); INC(len);
754 IF ch = CR THEN SYSTEM.PUT(adr, LF); INC(adr); INC(len) END
755 END;
756 r.ReadChar(ch)
757 END;
758 SYSTEM.PUT(adr, 0X); INC(len);
759 res := WinApi.GlobalUnlock(hnd);
760 hnd := WinApi.GlobalReAlloc(hnd, len, {});
761 GenGlobalMedium(hnd, NIL, med)
762 END
763 ELSE
764 END
765 END ExportDText;
767 PROCEDURE ExportDRichText* (
768 v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
769 );
770 VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; res, adr: INTEGER; hnd: WinApi.HANDLE;
771 BEGIN
772 ASSERT(v # NIL, 20);
773 WITH v: TextViews.View DO
774 ConvertToRichText(v, 0, MAX(INTEGER), t);
775 hnd := WinApi.GlobalAlloc({1, 13}, t.Length() + 1); (* movable, sharable *)
776 IF hnd # 0 THEN
777 adr := WinApi.GlobalLock(hnd);
778 r := t.NewReader(NIL); r.ReadChar(ch);
779 WHILE ~r.eot DO
780 SYSTEM.PUT(adr, SHORT(ch)); INC(adr);
781 r.ReadChar(ch)
782 END;
783 SYSTEM.PUT(adr, 0X);
784 res := WinApi.GlobalUnlock(hnd);
785 GenGlobalMedium(hnd, NIL, med)
786 END
787 ELSE
788 END
789 END ExportDRichText;
791 PROCEDURE ExportDUnicode* (
792 v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM
793 );
794 VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; res, len, adr: INTEGER; hnd: WinApi.HANDLE;
795 BEGIN
796 ASSERT(v # NIL, 20);
797 WITH v: TextViews.View DO
798 t := v.ThisModel();
799 hnd := WinApi.GlobalAlloc({1, 13}, 4 * t.Length() + 2); (* movable, sharable *)
800 IF hnd # 0 THEN
801 adr := WinApi.GlobalLock(hnd); len := 0;
802 r := t.NewReader(NIL); r.ReadChar(ch);
803 WHILE ~r.eot DO
804 IF ch = CR THEN
805 SYSTEM.PUT(adr, LONG(CR)); INC(adr, 2); INC(len, 2);
806 SYSTEM.PUT(adr, LONG(LF)); INC(adr, 2); INC(len, 2)
807 ELSIF (ch >= " ") OR (ch = TAB) THEN
808 IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H) END;
809 SYSTEM.PUT(adr, ch); INC(adr, 2); INC(len, 2)
810 END;
811 r.ReadChar(ch)
812 END;
813 SYSTEM.PUT(adr, LONG(0X)); INC(len, 2);
814 res := WinApi.GlobalUnlock(hnd);
815 hnd := WinApi.GlobalReAlloc(hnd, len, {});
816 GenGlobalMedium(hnd, NIL, med)
817 END
818 ELSE
819 END
820 END ExportDUnicode;
821 *)
823 PROCEDURE ImportText* (f: Files.File; OUT s: Stores.Store);
824 VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
825 BEGIN
826 ASSERT(f # NIL, 20);
827 r.ConnectTo(f); r.SetPos(0);
828 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
829 r.ReadSChar(ch);
830 WHILE ~r.rider.eof DO
831 r.ReadSChar(nch);
832 IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
833 ELSIF ch = LF THEN ch := CR
834 END;
835 WriteWndChar(wr, ch); ch := nch
836 END;
837 s := TextViews.dir.New(t)
838 END ImportText;
840 PROCEDURE ImportTabText* (f: Files.File; OUT s: Stores.Store);
841 VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
842 BEGIN
843 ASSERT(f # NIL, 20);
844 r.ConnectTo(f); r.SetPos(0);
845 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
846 r.ReadSChar(ch);
847 WHILE ~r.rider.eof DO
848 r.ReadSChar(nch);
849 IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
850 ELSIF ch = LF THEN ch := CR
851 ELSIF (ch = " ") & (nch = " ") THEN ch := TAB; r.ReadSChar(nch)
852 END;
853 WriteWndChar(wr, ch); ch := nch
854 END;
855 s := TextViews.dir.New(t)
856 END ImportTabText;
858 PROCEDURE ImportRichText* (f: Files.File; OUT s: Stores.Store);
859 VAR t: TextModels.Model; wr: TextModels.Writer; rd: Files.Reader; ruler: TextRulers.Ruler;
860 BEGIN
861 rd := f.NewReader(NIL); rd.SetPos(0);
862 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
863 ParseRichText(rd, wr, ruler);
864 s := TextViews.dir.New(t);
865 s(TextViews.View).SetDefaults(ruler, TextModels.dir.attr)
866 END ImportRichText;
868 PROCEDURE ImportUnicode* (f: Files.File; OUT s: Stores.Store);
869 VAR r: Stores.Reader; t: TextModels.Model; v: TextViews.View; w: TextModels.Writer;
870 ch0, ch1: SHORTCHAR; len, res: INTEGER; uc: CHAR; rev: BOOLEAN;
871 BEGIN
872 ASSERT(f # NIL, 20);
873 r.ConnectTo(f); r.SetPos(0);
874 len := f.Length(); rev := FALSE;
875 t := TextModels.dir.New(); w := t.NewWriter(NIL); w.SetPos(0);
876 WHILE len > 0 DO
877 r.ReadSChar(ch0); r.ReadSChar(ch1);
878 IF rev THEN uc := CHR(ORD(ch1) + 256 * ORD(ch0))
879 ELSE uc := CHR(ORD(ch0) + 256 * ORD(ch1))
880 END;
881 DEC(len, 2);
882 IF uc = 0FFFEX THEN rev := ~rev
883 ELSIF uc < 100X THEN WriteWndChar(w, uc)
884 ELSIF uc # 0FEFFX THEN w.WriteChar(uc)
885 END
886 END;
887 v := TextViews.dir.New(t);
888 s := v
889 END ImportUnicode;
891 PROCEDURE ImportDosText* (f: Files.File; OUT s: Stores.Store);
892 VAR r: Stores.Reader; t: TextModels.Model; wr: TextModels.Writer; ch, nch: SHORTCHAR;
894 PROCEDURE ConvertChar (wr: TextModels.Writer; ch: CHAR);
895 (* PC Code Page Mappings M4 (Latin) to Unicode Encoding *)
896 (* Reference: The Unicode Standard, Version 1.0, Vol 1, Addison Wesley, p. 536 *)
897 BEGIN
898 CASE ch OF
899 | CR, TAB, " "..7EX: wr.WriteChar(ch)
900 | LF:
901 | 080X: wr.WriteChar(0C7X)
902 | 081X: wr.WriteChar(0FCX)
903 | 082X: wr.WriteChar(0E9X)
904 | 083X: wr.WriteChar(0E2X)
905 | 084X: wr.WriteChar(0E4X)
906 | 085X: wr.WriteChar(0E0X)
907 | 086X: wr.WriteChar(0E5X)
908 | 087X: wr.WriteChar(0E7X)
909 | 088X: wr.WriteChar(0EAX)
910 | 089X: wr.WriteChar(0EBX)
911 | 08AX: wr.WriteChar(0E8X)
912 | 08BX: wr.WriteChar(0EFX)
913 | 08CX: wr.WriteChar(0EEX)
914 | 08DX: wr.WriteChar(0ECX)
915 | 08EX: wr.WriteChar(0C4X)
916 | 08FX: wr.WriteChar(0C5X)
917 | 090X: wr.WriteChar(0C9X)
918 | 091X: wr.WriteChar(0E6X)
919 | 092X: wr.WriteChar(0C6X)
920 | 093X: wr.WriteChar(0F4X)
921 | 094X: wr.WriteChar(0F6X)
922 | 095X: wr.WriteChar(0F2X)
923 | 096X: wr.WriteChar(0FBX)
924 | 097X: wr.WriteChar(0F9X)
925 | 098X: wr.WriteChar(0FFX)
926 | 099X: wr.WriteChar(0D6X)
927 | 09AX: wr.WriteChar(0DCX)
928 | 09BX: wr.WriteChar(0F8X)
929 | 09CX: wr.WriteChar(0A3X)
930 | 09DX: wr.WriteChar(0D8X)
931 | 09EX: wr.WriteChar(0D7X)
932 | 09FX: wr.WriteChar(0192X)
933 | 0A0X: wr.WriteChar(0E1X)
934 | 0A1X: wr.WriteChar(0EDX)
935 | 0A2X: wr.WriteChar(0F3X)
936 | 0A3X: wr.WriteChar(0FAX)
937 | 0A4X: wr.WriteChar(0F1X)
938 | 0A5X: wr.WriteChar(0D1X)
939 | 0A6X: wr.WriteChar(0AAX)
940 | 0A7X: wr.WriteChar(0BAX)
941 | 0A8X: wr.WriteChar(0BFX)
942 | 0A9X: wr.WriteChar(0AEX)
943 | 0AAX: wr.WriteChar(0ACX)
944 | 0ABX: wr.WriteChar(0BDX)
945 | 0ACX: wr.WriteChar(0BCX)
946 | 0ADX: wr.WriteChar(0A1X)
947 | 0AEX: wr.WriteChar(0ABX)
948 | 0AFX: wr.WriteChar(0BBX)
949 | 0B5X: wr.WriteChar(0C1X)
950 | 0B6X: wr.WriteChar(0C2X)
951 | 0B7X: wr.WriteChar(0C0X)
952 | 0B8X: wr.WriteChar(0A9X)
953 | 0BDX: wr.WriteChar(0A2X)
954 | 0BEX: wr.WriteChar(0A5X)
955 | 0C6X: wr.WriteChar(0E3X)
956 | 0C7X: wr.WriteChar(0C3X)
957 | 0CFX: wr.WriteChar(0A4X)
958 | 0D0X: wr.WriteChar(0F0X)
959 | 0D1X: wr.WriteChar(0D0X)
960 | 0D2X: wr.WriteChar(0CAX)
961 | 0D3X: wr.WriteChar(0CBX)
962 | 0D4X: wr.WriteChar(0C8X)
963 | 0D5X: wr.WriteChar(0131X)
964 | 0D6X: wr.WriteChar(0CDX)
965 | 0D7X: wr.WriteChar(0CEX)
966 | 0D8X: wr.WriteChar(0CFX)
967 | 0DDX: wr.WriteChar(0A6X)
968 | 0DEX: wr.WriteChar(0CCX)
969 | 0E0X: wr.WriteChar(0D3X)
970 | 0E1X: wr.WriteChar(0DFX)
971 | 0E2X: wr.WriteChar(0D4X)
972 | 0E3X: wr.WriteChar(0D2X)
973 | 0E4X: wr.WriteChar(0F5X)
974 | 0E5X: wr.WriteChar(0D5X)
975 | 0E6X: wr.WriteChar(0B5X)
976 | 0E7X: wr.WriteChar(0FEX)
977 | 0E8X: wr.WriteChar(0DEX)
978 | 0E9X: wr.WriteChar(0DAX)
979 | 0EAX: wr.WriteChar(0DBX)
980 | 0EBX: wr.WriteChar(0D9X)
981 | 0ECX: wr.WriteChar(0FDX)
982 | 0EDX: wr.WriteChar(0DDX)
983 | 0EEX: wr.WriteChar(0AFX)
984 | 0EFX: wr.WriteChar(0B4X)
985 | 0F0X: wr.WriteChar(0ADX)
986 | 0F1X: wr.WriteChar(0B1X)
987 | 0F2X: wr.WriteChar(02017X)
988 | 0F3X: wr.WriteChar(0BEX)
989 | 0F4X: wr.WriteChar(0B6X)
990 | 0F5X: wr.WriteChar(0A7X)
991 | 0F6X: wr.WriteChar(0F7X)
992 | 0F7X: wr.WriteChar(0B8X)
993 | 0F8X: wr.WriteChar(0B0X)
994 | 0F9X: wr.WriteChar(0A8X)
995 | 0FAX: wr.WriteChar(0B7X)
996 | 0FBX: wr.WriteChar(0B9X)
997 | 0FCX: wr.WriteChar(0B3X)
998 | 0FDX: wr.WriteChar(0B2X)
999 | 0X..8X, 0BX, 0CX, 0EX..1FX, 7FX,
1000 0B0X..0B4X, 0B9X..0BCX, 0BFX..0C5X, 0C8X..0CEX, 0D9X..0DCX, 0DFX, 0FEX, 0FFX:
1001 wr.WriteChar(CHR(0EF00H + ORD(ch)))
1002 END
1003 END ConvertChar;
1005 BEGIN
1006 ASSERT(f # NIL, 20);
1007 r.ConnectTo(f); r.SetPos(0);
1008 t := TextModels.dir.New(); wr := t.NewWriter(NIL);
1009 r.ReadSChar(ch);
1010 WHILE ~r.rider.eof DO
1011 r.ReadSChar(nch);
1012 IF (ch = CR) & (nch = LF) THEN r.ReadSChar(nch)
1013 ELSIF ch = LF THEN ch := CR
1014 END;
1015 ConvertChar(wr, ch); ch := nch
1016 END;
1017 s := TextViews.dir.New(t)
1018 END ImportDosText;
1020 PROCEDURE TextView(s: Stores.Store): Stores.Store;
1021 BEGIN
1022 IF s IS Views.View THEN RETURN Properties.ThisType(s(Views.View), "TextViews.View")
1023 ELSE RETURN NIL
1024 END
1025 END TextView;
1027 PROCEDURE ExportText* (s: Stores.Store; f: Files.File);
1028 VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
1029 BEGIN
1030 ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
1031 s := TextView(s);
1032 IF s # NIL THEN
1033 w.ConnectTo(f); w.SetPos(0);
1034 t := s(TextViews.View).ThisModel();
1035 IF t # NIL THEN
1036 r := t.NewReader(NIL);
1037 r.ReadChar(ch);
1038 WHILE ~r.eot DO
1039 IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
1040 ch := ThisWndChar(ch);
1041 w.WriteSChar(SHORT(ch));
1042 IF ch = CR THEN w.WriteSChar(LF) END
1043 END;
1044 r.ReadChar(ch)
1045 END
1046 END
1047 END
1048 END ExportText;
1050 PROCEDURE ExportTabText* (s: Stores.Store; f: Files.File);
1051 VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
1052 BEGIN
1053 ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
1054 s := TextView(s);
1055 IF s # NIL THEN
1056 w.ConnectTo(f); w.SetPos(0);
1057 t := s(TextViews.View).ThisModel();
1058 IF t # NIL THEN
1059 r := t.NewReader(NIL);
1060 r.ReadChar(ch);
1061 WHILE ~r.eot DO
1062 IF (ch # TextModels.viewcode) & (ch # TextModels.para) THEN
1063 ch := ThisWndChar(ch);
1064 IF ch = CR THEN w.WriteSChar(CR); w.WriteSChar(LF)
1065 ELSIF ch = TAB THEN w.WriteSChar(" "); w.WriteSChar(" ")
1066 ELSE w.WriteSChar(SHORT(ch))
1067 END
1068 END;
1069 r.ReadChar(ch)
1070 END
1071 END
1072 END
1073 END ExportTabText;
1075 PROCEDURE ExportRichText* (s: Stores.Store; f: Files.File);
1076 VAR t: TextModels.Model; r: TextModels.Reader; ch: CHAR; w: Stores.Writer;
1077 BEGIN
1078 ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
1079 WITH s: TextViews.View DO
1080 ConvertToRichText(s, 0, MAX(INTEGER), t);
1081 w.ConnectTo(f); w.SetPos(0);
1082 r := t.NewReader(NIL); r.ReadChar(ch);
1083 WHILE ~r.eot DO
1084 w.WriteSChar(SHORT(ch)); r.ReadChar(ch)
1085 END
1086 (*
1087 w.WriteSChar(0X)
1088 *)
1089 ELSE
1090 END
1091 END ExportRichText;
1093 PROCEDURE ExportUnicode* (s: Stores.Store; f: Files.File);
1094 VAR w: Stores.Writer; t: TextModels.Model; r: TextModels.Reader; ch: CHAR;
1095 BEGIN
1096 ASSERT(s # NIL, 20); ASSERT(f # NIL, 21);
1097 s := TextView(s);
1098 IF s # NIL THEN
1099 w.ConnectTo(f); w.SetPos(0);
1100 w.WriteChar(0FEFFX); (* little endian *)
1101 t := s(TextViews.View).ThisModel();
1102 IF t # NIL THEN
1103 r := t.NewReader(NIL);
1104 r.ReadChar(ch);
1105 WHILE ~r.eot DO
1106 IF ch = CR THEN
1107 w.WriteChar(CR); w.WriteChar(LF)
1108 ELSIF (ch >= " ") OR (ch = TAB) THEN
1109 IF (ch >= 0EF00X) & (ch <= 0EFFFX) THEN ch := CHR(ORD(ch) - 0EF00H) END;
1110 w.WriteChar(ch)
1111 END;
1112 r.ReadChar(ch)
1113 END
1114 END
1115 END
1116 END ExportUnicode;
1118 PROCEDURE ImportHex* (f: Files.File; OUT s: Stores.Store);
1119 VAR r: Stores.Reader; t: TextModels.Model; w: TextMappers.Formatter; ch: SHORTCHAR; a: INTEGER;
1120 i: INTEGER; str: ARRAY 17 OF CHAR;
1121 BEGIN
1122 ASSERT(f # NIL, 20);
1123 r.ConnectTo(f); r.SetPos(0);
1124 t := TextModels.dir.New();
1125 w.ConnectTo(t); w.SetPos(0);
1126 r.ReadSChar(ch); a := 0;
1127 WHILE ~r.rider.eof DO
1128 IF a MOD 16 = 0 THEN
1129 w.WriteChar("[");
1130 w.WriteIntForm(a, TextMappers.hexadecimal, 8, "0", FALSE);
1132 END;
1133 w.WriteIntForm(ORD(ch), TextMappers.hexadecimal, 2, "0", FALSE);
1134 IF ch > 20X THEN str[a MOD 16] := ch ELSE str[a MOD 16] := "\8f" END;
1135 INC(a);
1136 IF a MOD 16 = 0 THEN
1138 w.WriteLn
1139 ELSIF a MOD 4 = 0 THEN
1141 ELSE
1142 w.WriteChar("\8f")
1143 END;
1144 r.ReadSChar(ch)
1145 END;
1146 IF a MOD 16 # 0 THEN
1147 str[a MOD 16] := 0X;
1148 i := (16 - a MOD 16) * 3 + (3 - a MOD 16 DIV 4) + 3;
1149 WHILE i # 0 DO w.WriteChar("\8f"); DEC(i) END;
1150 w.WriteString(str)
1151 END;
1152 s := TextViews.dir.New(t)
1153 END ImportHex;
1155 END HostTextConv.