Trurl-based/Std/Mod/ETHConv.txt

   1 MODULE StdETHConv;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/ETHConv.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT
   7                 Fonts, Files, Stores, Ports, Views,
   8                 TextModels, TextRulers, TextViews,
   9                 Stamps := StdStamps, Clocks := StdClocks, StdFolds;
  10
  11         CONST
  12                 V2Tag = -4095; (* 01 F0 *)
  13                 V4Tag = 496; (* F0 01 *)
  14
  15         TYPE
  16                 FontDesc = RECORD
  17                         typeface: Fonts.Typeface;
  18                         size: INTEGER;
  19                         style: SET;
  20                         weight: INTEGER
  21                 END;
  22
  23         VAR default: Fonts.Font;
  24
  25         PROCEDURE Split (name: ARRAY OF CHAR; VAR d: FontDesc);
  26                 VAR i: INTEGER; ch: CHAR;
  27         BEGIN
  28                 i := 0; ch := name[0];
  29                 WHILE (ch < "0") OR (ch >"9") DO
  30                         d.typeface[i] := ch; INC(i); ch := name[i]
  31                 END;
  32                 d.typeface[i] := 0X;
  33                 d.size := 0;
  34                 WHILE ("0" <= ch) & (ch <= "9") DO
  35                         d.size := d.size * 10 + (ORD(ch) - 30H); INC(i); ch := name[i]
  36                 END;
  37                 CASE ch OF
  38                   "b": d.style := {}; d.weight := Fonts.bold
  39                 | "i": d.style := {Fonts.italic}; d.weight := Fonts.normal
  40                 | "j": d.style := {Fonts.italic}; d.weight := Fonts.bold
  41                 | "m": d.style := {}; d.weight := Fonts.bold
  42                 ELSE d.style := {}; d.weight := Fonts.normal    (* unknown style *)
  43                 END
  44         END Split;
  45
  46         PROCEDURE ThisFont (name: ARRAY OF CHAR): Fonts.Font;
  47                 VAR d: FontDesc;
  48         BEGIN
  49                 Split(name, d);
  50                 IF d.typeface = "Syntax" THEN d.typeface := default.typeface END;
  51                 IF d.size = 10 THEN d.size := default.size
  52                 ELSE d.size := (d.size - 2) * Ports.point
  53                 END;
  54                 RETURN Fonts.dir.This(d.typeface, d.size, d.style, d.weight)
  55         END ThisFont;
  56
  57         PROCEDURE ThisChar (ch: CHAR): CHAR;
  58         BEGIN
  59                 CASE ORD(ch) OF
  60                   80H: ch := 0C4X | 81H: ch := 0D6X | 82H: ch := 0DCX
  61                 | 83H: ch := 0E4X | 84H: ch := 0F6X | 85H: ch := 0FCX
  62                 | 86H: ch := 0E2X | 87H: ch := 0EAX | 88H: ch := 0EEX | 89H: ch := 0F4X | 8AH: ch := 0FBX
  63                 | 8BH: ch := 0E0X | 8CH: ch := 0E8X | 8DH: ch := 0ECX | 8EH: ch := 0F2X | 8FH: ch := 0F9X
  64                 | 90H: ch := 0E9X
  65                 | 91H: ch := 0EBX | 92H: ch := 0EFX
  66                 | 93H: ch := 0E7X
  67                 | 94H: ch := 0E1X
  68                 | 95H: ch := 0F1X
  69                 | 9BH: ch := TextModels.hyphen
  70                 | 9FH: ch := TextModels.nbspace
  71                 | 0ABH: ch := 0DFX
  72                 ELSE
  73                         ch := 0BFX      (* use inverted question mark for unknown character codes *)
  74                 END;
  75                 RETURN ch
  76         END ThisChar;
  77
  78         PROCEDURE ^ LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
  79
  80         PROCEDURE StdFold (VAR r: Stores.Reader): Views.View;
  81                 CONST colLeft = 0; colRight = 1; expRight = 2; expLeft = 3;
  82                 VAR k: BYTE; state: BOOLEAN; hidden: TextModels.Model; fold: StdFolds.Fold;
  83         BEGIN
  84                 r.ReadByte(k);
  85                 CASE k MOD 4 OF
  86                         | colLeft: state := StdFolds.collapsed
  87                         | colRight: state := StdFolds.collapsed
  88                         | expRight: state := StdFolds.expanded
  89                         | expLeft: state := StdFolds.expanded
  90                 END;
  91                 IF (k MOD 4 IN {colLeft, expLeft}) & (k < 4) THEN
  92                         hidden := TextModels.dir.New(); LoadTextBlock(r, hidden);
  93                 ELSE hidden := NIL;
  94                 END;
  95                 fold := StdFolds.dir.New(state, "", hidden);
  96                 RETURN fold;
  97         END StdFold;
  98
  99         PROCEDURE LoadTextBlock (r: Stores.Reader; t: TextModels.Model);
 100                 VAR r0: Stores.Reader; wr: TextModels.Writer;
 101                         org, len: INTEGER; en, ano, i, n: BYTE; col, voff, ch: CHAR; tag: INTEGER;
 102                         fname: ARRAY 32 OF CHAR;
 103                         attr: ARRAY 32 OF TextModels.Attributes;
 104                         mod, proc: ARRAY 32 OF ARRAY 32 OF CHAR;
 105
 106                 PROCEDURE ReadNum (VAR n: INTEGER);
 107                         VAR s: BYTE; ch: CHAR; y: INTEGER;
 108                 BEGIN
 109                         s := 0; y := 0; r.ReadXChar(ch);
 110                         WHILE ch >= 80X DO
 111                                 INC(y, ASH(ORD(ch)-128, s)); INC(s, 7); r.ReadXChar(ch)
 112                         END;
 113                         n := ASH((ORD(ch) + 64) MOD 128 - 64, s) + y
 114                 END ReadNum;
 115
 116                 PROCEDURE ReadSet (VAR s: SET);
 117                         VAR x: INTEGER;
 118                 BEGIN
 119                         ReadNum(x); s := BITS(x)
 120                 END ReadSet;
 121
 122                 PROCEDURE Elem (VAR r: Stores.Reader; span: INTEGER);
 123                         VAR v: Views.View; end, ew, eh, n, indent: INTEGER; eno, version: BYTE;
 124                                 p: TextRulers.Prop; opts: SET;
 125                 BEGIN
 126                         r.ReadInt(ew); r.ReadInt(eh); r.ReadByte(eno);
 127                         IF eno > en THEN en := eno; r.ReadXString(mod[eno]); r.ReadXString(proc[eno]) END;
 128                         end := r.Pos() + span;
 129                         IF (mod[eno] = "ParcElems") OR (mod[eno] = "StyleElems") THEN
 130                                 r.ReadByte(version);
 131                                 NEW(p);
 132                                 p.valid := {TextRulers.first .. TextRulers.tabs};
 133                                 ReadNum(indent); ReadNum(p.left);
 134                                 p.first := p.left + indent;
 135                                 ReadNum(n); p.right := p.left + n;
 136                                 ReadNum(p.lead);
 137                                 ReadNum(p.grid);
 138                                 ReadNum(p.dsc); p.asc := p.grid - p.dsc;
 139                                 ReadSet(opts); p.opts.val := {};
 140                                 IF ~(0 IN opts) THEN p.grid := 1 END;
 141                                 IF 1 IN opts THEN INCL(p.opts.val, TextRulers.leftAdjust) END;
 142                                 IF 2 IN opts THEN INCL(p.opts.val, TextRulers.rightAdjust) END;
 143                                 IF 3 IN opts THEN INCL(p.opts.val, TextRulers.pageBreak) END;
 144                                 INCL(p.opts.val, TextRulers.rightFixed);
 145                                 p.opts.mask := {TextRulers.leftAdjust .. TextRulers.pageBreak, TextRulers.rightFixed};
 146                                 ReadNum(n); p.tabs.len := n;
 147                                 i := 0; WHILE i < p.tabs.len DO ReadNum(p.tabs.tab[i].stop); INC(i) END;
 148                                 v := TextRulers.dir.NewFromProp(p);
 149                                 wr.WriteView(v, ew, eh)
 150                         ELSIF mod[eno] = "StampElems" THEN
 151                                 v := Stamps.New();
 152                                 wr.WriteView(v, ew, eh)
 153                         ELSIF mod[eno] = "ClockElems" THEN
 154                                 v := Clocks.New();
 155                                 wr.WriteView(v, ew, eh)
 156                         ELSIF mod[eno] = "FoldElems" THEN
 157                                 v := StdFold(r);
 158                                 wr.WriteView(v, ew, eh);
 159                         END;
 160                         r.SetPos(end)
 161                 END Elem;
 162
 163         BEGIN
 164                 (* skip inner text tags (legacy from V2) *)
 165                 r.ReadXInt(tag);
 166                 IF tag # V2Tag THEN r.SetPos(r.Pos()-2) END;
 167                 (* load text block *)
 168                 org := r.Pos(); r.ReadInt(len); INC(org, len - 2);
 169                 r0.ConnectTo(r.rider.Base()); r0.SetPos(org);
 170                 wr := t.NewWriter(NIL); wr.SetPos(0);
 171                 n := 0; en := 0; r.ReadByte(ano);
 172                 WHILE ano # 0 DO
 173                         IF ano > n THEN
 174                                 n := ano; r.ReadXString(fname);
 175                                 attr[n] := TextModels.NewFont(wr.attr, ThisFont(fname))
 176                         END;
 177                         r.ReadXChar(col); r.ReadXChar(voff); r.ReadInt(len);
 178                         wr.SetAttr(attr[ano]);
 179                         IF len > 0 THEN
 180                                 WHILE len # 0 DO
 181                                         r0.ReadXChar(ch);
 182                                         IF ch >= 80X THEN ch := ThisChar(ch) END;
 183                                         IF (ch >= " ") OR (ch = TextModels.tab) OR (ch = TextModels.line) THEN
 184                                                 wr.WriteChar(ch)
 185                                         END;
 186                                         DEC(len)
 187                                 END
 188                         ELSE
 189                                 Elem(r, -len); r0.ReadXChar(ch)
 190                         END;
 191                         r.ReadByte(ano)
 192                 END;
 193                 r.ReadInt(len);
 194                 r.SetPos(r.Pos() + len);
 195         END LoadTextBlock;
 196
 197         PROCEDURE ImportOberon* (f: Files.File): TextModels.Model;
 198                 VAR r: Stores.Reader; t: TextModels.Model; tag: INTEGER;
 199         BEGIN
 200                 r.ConnectTo(f); r.SetPos(0);
 201                 r.ReadXInt(tag);
 202                 IF tag = ORD("o") + 256 * ORD("B") THEN
 203                         (* ignore file header of Oberon for Windows and DOSOberon files *)
 204                         r.SetPos(34); r.ReadXInt(tag)
 205                 END;
 206                 ASSERT((tag = V2Tag) OR (tag = V4Tag), 100);
 207                 t := TextModels.dir.New();
 208                 LoadTextBlock(r, t);
 209                 RETURN t;
 210         END ImportOberon;
 211
 212
 213         PROCEDURE ImportETHDoc* (f: Files.File; OUT s: Stores.Store);
 214                 VAR t: TextModels.Model;
 215         BEGIN
 216                 ASSERT(f # NIL, 20);
 217                 t := ImportOberon(f);
 218                 IF t # NIL THEN s := TextViews.dir.New(t) END
 219         END ImportETHDoc;
 220
 221 BEGIN
 222         default := Fonts.dir.Default()
 223 END StdETHConv.