HostTextConv.txt 39 KB

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