home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / fonts.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  3KB  |  104 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Fonts; (*JG 27.8.90*)
  3.     IMPORT SYSTEM, Kernel, Display, Files;
  4.  CONST FontFileId = 0DBX;
  5.     TYPE
  6.         Name* = ARRAY 32 OF CHAR;
  7.         Font* = POINTER TO FontDesc;
  8.         FontDesc* = RECORD
  9.             next: Font;
  10.             name*: Name;
  11.             height*, minX*, maxX*, minY*, maxY*: INTEGER;
  12.             raster*: Display.Font
  13.         END;
  14.     VAR Default*, First: Font;
  15.     PROCEDURE This* (name: ARRAY OF CHAR): Font;
  16.         TYPE
  17.             RunRec = RECORD beg, end: INTEGER END;
  18.             BoxRec = RECORD dx, x, y, w, h: INTEGER END;
  19.         VAR
  20.             F: Font;
  21.             f: Files.File; R: Files.Rider;
  22.             NofBytes, RasterBase, A, a: LONGINT;
  23.             NofRuns, NofBoxes: INTEGER;
  24.             k, l, m, n: INTEGER;
  25.             ch: CHAR;
  26.             run: ARRAY 16 OF RunRec;
  27.             box: ARRAY 256 OF BoxRec;
  28.         PROCEDURE Enter (d: LONGINT);
  29.         BEGIN
  30.             SYSTEM.PUT(A, d MOD 256); INC(A);
  31.             SYSTEM.PUT(A, d DIV 256); INC(A)
  32.         END Enter;
  33.     BEGIN F := First;
  34.         LOOP
  35.             IF F = NIL THEN EXIT END;
  36.             IF name = F.name THEN EXIT END;
  37.             F := F.next
  38.         END;
  39.         IF F = NIL THEN
  40.             f := Files.Old(name);
  41.             IF f # NIL THEN
  42.                 Files.Set(R, f, 0); Files.Read(R, ch);
  43.                 IF ch = FontFileId THEN
  44.                     Files.Read(R, ch); (*abstraction*)
  45.                     Files.Read(R, ch); (*family*)
  46.                     Files.Read(R, ch); (*variant*)
  47.                     NEW(F);
  48.                     Files.ReadBytes(R, F.height, 2);
  49.                     Files.ReadBytes(R, F.minX, 2); Files.ReadBytes(R, F.maxX, 2);
  50.                     Files.ReadBytes(R, F.minY, 2); Files.ReadBytes(R, F.maxY, 2);
  51.                     Files.ReadBytes(R, NofRuns, 2);
  52.                     NofBoxes := 0; k := 0;
  53.                     WHILE k # NofRuns DO
  54.                         Files.ReadBytes(R, run[k].beg, 2); Files.ReadBytes(R, run[k].end, 2);
  55.                         NofBoxes := NofBoxes + run[k].end - run[k].beg;
  56.                         INC(k)
  57.                     END;
  58.                     NofBytes := 512 + 5; l := 0;
  59.                     WHILE l # NofBoxes DO
  60.                         Files.ReadBytes(R, box[l].dx, 2);
  61.                         Files.ReadBytes(R, box[l].x, 2); Files.ReadBytes(R, box[l].y, 2);
  62.                         Files.ReadBytes(R, box[l].w, 2); Files.ReadBytes(R, box[l].h, 2);
  63.                         NofBytes := NofBytes + 5 + (box[l].w + 7) DIV 8 * box[l].h;
  64.                         INC(l)
  65.                     END;
  66.                     SYSTEM.NEW(F.raster, NofBytes);
  67.                     RasterBase := SYSTEM.VAL(LONGINT, F.raster);
  68.                     A := RasterBase; a := A + 512;
  69.                     SYSTEM.PUT(a, 0X); INC(a); (*dummy ch*)
  70.                     SYSTEM.PUT(a, 0X); INC(a);
  71.                     SYSTEM.PUT(a, 0X); INC(a);
  72.                     SYSTEM.PUT(a, 0X); INC(a);
  73.                     SYSTEM.PUT(a, 0X); INC(a);
  74.                     k := 0; l := 0; m := 0;
  75.                     WHILE k < NofRuns DO
  76.                         WHILE m < run[k].beg DO Enter(515); INC(m) END;
  77.                         WHILE m < run[k].end DO Enter(a + 3 - RasterBase);
  78.                             SYSTEM.PUT(a, box[l].dx MOD 256); INC(a);
  79.                             SYSTEM.PUT(a, box[l].x MOD 256); INC(a);
  80.                             SYSTEM.PUT(a, box[l].y MOD 256); INC(a);
  81.                             SYSTEM.PUT(a, box[l].w MOD 256); INC(a);
  82.                             SYSTEM.PUT(a, box[l].h MOD 256); INC(a);
  83.                             n := (box[l].w + 7) DIV 8 * box[l].h;
  84.                             WHILE n # 0 DO
  85.                                 Files.Read(R, ch); SYSTEM.PUT(a, ch); INC(a); DEC(n)
  86.                             END;
  87.                             INC(l); INC(m)
  88.                         END;
  89.                         INC(k)
  90.                     END;
  91.                     WHILE m < 256 DO Enter(515); INC(m) END;
  92.                    COPY(name, F.name);
  93.                     F.next := First; First := F
  94.                 ELSE F := Default
  95.                 END
  96.             ELSE F := Default
  97.             END
  98.         END;
  99.         RETURN F
  100.     END This;
  101. BEGIN
  102.   First := NIL; Kernel.FontRoot := SYSTEM.ADR(First); Default := This("Syntax10.Scn.Fnt")
  103. END Fonts.
  104.