OberonCore

TextSetters      36
   GatherString      11
   Reader.Read      7
   StdReader.Read      7
   Enclose      4
   StdSetter.GetLine      4
   WordPart      1
   TrueW      1

HostFonts      19
   Font.StringWidth      15
   Font.fTab      1
   DevFont.wTab      1
   Font.GetBounds      1

      (* width methods for unicode *)
   
   PROCEDURE (f: Font) wTab* (dc: WinApi.HANDLE; ch: CHAR): INTEGER, NEW;
      VAR res, w: INTEGER; abc: ARRAY 1 OF WinApi.ABC; wt: ARRAY 1 OF INTEGER;
   BEGIN
      IF ch < 100X THEN RETURN f.wtab[ORD(ch)] END;
      res := WinApi.GetCharABCWidthsW(dc, ORD(ch), ORD(ch), abc[0]);
      IF res # 0 THEN
         w := abc[0].abcA + abc[0].abcB + abc[0].abcC;
         w := w * f.a DIV grid + w * f.b
      ELSE
         res := WinApi.GetCharWidth32W(dc, ORD(ch), ORD(ch), wt[0]);
         IF res # 0 THEN w := wt[0] * f.a DIV grid + wt[0] * f.b
         ELSE
            res := WinApi.GetCharWidthW(dc, ORD(ch), ORD(ch), wt[0]);
            IF res # 0 THEN w := wt[0] * f.a DIV grid + wt[0] * f.b
            ELSE w := f.wtab[1]
            END
         END
      END;
      RETURN w
   END wTab;

   PROCEDURE (f: Font) fTab* (dc: WinApi.HANDLE; ch: CHAR): INTEGER, NEW;
      VAR res, w: INTEGER; abc: ARRAY 1 OF WinApi.ABC;
   BEGIN
      IF ch < 100X THEN RETURN f.ftab[ORD(ch)] END;
      res := WinApi.GetCharABCWidthsW(dc, ORD(ch), ORD(ch), abc[0]);
      IF (res # 0) & (abc[0].abcA < 0) THEN
         w := -abc[0].abcA;
         w := w * f.a DIV grid + w * f.b
      ELSE w := 0
      END;
      RETURN w
   END fTab;

   PROCEDURE (f: Font) tTab* (dc: WinApi.HANDLE; ch: CHAR): INTEGER, NEW;
      VAR res, w: INTEGER; abc: ARRAY 1 OF WinApi.ABC;
   BEGIN
      IF ch < 100X THEN RETURN f.ttab[ORD(ch)] END;
      res := WinApi.GetCharABCWidthsW(dc, ORD(ch), ORD(ch), abc[0]);
      IF (res # 0) & (abc[0].abcC < 0) THEN
         w := -abc[0].abcC;
         w := w * f.a DIV grid + w * f.b
      ELSE w := 0
      END;
      RETURN w
   END tTab;
   
   PROCEDURE (df: DevFont) wTab* (dc: WinApi.HANDLE; ch: CHAR): INTEGER, NEW;
      VAR res, w: INTEGER; wt: ARRAY 1 OF INTEGER;
   BEGIN
      IF ch < 100X THEN RETURN df.wtab[ORD(ch)] END;
      res := WinApi.GetCharWidth32W(dc, ORD(ch), ORD(ch), wt[0]);
      IF res = 0 THEN res := WinApi.GetCharWidthW(dc, ORD(ch), ORD(ch), wt[0]) END;
      IF res # 0 THEN w := wt[0] ELSE w := df.wtab[1] END;
      RETURN w
   END wTab;
   

MODULE TestFoo1;
   PROCEDURE Do*;
   VAR i, a, b: INTEGER;
   BEGIN
      FOR i := 1 TO 1000 DO
         a := b DIV i;
      END;
   END Do;
END TestFoo1.

MODULE TestFoo2;
IMPORT TestFoo1;
   PROCEDURE Do*;
   VAR i: INTEGER;
   BEGIN
      FOR i := 1 TO 100000000 DO
         TestFoo1.Do;
      END;
   END Do;
END TestFoo2.Do

Module      % per module
   Procedure      % per procedure

TestFoo1      99
   Do      99

samples:      51315      100%
   in profiled modules      30664      59%
   other      20651      41%

   PROCEDURE (f: Font) StringWidth* (IN s: ARRAY OF CHAR): INTEGER;
      VAR res: INTEGER; dc, old: WinApi.HANDLE; size: WinApi.SIZE;
   BEGIN
      dc := WinApi.GetDC(0);
      old := WinApi.SelectObject(dc, f.id);
      res := WinApi.GetTextExtentPoint32W(dc, s, LEN(s$), size);
      res := WinApi.SelectObject(dc, old);
      res := WinApi.ReleaseDC(0, dc);
      RETURN size.cx * 9525;
   END StringWidth;