home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / textprinter.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  23KB  |  501 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Syntax12.Scn.Fnt
  5. MODULE TextPrinter;    (** CAS/MH/HM 23.9.1993 **)
  6.     IMPORT
  7.         Files, Display, Fonts, Printer, Texts, TextFrames;
  8.     CONST
  9.         Unit* = 3048;    (**unit for a 300 dpi printer**)
  10.         unit = TextFrames.Unit;
  11.         mm = TextFrames.mm; Scale = mm DIV 10;
  12.         gridAdj = TextFrames.gridAdj;
  13.         leftAdj = TextFrames.leftAdj; rightAdj = TextFrames.rightAdj; AdjMask = {leftAdj, rightAdj};
  14.         pageBreak = TextFrames.pageBreak;
  15.         twoColumns = TextFrames.twoColumns;
  16.         AdjustSpan = 30; MinTabWidth = 1 * Scale; StdTabWidth = 4 * mm;
  17.         ColumnGap = 7*mm;
  18.         TAB = 9X; CR = 0DX;
  19.         MaxDict = 32;    MaxLine = 512;
  20.     TYPE
  21.         PrintMsg* = RECORD (Texts.ElemMsg)
  22.             prepare*: BOOLEAN;
  23.             indent*: LONGINT;    (**prepare => width already consumed in line, in units**)
  24.             fnt*: Fonts.Font;
  25.             col*: SHORTINT;
  26.             pos*: LONGINT;    (**position in host text**)
  27.             X0*, Y0*, pno*: INTEGER    (**receiver origin in screen space; page number**)
  28.         END;
  29.         PrintLine = RECORD
  30.             eot: BOOLEAN;    (*marked to skip, contains end of text*)
  31.             indent: LONGINT;
  32.             w, h, dsr: INTEGER;    (*bounding box clipped to frame*)
  33.             nob: INTEGER;    (*number of contained blanks; > 0 if text line wraps around*)
  34.             org, len, span: LONGINT;    (*len w/o; span w/ trailing CR or white space, if any*)
  35.             pbeg: LONGINT    (*position of corresponding parc*)
  36.         END;
  37.         P: TextFrames.Parc;
  38.         pbeg: LONGINT;
  39.         R: Texts.Reader;
  40.         nextCh: CHAR;
  41.         fname: ARRAY 32 OF CHAR;
  42.         fonts: RECORD
  43.             num: SHORTINT;
  44.             dict: ARRAY MaxDict OF Fonts.Font;
  45.             dx: ARRAY MaxDict, 256 OF SHORTINT
  46.         END;
  47.         line: RECORD
  48.             first: BOOLEAN;
  49.             fno: SHORTINT;
  50.             px, x, y: INTEGER;
  51.             len: INTEGER;
  52.             buf: ARRAY MaxLine OF CHAR
  53.         END;
  54.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  55.     BEGIN
  56.         IF x < y THEN RETURN x ELSE RETURN y END
  57.     END Min;
  58.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  59.     BEGIN
  60.         IF x > y THEN RETURN x ELSE RETURN y END
  61.     END Max;
  62.     PROCEDURE Append (VAR s1: ARRAY OF CHAR; i: INTEGER; s2: ARRAY OF CHAR);
  63.         VAR j: INTEGER;
  64.     BEGIN j := 0;    (*s1 large enough*)
  65.         WHILE s2[j] # 0X DO s1[i] := s2[j]; INC(i); INC(j) END;
  66.         s1[i] := 0X
  67.     END Append;
  68.     (** Printer Metrics **)
  69.     PROCEDURE SetMetrics (fno: SHORTINT; fnt: Fonts.Font);
  70.         VAR f: Files.File; r: Files.Rider; pat: Display.Pattern;
  71.             off, i, j, k, dx, x, y, w, h: INTEGER; size, s: SHORTINT; mod, m: CHAR;
  72.             name: ARRAY 32 OF CHAR;
  73.     BEGIN COPY(fnt.name, name);
  74.         i := 0; WHILE name[i] > "9" DO INC(i) END;
  75.         j := i; WHILE ("0" <= name[j]) & (name[j] < "9") DO INC(j) END;
  76.         k := j; WHILE (name[k] # ".") & (name[k] # 0X) DO INC(k) END;
  77.         IF k > j THEN mod := name[k-1] ELSE mod := " " END;
  78.         size := 0; k := i; WHILE i < j DO size := 10 * size + SHORT(ORD(name[i]) - 30H); INC(i) END;
  79.         Append(name, k, ".Lm3.Fnt"); f := Files.Old(name);
  80.         IF f # NIL THEN Files.Set(r, f, 2); Files.ReadInt(r, off); Files.Set(r, f, 6); i := -1;
  81.             REPEAT INC(i); Files.Read(r, s); Files.Read(r, m) UNTIL (s = size) & (m = mod) OR (Files.Pos(r) >= off);
  82.             IF (s = size) & (m = mod) THEN Files.Set(r, f, off + i * 260 + 4); Files.ReadBytes(r, fonts.dx[fno], 256)
  83.             ELSE f := NIL
  84.             END
  85.         END;
  86.         IF f = NIL THEN i := 0;    (*no printer metrics file found - construct from screen metrics*)
  87.             WHILE i < 256 DO Display.GetChar(fnt.raster, CHR(i), dx, x, y, w, h, pat);
  88.                 fonts.dx[fno, i] := SHORT(SHORT(LONG(dx) * unit * 12 DIV 10 DIV Unit)); INC(i)
  89.                 (*+20% : heuristical correction*)
  90.             END
  91.         END
  92.     END SetMetrics;
  93.     PROCEDURE FontNo* (fnt: Fonts.Font): SHORTINT;
  94.         VAR fno: SHORTINT;
  95.     BEGIN fno := 0; fonts.dict[fonts.num] := fnt;
  96.         WHILE fonts.dict[fno] # fnt DO INC(fno) END;
  97.         IF fno = fonts.num THEN SetMetrics(fno, fnt); INC(fonts.num) END;
  98.         RETURN fno
  99.     END FontNo;
  100.     PROCEDURE Font* (fno: SHORTINT): Fonts.Font;
  101.     BEGIN RETURN fonts.dict[fno]
  102.     END Font;
  103.     PROCEDURE DX* (fno: SHORTINT; ch: CHAR): LONGINT;
  104.     BEGIN RETURN LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit
  105.     END DX;
  106.     PROCEDURE Get* (fno: SHORTINT; ch: CHAR; VAR dx, x, y, w, h: LONGINT);
  107.         VAR pat: Display.Pattern; dx0, x0, y0, w0, h0: INTEGER;
  108.     BEGIN Display.GetChar(fonts.dict[fno].raster, ch, dx0, x0, y0, w0, h0, pat);
  109.         x := LONG(x0) * unit; y := LONG(y0) * unit; h := LONG(h0) * unit;
  110.         dx := LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit; w := dx
  111.     END Get;
  112.     PROCEDURE GetChar* (fno: SHORTINT; targetUnit: LONGINT; ch: CHAR;
  113.                 VAR pdx: LONGINT; VAR dx, x, y, w, h: INTEGER; VAR pat: Display.Pattern);
  114.     BEGIN Display.GetChar(fonts.dict[fno].raster, ch, dx, x, y, w, h, pat);
  115.         x := SHORT(x * LONG(unit) DIV targetUnit); y := SHORT(y * LONG(unit) DIV targetUnit);
  116.         h := SHORT(h * LONG(unit) DIV targetUnit);
  117.         pdx := LONG(LONG(fonts.dx[fno, ORD(ch)])) * Unit;
  118.         dx := SHORT(pdx DIV targetUnit); w := dx
  119.     END GetChar;
  120.     PROCEDURE InitFonts*;
  121.         VAR fno: SHORTINT;
  122.     BEGIN fonts.num := 0; fno := FontNo(Fonts.Default)
  123.     END InitFonts;
  124.     PROCEDURE Width (fno: SHORTINT; VAR s: ARRAY OF CHAR): INTEGER;
  125.         VAR i, w: INTEGER;
  126.     BEGIN i := 0; w := 0;
  127.         WHILE s[i] # 0X DO INC(w, LONG(fonts.dx[fno, ORD(s[i])]) ); INC(i) END;
  128.         RETURN w
  129.     END Width;
  130.     PROCEDURE GetPrintChar (fnt: Fonts.Font; ch: CHAR; VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);
  131.         VAR pat: Display.Pattern;
  132.     BEGIN Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  133.         x := SHORT(x * LONG(unit) DIV Unit); y := -SHORT((-y) * LONG(unit) DIV Unit);
  134.         h := SHORT(h * LONG(unit) DIV Unit);
  135.         fno := FontNo(fnt); dx := fonts.dx[fno, ORD(ch)]; w := dx
  136.     END GetPrintChar;
  137.     PROCEDURE Tab (dw: INTEGER; VAR dx: INTEGER);    (*P set*)
  138.         VAR i, n: INTEGER; w: LONGINT;
  139.     BEGIN i := 0; n := P.nofTabs; w := LONG(dw) * Unit + MinTabWidth;
  140.         IF dw < 0 THEN dx := -dw
  141.         ELSE
  142.             WHILE (i < n) & (P.tab[i] < w) DO INC(i) END;
  143.             IF i < n THEN dx := SHORT((P.tab[i] - LONG(dw) * Unit) DIV Unit)
  144.             ELSE dx := StdTabWidth DIV Unit
  145.             END
  146.         END
  147.     END Tab;
  148.     PROCEDURE Offset (): INTEGER;    (*R set*)
  149.     BEGIN
  150.         IF R.voff = 0 THEN RETURN 0
  151.         ELSE RETURN SHORT(R.fnt.height * R.voff * LONG(unit) DIV 64 DIV Unit)
  152.         END
  153.     END Offset;
  154.     PROCEDURE MeasureSpecial (pno, dw: INTEGER; VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);
  155.         (*P, R, nextCh set*)
  156.         VAR e: Texts.Elem; i: INTEGER; msg: PrintMsg;
  157.     BEGIN
  158.         IF nextCh = " " THEN GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h);
  159.             x := 0; y := 0; w := dx; h := 0
  160.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  161.         ELSIF R.elem # NIL THEN e := R.elem;
  162.             msg.prepare := TRUE; msg.indent := LONG(dw) * Unit;
  163.             msg.fnt := R.fnt; msg.col := R.col; msg.pos := Texts.Pos(R) - 1; msg.pno := pno;
  164.             msg.Y0 := -SHORT(P.dsr DIV Unit);
  165.             e.handle(e, msg);
  166.             w := SHORT(e.W DIV Unit); dx := w; h := SHORT(e.H DIV Unit);
  167.             x := 0; y := msg.Y0
  168.         ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  169.         END
  170.     END MeasureSpecial;
  171.     PROCEDURE GetSpecial (VAR n: INTEGER; maxW, cn, ddx, dw: INTEGER;
  172.             VAR fno: SHORTINT; VAR dx, x, y, w, h: INTEGER);    (*P, R, nextCh set*)
  173.         VAR e: Texts.Elem;
  174.     BEGIN
  175.         IF nextCh = " " THEN GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h);
  176.             x := 0; y := 0; INC(dx, ddx); INC(n); IF n <= cn THEN INC(dx) END;    (*space correction for block adjustment*)
  177.             w := dx; h := 0
  178.         ELSIF nextCh = TAB THEN Tab(dw, dx); x := 0; y := 0; w := dx; h := 0
  179.         ELSIF R.elem # NIL THEN e := R.elem;
  180.                 IF e IS TextFrames.Parc THEN w := SHORT(Min(P.width DIV Unit, maxW)); e.W := LONG(w) * Unit
  181.                 ELSE w := SHORT(e.W DIV Unit)
  182.                 END;
  183.                 dx := w; x := 0; y := -SHORT(P.dsr DIV Unit); h := SHORT(e.H DIV Unit)
  184.         ELSE GetPrintChar(R.fnt, nextCh, fno, dx, x, y, w, h)
  185.         END
  186.     END GetSpecial;
  187.     PROCEDURE AdjustMetrics (T: Texts.Text; VAR t: PrintLine; left: INTEGER; VAR pw, tw, ddx, cn: INTEGER);
  188.         (*sets P, pbeg*)
  189.     BEGIN pw := left; tw := t.w; ddx := 0; cn := 0;
  190.         TextFrames.ParcBefore(T, t.org, P, pbeg);
  191.         IF pbeg # t.org THEN
  192.             INC(pw, SHORT((P.left + t.indent) DIV Unit));
  193.             DEC(tw, SHORT(t.indent DIV Unit));
  194.             IF leftAdj IN P.opts THEN
  195.                 IF (rightAdj IN P.opts) & (t.nob > 0) THEN
  196.                     tw := SHORT((P.width - t.indent) DIV Unit); ddx := (tw - t.w) DIV t.nob; cn := (tw - t.w) MOD t.nob
  197.                 END
  198.             ELSIF rightAdj IN P.opts THEN INC(pw, SHORT(P.width DIV Unit) - t.w)
  199.             ELSE (*center*) INC(pw, (SHORT(P.width DIV Unit) - t.w) DIV 2)
  200.             END
  201.         END
  202.     END AdjustMetrics;
  203.     (* Printer Line Casting *)
  204.     PROCEDURE MeasureLine (T: Texts.Text