home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / dialogcolorpickers.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  6KB  |  149 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 2 Feb 95
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogColorPickers;
  8.     (** Markus Knasm
  9. ller 16 Sep.94 -  
  10.     IMPORT Bitmaps, DialogFrames, Dialogs, DialogTexts, Display, Display1, GraphicUtils, In, Input, Oberon, TextFrames, Texts, Viewers;
  11.     CONST W* = 20; H* = W; ML = 0; MM = 1; MR = 2; cancel = {ML, MM, MR}; black = 15;
  12.     TYPE
  13.         Item* = POINTER TO ItemDesc;
  14.         ItemDesc* = RECORD(Dialogs.ObjectDesc)
  15.             col*: INTEGER; (** selected color *)
  16.         END;
  17.     PROCEDURE Box (x, y, w, h: INTEGER);
  18.         VAR i: INTEGER;
  19.     BEGIN
  20.         FOR i := 0 TO w DO
  21.             Display.Dot (black, x + i, y, Display.invert);
  22.             Display.Dot  (black, x + i, y + h, Display.invert)
  23.         END;
  24.         FOR i := 1 TO h - 1 DO
  25.             Display.Dot (black, x, y + i, Display.invert);
  26.             Display.Dot (black, x + w, y + i, Display.invert)
  27.         END
  28.     END Box;
  29.     PROCEDURE (c: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  30.     (** displays the object at (x, y) in frame f *)
  31.         VAR x0, y0, w, h, mode: INTEGER; 
  32.     BEGIN
  33.         c.GetDim (x0, y0, w, h); DEC (w); DEC (h);
  34.         IF c.selected THEN mode := Display.invert ELSE mode := Display.paint END;
  35.         Display1.Line (f, black, x, y, x + w, y, mode); Display1.Line (f, black, x + w, y, x + w, y + h, mode);
  36.         Display1.Line (f, black, x, y, x, y + h, mode); Display1.Line (f, black, x, y + h, x + w, y + h, mode);
  37.         Display.ReplConstC (f, c.col, x + 1, y + 1, w - 1, h - 1, mode)
  38.     END Draw;
  39.     PROCEDURE (c: Item) Print* (x, y: INTEGER);
  40.     (** prints the object at printer coordinates (x, y) *)
  41.         VAR x0, y0, w, h: INTEGER;
  42.     BEGIN
  43.         c.GetPDim (x0, y0, w, h);
  44.         GraphicUtils.PrintBox (x, y, w, h)
  45.     END Print;
  46.     PROCEDURE (c: Item) Copy* (VAR dup: Dialogs.Object);
  47.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  48.         VAR x: Item; 
  49.     BEGIN
  50.         IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; 
  51.         c.Copy^ (dup); x.col := c.col;
  52.     END Copy;
  53.     PROCEDURE (c: Item) Show (x, y, w, h: INTEGER; VAR col: INTEGER; VAR keysum: SET);    
  54.         VAR mx, my, top, bot, left, right, newcol: INTEGER; b: Bitmaps.Bitmap; keys: SET;
  55.         PROCEDURE Flip (col: INTEGER);
  56.             VAR x0, y0: INTEGER; 
  57.         BEGIN 
  58.             IF col >= 0 THEN
  59.                 x0 := x + (col MOD 4) * (w DIV 4); y0 := y + h - ((col DIV 4) + 1) * (h DIV 4);
  60.                 Box (x0, y0, w DIV 4, h DIV 4)
  61.             END
  62.         END Flip;
  63.         PROCEDURE DrawColors (x, y, w, h: INTEGER);
  64.             VAR c, i, j: INTEGER;
  65.         BEGIN
  66.             FOR i := 0 TO 3 DO
  67.                 FOR j := 0 TO 3 DO
  68.                     c := i * 4 + j;
  69.                     Display.ReplConst (c, x + (c MOD 4) * w, y + (3 - (c DIV 4)) * h, w, h, Display.paint) 
  70.                 END
  71.             END
  72.         END DrawColors;
  73.     BEGIN
  74.         left := x + 1; right := x + w - 2; bot := y +  1;  top:= y + h - 2; col := c.col;
  75.         Oberon.RemoveMarks (x, y, w, h); Oberon.FadeCursor(Oberon.Mouse);
  76.         (* save background *)
  77.         b := Bitmaps.New (w + 1, h + 1); Bitmaps.CopyBlock (Bitmaps.Disp, b, x, y, w + 1, h + 1, 0, 0, 0);
  78.         DrawColors (x, y, w DIV 4, h DIV 4); 
  79.         REPEAT
  80.             Input.Mouse (keys, mx, my); keysum := keysum + keys; 
  81.             Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, mx, my);
  82.             IF keysum = cancel THEN col := -1
  83.             ELSIF (mx >= left) & (mx <= right) & (my >= bot) & (my <= top) THEN
  84.                 newcol:= 4* ((top - my) DIV (h DIV 4)) + (mx - left) DIV (w DIV 4);
  85.                 IF newcol # col THEN
  86.                     Flip(col); Flip(newcol); col:=newcol
  87.                 END
  88.             ELSE Flip(col); col := -1
  89.             END
  90.         UNTIL keys = {};
  91.         Oberon.FadeCursor(Oberon.Mouse);
  92.         (* restore background *)
  93.         Bitmaps.CopyBlock (b, Bitmaps.Disp, 0, 0, w + 1, h + 1, x, y, 0);
  94.     END Show;
  95.     PROCEDURE (c: Item) Track (x, y: INTEGER; keys: SET; f: Display.Frame; p: Dialogs.Panel);
  96.         VAR t: Texts.Text; ox, oy, ow, oh, col: INTEGER;
  97.     BEGIN
  98.         IF (keys = {MM}) OR (keys = {ML}) OR (keys = {MR}) THEN 
  99.             c.GetDim (ox, oy, ow, oh);
  100.             ox := f.X + ox; oy := f.Y + f.H + oy; ow := 4 * ow; oh := 4 * oh;
  101.             oy := oy - oh; IF (oy < 0) THEN oy := oy + oh * 5 DIV 4 + 1 ELSE DEC (oy) END;
  102.             IF ox + ow > Display.Width THEN ox := ox - ow + ow DIV 4 END;
  103.             c.Show (ox, oy, ow, oh, col, keys);
  104.             IF (col # c.col) & (col >= 0) THEN
  105.                 c.col := col; c.Restore; 
  106.                 IF c.cmd[0] # 0X THEN
  107.                     DialogTexts.GetParText (c.par, c.panel, t); 
  108.                     c.CallCmd (f, Viewers.This (x, y), t)
  109.                 END
  110.             END
  111.         ELSE Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  112.         END
  113.     END Track;    
  114.     PROCEDURE (c: Item) Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
  115.     (** handles messages which were sent to frame f *)
  116.     BEGIN
  117.         c.Handle^ (f, m);
  118.         WITH f: DialogFrames.Frame DO
  119.             WITH m: Oberon.InputMsg DO
  120.                 IF m.id = Oberon.track THEN c.Track (m.X, m.Y, m.keys, f, f.panel) END
  121.             ELSE
  122.             END
  123.         ELSE
  124.         END
  125.     END Handle;
  126.     PROCEDURE Insert*;
  127.     (** Insert ([name] [x y w h] | ^ ) inserts a colorpicker - item in the panel containing the caret position *)
  128.         VAR x, y, x1, y1, w, h: INTEGER; c: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; 
  129.     BEGIN 
  130.         NEW (c); 
  131.         DialogFrames.GetCaretPosition (p, x, y);
  132.         IF (p # NIL) THEN 
  133.             c.Init; c.col := 15; In.Open; In.Name (name);
  134.             IF ~In.Done THEN COPY ("", name); In.Open END;
  135.             c.SetName (name); 
  136.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  137.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  138.             ELSE
  139.                 IF w < 0 THEN w := W END;
  140.                 IF h < 0 THEN h := H END
  141.             END;
  142.             c.SetDim (x1, y1, w, h, FALSE); p.Insert (c, FALSE) 
  143.         ELSE
  144.             Dialogs.res := Dialogs.noPanelSelected
  145.         END;
  146.         IF Dialogs.res # 0 THEN Dialogs.Error ("DialogColorPickers") END;
  147.     END Insert;
  148. END DialogColorPickers.
  149.