home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / graphicutils.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  12KB  |  278 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 30 Dec 95
  6. Syntax10b.Scn.Fnt
  7. FoldElems
  8. MODULE GraphicUtils;
  9.     (** Markus Knasm
  10. ller 9 Aug 94 - 
  11.     IMPORT Display, Display1, Fonts, Input, Oberon, Printer, TextFrames, TextPrinter, Texts;
  12.     CONST 
  13.         grey1* = 12; grey2* = 13; grey3* = 14; black* = 15; white* = 0;
  14.         CR = 0DX; MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR};
  15.         left* = 0; center* = 1; right* = 2; (** alignment *)
  16.         ehm = 4; evm = 3;    (* element: horizontal margin, vertical margin*)
  17.         mhm = 5; mvm = 2; 
  18.         delay = 150;  (* for scrolling *)
  19.     VAR dUnit*, pUnit*: LONGINT;  (** for device independent coordinates *)
  20.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  21.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  22.     END Min;
  23.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  24.     BEGIN IF x > y THEN RETURN x ELSE RETURN y END
  25.     END Max;
  26.     PROCEDURE ReplConstC (f: Display.Frame; col, x, y, w, h, mode: INTEGER);
  27.     BEGIN
  28.         IF f # NIL THEN
  29.             Display.ReplConstC (f, col, x, y, w, h, mode)
  30.         ELSE
  31.             Display.ReplConst (col, x, y, w, h, mode)
  32.         END
  33.     END ReplConstC;
  34.     PROCEDURE CopyPatternC (f: Display.Frame; col: INTEGER; pat: LONGINT; x, y, mode: INTEGER);
  35.     BEGIN
  36.         IF f # NIL THEN
  37.             Display.CopyPatternC (f, col, pat, x, y, mode)
  38.         ELSE
  39.             Display.CopyPattern (col, pat, x, y, mode)
  40.         END
  41.     END CopyPatternC;
  42.     PROCEDURE CheckString (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER);
  43.         VAR i, cx, cy, cw, ch, dx, x0: INTEGER; pat: LONGINT; cond: BOOLEAN; 
  44.     BEGIN
  45.         i := 0; x0 := x; cond := TRUE;        
  46.         WHILE (s[i] # 0X) & (cond) DO
  47.             Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
  48.             IF x + dx < x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END
  49.         END;
  50.         ret := (w - (x - x0)); let := i
  51.     END CheckString;
  52.     PROCEDURE DrawString* (f: Display.Frame; s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; mode: INTEGER; 
  53.             align: INTEGER; VAR ret: INTEGER);
  54.         VAR i, let, cx, cy, cw, ch, dx: INTEGER; cond: BOOLEAN; pat: LONGINT;
  55.     BEGIN 
  56.         IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
  57.         CheckString (s, x, y, w, fnt, cx, let);  ret := cx DIV 2;
  58.         IF align = left THEN cx := 0
  59.         ELSIF align = center THEN cx := cx DIV 2;
  60.         END;
  61.         INC (x, cx); 
  62.         FOR i := 0 TO let - 1 DO
  63.             Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
  64.             Display.CopyPatternC (f, black, pat, x + cx, y + cy, mode);
  65.             INC (x, dx)
  66.         END
  67.     END DrawString;
  68.     PROCEDURE GetStringLength* (s: ARRAY OF CHAR; fnt: Fonts.Font): INTEGER;
  69.         VAR i, x, dx, cx, cy, cw, ch: INTEGER; pat: LONGINT;
  70.     BEGIN
  71.         i := 0; x := 0;
  72.         WHILE (s[i] # 0X) DO
  73.             Display.GetChar (fnt.raster, s[i], dx, cx, cy, cw, ch, pat);
  74.             INC (x, dx); INC (i)
  75.         END;
  76.         RETURN x
  77.     END GetStringLength;
  78.     PROCEDURE CheckPString (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; VAR ret, let: INTEGER);
  79.         VAR fno: SHORTINT; i, cx, cy, cw, ch, dx, x0: INTEGER; pat, pdx: LONGINT; cond: BOOLEAN; 
  80.     BEGIN
  81.         fno := TextPrinter.FontNo (fnt);
  82.         i := 0; x0 := x; cond := TRUE;        
  83.         WHILE (s[i] # 0X) & (cond) DO
  84.             TextPrinter.GetChar (fno, pUnit, s[i], pdx, dx, cx, cy, cw, ch, pat);
  85.             IF x + dx < x0 + w THEN INC (x, dx); INC (i) ELSE cond := FALSE END
  86.         END;
  87.         ret := (w - (x - x0)); let := i
  88.     END CheckPString;
  89.     PROCEDURE PrintString* (s: ARRAY OF CHAR; x, y, w: INTEGER; fnt: Fonts.Font; align: INTEGER; VAR ret: INTEGER);
  90.         VAR i, let, cx: INTEGER; mystr: ARRAY 62 OF CHAR; 
  91.     BEGIN
  92.         CheckPString (s, x, y, w, fnt, cx, let); ret := cx DIV 2;    
  93.         IF align = left THEN cx := 0
  94.         ELSIF align = center THEN cx := cx DIV 2;
  95.         END;
  96.         INC (x, cx); 
  97.         FOR i := 0 TO let - 1 DO mystr[i] := s[i] END;
  98.         mystr[let] := 0X;
  99.         Printer.String (x, y, mystr, fnt.name);
  100.     END PrintString;
  101.     PROCEDURE DrawBox* (f: Display.Frame; pressed: BOOLEAN; x, y, w, h: INTEGER; mode: INTEGER);
  102.     BEGIN
  103.         IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
  104.         IF (w <= 4) OR (h <= 4) THEN
  105.             Display.ReplConstC (f, grey3, x, y, w, Min (h, 2), mode)
  106.         ELSE 
  107.             IF pressed THEN
  108.                 Display.ReplConstC (f, grey1, x, y, w, h, mode);
  109.                 Display.ReplConstC (f, grey3, x, y + 2, w - 2, h - 2, mode);
  110.                 Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
  111.                 Display.DotC (f, grey3, x, y + 1, mode);
  112.                 Display.DotC (f, grey3, x + w - 2, y + h - 1, mode);
  113.             ELSE
  114.                 Display.ReplConstC (f, grey3, x, y, w, h, mode);
  115.                 Display.ReplConstC (f, grey1, x, y + 2, w - 2, h - 2, mode);
  116.                 Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
  117.                 Display.DotC (f, grey1, x, y + 1, mode);
  118.                 Display.DotC (f, grey1, x + w - 2, y + h - 1, mode);
  119.             END
  120.         END
  121.     END DrawBox;
  122.     PROCEDURE PrintBox* (x, y, w, h: INTEGER);
  123.     BEGIN
  124.         Printer.ReplConst (x, y, w, 2);
  125.         Printer.ReplConst (x + w - 2, y + 2, 2, h - 2);
  126.         Printer.ReplConst (x, y + 2, 2, h - 2);
  127.         Printer.ReplConst (x + 2, y + h - 2, w -  4, 2);
  128.         Printer.Circle (x, y + 1, 0);
  129.         Printer.Circle (x + w - 2, y + h - 1, 0)
  130.     END PrintBox;
  131.     PROCEDURE DrawPatternBox* (f: Display.Frame; pressed: BOOLEAN; pat: Display.Pattern; x, y, w, h, pX, pY, mode: INTEGER);
  132.         lowerCol, upperCol : INTEGER;
  133.     BEGIN
  134.         IF f # NIL THEN Oberon.RemoveMarks(f.X, f.Y, f.W, f.H) END;
  135.         IF pressed THEN
  136.             lowerCol := grey1; upperCol := grey3; INC(pX); DEC(pY)
  137.         ELSE
  138.             lowerCol := grey3; upperCol := grey1
  139.         END;
  140.         Display.ReplConstC (f, lowerCol, x, y, w, 2, mode);
  141.         Display.ReplConstC (f, lowerCol, x + w - 2, y + 2, 2, h - 2, mode);
  142.         Display.ReplConstC (f, upperCol, x, y + 2, 2, h - 2, mode);
  143.         Display.ReplConstC (f, upperCol, x + 2, y + h - 2, w - 4, 2, mode);
  144.         Display.DotC (f, upperCol, x, y + 1, mode);
  145.         Display.DotC (f, upperCol, x + w - 2, y + h -1, mode);
  146.         Display.ReplConstC (f, grey2, x + 2, y + 2, w - 4, h - 4, mode);
  147.         IF pat # 0 THEN
  148.             Display.CopyPatternC (f, black, pat, x + pX, y + pY, mode)
  149.         END
  150.     END DrawPatternBox;
  151.     PROCEDURE PrintPatternBox* (pat: Display.Pattern; x, y, w, h, pX, pY: INTEGER);
  152.     (** not yet implemented *)
  153.     BEGIN
  154.         PrintBox (x, y, w, h)
  155.     END PrintPatternBox;
  156.     PROCEDURE Set* (VAR r: Texts.Reader; t: Texts.Text; l: INTEGER);    
  157.     (* sets the reader r in the text t to line l *)
  158.         VAR i: INTEGER; ch: CHAR;
  159.     BEGIN
  160.         Texts.OpenReader (r, t, 0);
  161.         FOR i := 0 TO l - 1 DO
  162.             REPEAT Texts.Read (r, ch) UNTIL ch = CR
  163.         END
  164.     END Set;
  165.     PROCEDURE DrawLine (VAR r: Texts.Reader; f: Display.Frame; x, y, w: INTEGER);    
  166.         VAR e: Texts.Elem; ch: CHAR; dx, x0, y0, w0, h: INTEGER; pat: Display.Pattern; m: TextFrames.DisplayMsg;
  167.     BEGIN
  168.         Texts.Read (r, ch);
  169.         WHILE (w > 0) & ~r.eot & (ch # CR) DO
  170.             IF r.elem # NIL THEN
  171.                 e := r.elem;
  172.                 m.prepare := TRUE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos (r) - 1; 
  173.                 e.handle (e, m); DEC (w, SHORT (e.W DIV TextFrames.Unit));
  174.                 IF w > evm THEN
  175.                     m.prepare := FALSE; m.fnt := r.fnt; m.col := r.col; m.pos := Texts.Pos (r) - 1;
  176.                     m.frame := f; m.X0 := x; m.Y0 := y; m.elemFrame := NIL;
  177.                     e.handle (e, m); INC (x, SHORT (e.W DIV TextFrames.Unit))
  178.                 END
  179.             ELSE
  180.                 Display.GetChar (r.fnt.raster, ch, dx, x0, y0, w0, h, pat); DEC (w, dx);
  181.                 IF w > evm THEN 
  182.                     CopyPatternC (f, r.col, pat, x + x0, y + y0, Display.paint); INC (x, dx)
  183.                 END
  184.             END;
  185.             Texts.Read (r,ch)
  186.         END
  187.     END DrawLine;
  188.     PROCEDURE Flip (f: Display.Frame; menu: Texts.Text; lsp, dsc, x, y, w, h: INTEGER; in: BOOLEAN; sc, cmd: INTEGER);
  189.         VAR r: Texts.Reader; itemH, x1, y1 : INTEGER;
  190.     BEGIN
  191.         IF (cmd >= 0) & (cmd >= sc) THEN
  192.             y1:= y + h - (lsp * (cmd - sc + 1)) - dsc - mvm; y := y1 + dsc - 1; x1 := x + mhm; 
  193.             itemH := lsp + 1; DEC (w, 4); INC (x, 2);
  194.             Oberon.RemoveMarks(x,y,w,h);
  195.             IF in THEN
  196.                 ReplConstC (f, black, x, y, w, 1, Display.replace);
  197.                 ReplConstC (f, black, x + w - 1, y, 1, itemH - 1, Display.replace);
  198.                 ReplConstC (f, white, x, y + 1, 1, itemH - 1, Display.replace);
  199.                 ReplConstC (f, white, x, y + itemH -1, w, 1, Display.replace);
  200.                 ReplConstC (f, grey1, x + 1, y + 1, w - 2, itemH - 2, Display.replace)
  201.             ELSE
  202.                 ReplConstC (f, grey2, x, y, w, itemH, Display.replace)
  203.             END;
  204.             Set (r, menu, cmd); DrawLine (r, f, x1, y1, w)
  205.         END
  206.     END Flip;
  207.     PROCEDURE DrawMenu* (f: Display.Frame; menu: Texts.Text; sc, cmd, x, y, w, h, mode: INTEGER; VAR n, lsp, dsc: INTEGER);
  208.     (** draws the menu with the coordinates x, y, and the dimensions w, h in frame f if f # NIL ; otherwise it is drawn to the screen; 
  209.         computes number of lines, line space & descender of item lines *)
  210.         VAR def, wid, x0, y0, i: INTEGER; r: Texts.Reader;
  211.         PROCEDURE MeasureMenu;
  212.             (* compute number of items, default item, with, line space descender of item lines *)
  213.             VAR r: Texts.Reader; ch, oldCh: CHAR; wid0, dx, x, y, w, h: INTEGER; p: LONGINT;
  214.         BEGIN
  215.             wid := 0; n := 1; lsp := 0; dsc := 0; wid0 := 0; oldCh := 0X; def := -1;
  216.             Texts.OpenReader (r, menu, 0); Texts.Read (r, ch);
  217.             WHILE ~ r.eot DO
  218.                 IF ch = CR THEN wid := Max (wid, wid0); wid0 := 0; INC (n)
  219.                 ELSIF r.elem # NIL THEN
  220.                     lsp := Max (lsp, SHORT (r.elem.H DIV TextFrames.Unit)); 
  221.                     INC (wid, SHORT (r.elem.W DIV TextFrames.Unit))
  222.                 ELSE
  223.                     lsp := Max (lsp, r.fnt.height); dsc := Min (dsc, r.fnt.minY);
  224.                     Display.GetChar (r.fnt.raster, ch, dx, x, y, w, h, p); INC (wid, dx)
  225.                 END;
  226.                 oldCh := ch; Texts.Read (r, ch)
  227.             END;
  228.             IF oldCh = CR THEN DEC (n) END;
  229.             wid := Max (wid, wid0); INC (lsp);
  230.         END MeasureMenu;
  231.     BEGIN
  232.         IF f # NIL THEN Oberon.RemoveMarks (f.X, f.Y, f.W, f.H) END;
  233.         MeasureMenu; y0 := y; x0 := x; 
  234.         ReplConstC (f, black, x0, y0, w, h, mode);
  235.         ReplConstC (f, grey2, x0 + 1, y0 + 1, w - 2, h - 2, Display.replace);
  236.         Set (r, menu, sc); y := y + h - mvm - lsp - dsc; x := x + mhm;
  237.         WHILE (y + dsc >= y0 + mvm + 1) & (~ r.eot) DO
  238.             DrawLine (r, f, x, y, w); DEC (y, lsp); INC (i)
  239.         END;  
  240.         Flip (f, menu, lsp, dsc, x0, y0, w, h, TRUE, sc, cmd) 
  241.     END DrawMenu;
  242.     PROCEDURE TrackMenu* (f: Display.Frame; menu: Texts.Text; x, y, w, h, n, lsp, dsc: INTEGER; VAR sc, cmd: INTEGER);
  243.     (** handles a mouse click into the menu; sc is the first command which is shown in the menu; cmd the selected command *)
  244.         VAR bot, top, dif, newCmd, mx, my: INTEGER; keys, keysum: SET; i: LONGINT;
  245.     BEGIN
  246.         bot := y + mvm; top := y + h - mvm; sc := Max (sc, 0); 
  247.         dif := (h - 2 * mvm - 1) DIV lsp;
  248.         Input.Mouse (keys, mx, my); keysum := {};
  249.         cmd := Max (0, cmd);
  250.         WHILE keys  # {} DO
  251.             keysum := keysum + keys; 
  252.             Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, mx, my);
  253.             newCmd := (top - my) DIV lsp + sc;
  254.             IF (keysum = cancel) OR (cmd = -1) THEN 
  255.                 Flip (f, menu, lsp, dsc, x, y, w, h, FALSE, sc, cmd);
  256.                 cmd := -1
  257.             ELSIF (mx >= x) & (mx <= x + w) & (newCmd >= sc) & (newCmd <= sc + dif - 1) THEN
  258.                 IF (newCmd # cmd) & (newCmd < n)  THEN
  259.                     Flip (f, menu, lsp, dsc, x, y, w, h, FALSE, sc, cmd); 
  260.                     Flip (f, menu, lsp, dsc, x, y, w, h, TRUE, sc, newCmd); 
  261.                     cmd := newCmd;   
  262.                 END
  263.             ELSIF (mx >= x) & (mx <= x + w) & (my > top) & (sc > 0) THEN
  264.                 DEC (sc); DEC (cmd); DrawMenu (f, menu, sc, cmd, x, y, w, h, Display.replace, n, lsp, dsc); 
  265.                 i := Oberon.Time (); WHILE Oberon.Time () - i < delay DO END;
  266.             ELSIF (mx >= x) & (mx <= x + w) & (my < top - dif ) & (cmd < n - 1) THEN
  267.                 INC (sc); INC (cmd); DrawMenu (f, menu, sc, cmd, x, y, w, h, Display.replace, n, lsp, dsc); 
  268.                 i := Oberon.Time (); WHILE Oberon.Time () - i < delay DO END; 
  269.             END;
  270.             Input.Mouse (keys, mx, my); 
  271.         END;
  272.     END TrackMenu;
  273. BEGIN
  274.     dUnit := Display.Unit; pUnit := TextPrinter.Unit;    
  275.     Display.SetColor (11, 230, 230, 230); Display.SetColor (12, 210, 210, 210);
  276.     Display.SetColor (13, 150, 150, 150); Display.SetColor (14, 100, 100, 100);
  277. END GraphicUtils.
  278.