Syntax10.Scn.FntSyntax10i.Scn.FntPIStampElemsAlloc16 Oct 98qBalloonElemsAlloc_Syntax10.Scn.FntSyntax10i.Scn.Fnt               $  1   * $7 C   )( "      %6 g     &$:0B    #" Q  #   $   %  <   -# <" "grey1" grey1 = 12 predefined color "grey2" grey2 = 13 predefines color "grey3" grey3 = 14 predefined color "black" black = 15 predefined color "white" white = 0 predefined color "left" left is used for align parameter of String "center" center is used for align parameter of String "right" right is used for align parameter of String "printer" printer is used for SetDevice which is stored in device "display" display is used for SetDevice which is stored in device "device" device- : INTEGER; represents the current device (printer or display) "Unit" PROCEDURE Unit(val : LONGINT; isDisplayUnit : BOOLEAN) : INTEGER; returns val recalculated with the device units depending on device and isDisplayUnit. If val was muliplied by Display.Unit then isDisplayUnit must be set TRUE. "SetDevice" PROCEDURE SetDevice(dev : INTEGER); Sets the current device to dev. All functions behave depending on device. Either they print or display. "ReplConst" PROCEDURE ReplConst(f : Display.Frame; col, x, y, w, h, mode : INTEGER); Draws a filled rectangle with its leftbottom corner on x, y and width w and height h with mode mode. The rectangle is filled with the color col. If f # NIL then the rectangle is clipped against f. "Line" PROCEDURE Line(f : Display.Frame; col, X0, Y0, X1, Y1, mode : INTEGER); Draws a line from X0, Y0 to X1, Y1 with color col and mode mode. If f # NIL then the line is clipped against f. "CopyPattern" PROCEDURE CopyPattern(f : Display.Frame; col : INTEGER; pat: LONGINT; x, y, w, h, mode : INTEGER); Draws the pattern pat with its bottomleft corner on x, y with width w and height h in mode mode using the color col. If f # NIL then the pattern is clipped against f. NOTE: printing is not supported "String" PROCEDURE String(f: Display.Frame; s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; col, mode: INTEGER; align: INTEGER); Draws the string s at x, y with font fnt and color col in mode mode. The string is aligned as defined in align within the width w. If f # NIL then the string is clipped against f. "GetStringLength" PROCEDURE GetStringLength(s : ARRAY OF CHAR; fnt : Fonts.Font): INTEGER; Returns the length of the string s when written with font fnt. "Frame" PROCEDURE Frame(f : Display.Frame; col, x, y, w, h, fw, mode : INTEGER); Draws a outlined rectangle with bottomleft corner at x, y with width w and height h using color col in mode mode. If f # NIL then the frame is clipped against f. The outline is drawn with width fw. "Frame3" PROCEDURE Frame3(f : Display.Frame; x, y, w, h : INTEGER); Draws a outlined rectangle in 3D mode with its bottomleft corner at x, y with width w and height h. If f # NIL then the frame is clipped against f. "ReplPattern" PROCEDURE ReplPattern(f : Display.Frame; col : INTEGER; pat : LONGINT; x, y, w, h, xp, yp, mode : INTEGER); Replicates the pattern pat over the destination x, y, w, h with color col and mode mode. If f # NIL then the pattern is clipped against f. "Area" PROCEDURE Area(f : Display.Frame; col, lightcol, x, y, w, h, fw : INTEGER; filled, deep : BOOLEAN); Draws a 3D area with its bottomleft corner at x, y and width w and height h with border with fw in color col. The light sided border is drawn with color lightcol. If filled = FALSE then only the border is drawn. If deep = TRUE the area is drawn lowered otherwise its drawn elevated. If f # NIL then the Area is clipped against f. "KSyntax10b.Scn.Fnt  * MarkElemsAllocMq48FoldElemsNewh8 0^O88  8#8 V/>88 V/'848  588 :88^88  I8Q(8 W/V8;8 Z/Z88 X/8[8 [/U8b8 X/88 Y/088 &e;8v8 &e+88  W88 |qW8l8MODULE GUtils; (* CE  *) (* portions by Markus Knasmller*) IMPORT Display, Display1, Fonts, Oberon, Printer, TextPrinter; CONST grey1* = 12; grey2* = 13; grey3* = 14; black* = 15; white* = 0; (** color codes *) left* = 0; center* = 1; right* = 2; (** alignment *) printer* = 1; display* = 2; (** devices *) VAR pUnit, dUnit : LONGINT; device- : INTEGER; (* printer or display *) (** returns val depending on the device *) PROCEDURE Unit* (val : LONGINT; isDisplayUnit : BOOLEAN) : INTEGER; BEGIN IF device = printer THEN IF isDisplayUnit THEN RETURN SHORT(val DIV pUnit) ELSE RETURN SHORT(val * dUnit DIV pUnit) END ELSE (* display *) IF isDisplayUnit THEN RETURN SHORT(val DIV dUnit) ELSE RETURN SHORT(val) END END END Unit; PROCEDURE GetChar (f: Fonts.Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: LONGINT); VAR fno : SHORTINT; pdx : LONGINT; BEGIN IF device = display THEN Display.GetChar(f.raster, ch, dx, x, y, w, h, p) ELSE fno := TextPrinter.FontNo(f); TextPrinter.GetChar(fno, pUnit, ch, pdx, dx, x, y, w, h, p); END END GetChar; PROCEDURE SetDevice* (dev : INTEGER); BEGIN device := dev END SetDevice; PROCEDURE ReplConstD (f: Display.Frame; col, x, y, w, h, mode: INTEGER); BEGIN IF f # NIL THEN Display.ReplConstC (f, col, x, y, w, h, mode) ELSE Display.ReplConst (col, x, y, w, h, mode) END END ReplConstD; PROCEDURE ReplConstP (col, x, y, w, h : INTEGER); BEGIN Printer.ReplConst(x, y, w, h) END ReplConstP; PROCEDURE ReplConst*(f : Display.Frame; col, x, y, w, h, mode : INTEGER); BEGIN IF device = display THEN ReplConstD(f, col, x, y, w, h, mode) ELSE ReplConstP(col, x, y, w, h) END END ReplConst; PROCEDURE Line* (f : Display.Frame; col, X0, Y0, X1, Y1, mode : INTEGER); BEGIN IF device = printer THEN Printer.Line(X0, Y0, X1, Y1) ELSE Display1.Line(f, col, X0, Y0, X1, Y1, mode) END END Line; PROCEDURE CopyPatternD (f: Display.Frame; col: INTEGER; pat: LONGINT; x, y, mode: INTEGER); BEGIN IF f # NIL THEN Display.CopyPatternC (f, col, pat, x, y, mode) ELSE Display.CopyPattern (col, pat, x, y, mode) END END CopyPatternD; PROCEDURE CopyPattern* (f : Display.Frame; col : INTEGER; pat : LONGINT; x, y, mode : INTEGER); BEGIN IF device = display THEN CopyPatternD(f, col, pat, x, y, mode) ELSE (*Printer.ReplPattern(x, y, w, h, pat)*) END END CopyPattern; PROCEDURE CheckString (s: ARRAY OF CHAR; x, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER); VAR i, cx, cy, cw, ch, dx, x0: INTEGER; pat: LONGINT; cond: BOOLEAN; BEGIN i := 0; x0 := x; cond := TRUE; WHILE (s[i] # 0X) & (cond) DO GetChar(fnt, s[i], dx, cx, cy, cw, ch, pat); IF x + dx <= x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END END; ret := (w - (x - x0)); let := i END CheckString; (*PROCEDURE CheckPString (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER); VAR fno: SHORTINT; i, cx, cy, cw, ch, dx, x0: INTEGER; pat, pdx: LONGINT; cond: BOOLEAN; BEGIN fno := TextPrinter.FontNo (fnt); i := 0; x0 := x; cond := TRUE; WHILE (s[i] # 0X) & (cond) DO TextPrinter.GetChar (fno, pUnit, s[i], pdx, dx, cx, cy, cw, ch, pat); IF x + dx < x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END END; ret := (w - (x - x0)); let := i END CheckPString;*) PROCEDURE StringD (f: Display.Frame; s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; col, mode: INTEGER; align: INTEGER); VAR i, let, cx, cy, cw, ch, dx: INTEGER; pat: LONGINT; BEGIN IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END; CheckString (s, x, w, fnt, cx, let); (*ret := cx DIV 2;*) IF align = left THEN cx := 0 ELSIF align = center THEN cx := cx DIV 2; END; INC (x, cx); FOR i := 0 TO let - 1 DO GetChar (fnt, s[i], dx, cx, cy, cw, ch, pat); IF f = NIL THEN Display.CopyPattern(col, pat, x + cx, y + cy, mode) ELSE Display.CopyPatternC(f, col, pat, x + cx, y + cy, mode) END; INC (x, dx) END END StringD; PROCEDURE StringP (s: ARRAY OF CHAR; x, y, w, color: INTEGER; fnt: Fonts.Font; align: INTEGER); VAR i, let, cx: INTEGER; mystr: ARRAY 62 OF CHAR; BEGIN CheckString (s, x, w, fnt, cx, let); (*ret := cx DIV 2; *) IF align = left THEN cx := 0 ELSIF align = center THEN cx := cx DIV 2; END; INC (x, cx); FOR i := 0 TO let - 1 DO mystr[i] := s[i] END; mystr[let] := 0X; Printer.String (x, y, mystr, fnt.name); END StringP; PROCEDURE String* (f : Display.Frame; s : ARRAY OF CHAR; x, y, w : INTEGER; fnt : Fonts.Font; col, mode : INTEGER; align : INTEGER); BEGIN IF device = display THEN StringD(f, s, x, y, w, fnt, col, mode, align) ELSE StringP(s, x, y, w, col, fnt, align) END END String; PROCEDURE GetStringLength* (s : ARRAY OF CHAR; fnt : Fonts.Font): INTEGER; VAR i, x, dx, cx, cy, cw, ch: INTEGER; pat: LONGINT; BEGIN i := 0; x := 0; WHILE (s[i] # 0X) DO GetChar (fnt, s[i], dx, cx, cy, cw, ch, pat); INC (x, dx); INC (i) END; RETURN x END GetStringLength; PROCEDURE Frame* (f : Display.Frame; col, x, y, w, h, fw, mode : INTEGER);  BEGIN IF w < 0 THEN INC(x, w); w := ABS(w) END; IF h < 0 THEN INC(y, h); h := ABS(h) END; IF 2 * fw < w THEN ReplConst(f, col, x, y, fw, h, mode); ReplConst(f, col, x + w - fw, y, fw, h, mode); ReplConst(f, col, x + fw, y, w - 2*fw, fw, mode); ReplConst(f, col, x + fw, y + h - fw, w - 2*fw, fw, mode); ELSE ReplConst(f, col, x, y, w, h, mode) END END Frame; PROCEDURE Frame3* (f : Display.Frame; x, y, w, h : INTEGER); BEGIN IF w < 0 THEN INC(x, w); w := ABS(w) END; IF h < 0 THEN INC(y, h); h := ABS(h) END; IF (w > 4) & (h > 4) THEN ReplConst(f, black, x, y, 1, h, Display.paint); ReplConst(f, black, x + 1, y + h - 1, w - 3, 1, Display.paint); ReplConst(f, white, x + 1, y, 1, h - 1, Display.paint); ReplConst(f, white, x + 1, y + h - 2, w - 4, 1, Display.paint); ReplConst(f, white, x + 2, y, w - 3, 1, Display.paint); ReplConst(f, white, x + w - 1, y, 1, h, Display.paint); ReplConst(f, black, x + 2, y + 1, w - 4, 1, Display.paint); ReplConst(f, black, x + w - 2, y + 2, 1, h - 2, Display.paint); ELSIF (w >1) & (h > 1) THEN IF w > h THEN ReplConst(f, black, x, y + 1, w - 1, 1, Display.paint); ReplConst(f, white, x, y, w, 1, Display.paint); ReplConst(f, white, x + w - 1, y + 1, 1, 1, Display.paint) ELSE ReplConst(f, black, x, y, 1, h - 1, Display.paint); ReplConst(f, white, x + 1, y, 1, h, Display.paint); ReplConst(f, white, x, y, 1, 1, Display.paint) END; END END Frame3; PROCEDURE ReplPattern* (f : Display.Frame; col : INTEGER; pat : LONGINT; x, y, w, h, xp, yp, mode : INTEGER); BEGIN IF f = NIL THEN Display.ReplPattern (col, pat, x, y, w, h, mode) ELSE Display.ReplPatternC (f, col, pat, x, y, w, h, xp, yp, mode) END END ReplPattern; PROCEDURE Area* (f : Display.Frame; col, lightcol, x, y, w, h, fw : INTEGER; filled, deep : BOOLEAN);  VAR lt, rb, i : INTEGER; BEGIN IF deep THEN lt := black; rb := lightcol ELSE lt := lightcol; rb := black END; IF device = printer THEN Frame(f, col, x, y, w, h, 2, 1) ELSE IF filled & (device = display) THEN ReplConst(f, col, x, y, w, h, Display.paint) END; IF 2 * fw < w THEN FOR i := 0 TO fw - 1 DO ReplConst(f, lt, x + i, y + i, 1, h - i, Display.paint); ReplConst(f, lt, x + fw, y + h - i - 1, w - fw - i - 1, 1, Display.paint); ReplConst(f, rb, x + i, y + i, w - fw - i + 1, 1, Display.paint); ReplConst(f, rb, x + w - i - 1, y, 1, h - i, Display.paint) END END END END Area; BEGIN device := display; pUnit := TextPrinter.Unit; dUnit := Display.Unit; END GUtils. Display.CopyPattern Display.ReplPatternC