home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system1 / dialogsliders.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  15KB  |  348 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 3 May 95
  6. Syntax10b.Scn.Fnt
  7. ParcElems
  8. Alloc
  9. MODULE DialogSliders;
  10.     (** Christian Mayrhofer, Markus Knasm
  11. ller 25 May 94 -  
  12.     IMPORT DialogFrames, Dialogs, DialogTexts, Display, Files, GraphicUtils, In, Input, Oberon, TextFrames, Texts, Viewers;
  13.     CONST MM = 1; ML = 0; MR = 2; white = 0; grey1 = 12; grey2 = 13; grey3 = 14; black = 15; downW = 9; 
  14.                 patternCol* = grey3; backCol* = white; W* = 20; H* = 70;
  15.     TYPE
  16.         Item* = POINTER TO ItemDesc;
  17.         ItemDesc* = RECORD (Dialogs.ObjectDesc)
  18.             sliderdY*: INTEGER;     (** position of the small bar inside *) 
  19.             delta*: INTEGER;        (** slightest possible change of the bar *)
  20.         END;
  21.         MoveSliderMsg = RECORD (Display.FrameMsg)
  22.             s: Item; 
  23.             x, y, dY: INTEGER;
  24.             pressed: BOOLEAN;
  25.         END;
  26.     VAR 
  27.         hBgPat*, vBgPat*: Display.Pattern;
  28.         downArrow*, upArrow*, leftArrow*, rightArrow*: Display.Pattern;
  29.         downArrowImage, upArrowImage, Hpat, Vpat: ARRAY 9 OF SET;
  30.         leftArrowImage, rightArrowImage: ARRAY 20 OF SET;
  31.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  32.     BEGIN IF x > y THEN RETURN y ELSE RETURN x END
  33.     END Min;
  34.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  35.     BEGIN IF x > y THEN RETURN x ELSE RETURN y END
  36.     END Max;
  37.     PROCEDURE (s: Item) Copy* (VAR dup: Dialogs.Object);
  38.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  39.         VAR x: Item; 
  40.     BEGIN IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; s.Copy^ (dup); x.delta := s.delta; 
  41.     END Copy;
  42.     PROCEDURE (s: Item) Load* (VAR r: Files.Rider);
  43.     (** reads the object from rider r *)
  44.     BEGIN s.Load^(r); Files.ReadInt(r, s.delta); s.sliderdY := 0
  45.     END Load;
  46.     PROCEDURE (s: Item) Store* (VAR r: Files.Rider);
  47.     (** writes the object to rider r *)
  48.     BEGIN s.Store^(r); Files.WriteInt(r, s.delta)
  49.     END Store;    
  50.     PROCEDURE (s: Item) Init*;
  51.     (** initialies the object, should be called after allocating the object with NEW *)
  52.     BEGIN s.Init^; s.delta := 1
  53.     END Init;
  54.     PROCEDURE (s: Item) DrawButton (f: Display.Frame; pr : BOOLEAN; but: Display.Pattern; x, y, w, mode : INTEGER);
  55.         VAR i: INTEGER; 
  56.     BEGIN
  57.         i := (w - downW) DIV 2; 
  58.         GraphicUtils.DrawPatternBox (f, pr, but, x, y, w, w, i, i, mode)
  59.     END DrawButton;
  60.     PROCEDURE (s: Item) PrintButton (but: Display.Pattern; x, y, w: INTEGER);
  61.         VAR i: INTEGER;
  62.     BEGIN
  63.         i := (w - downW) DIV 2; i := SHORT (i * Dialogs.dUnit DIV Dialogs.pUnit);
  64.         GraphicUtils.PrintPatternBox (but, x, y, w, w, i, i)
  65.     END PrintButton;
  66.     PROCEDURE (s: Item) CalculatesH (): INTEGER;
  67.         VAR x, y, w, h: INTEGER;
  68.     BEGIN
  69.         s.GetDim (x, y, w, h); RETURN (Min (w, h) + Min (w,h) DIV 2)
  70.     END CalculatesH;
  71.     PROCEDURE (s: Item) MaxValue* (): INTEGER;
  72.     (** returns the highest possible value of sliderdY *)
  73.         VAR x, y, w, h: INTEGER;
  74.     BEGIN
  75.         s.GetDim (x, y, w, h); 
  76.         x := Max (w, h) - 2 * Min (w, h);
  77.         RETURN Max (x, 0)
  78.     END MaxValue;
  79.     PROCEDURE (s: Item) Arrow* (down: BOOLEAN): Display.Pattern;
  80.     (** returns the pattern for the up or down arrow (depending on down) *)
  81.         VAR x, y, w, h: INTEGER;
  82.     BEGIN
  83.         s.GetDim (x, y, w, h);
  84.         IF w > h THEN
  85.             IF down THEN RETURN (rightArrow) ELSE RETURN (leftArrow) END
  86.         ELSE
  87.             IF down THEN RETURN (downArrow) ELSE RETURN (upArrow) END
  88.         END
  89.     END Arrow;
  90.     PROCEDURE (s: Item) DrawSlider* (f: Display.Frame; pressed : BOOLEAN; x, y, w, h, mode : INTEGER);
  91.     (** displays the slider of the item at (x, y) in frame f *)
  92.         VAR sdY, sH: INTEGER;
  93.     BEGIN
  94.         sdY := s.sliderdY; sH := s.CalculatesH ();
  95.         Display.ReplConstC (f, backCol, x, y , w, h, Display.replace);
  96.         IF h > w THEN
  97.             Display.ReplPatternC (f, patternCol, vBgPat, x, y, w, h, 0, 0, mode);
  98.             IF sH <= h THEN GraphicUtils.DrawBox (f, pressed, x, y + sdY, w, sH, mode) END
  99.         ELSE    
  100.             Display.ReplPatternC (f, patternCol, hBgPat, x, y, w, h, 0, 0, mode);
  101.             IF sH <= w THEN GraphicUtils.DrawBox (f, pressed, x + sdY, y, sH, h, mode) END
  102.         END
  103.     END DrawSlider;
  104.     PROCEDURE (s: Item) PrintSlider* (x, y, w, h: INTEGER);
  105.     (** prints the slider of the item at printer coordinates (x, y) *)
  106.         VAR sdY, sH: INTEGER;
  107.     BEGIN
  108.         sdY := SHORT (s.sliderdY * Dialogs.dUnit DIV Dialogs.pUnit); 
  109.         sH := SHORT (s.CalculatesH () * Dialogs.dUnit DIV Dialogs.pUnit); 
  110.         GraphicUtils.PrintBox (x, y, w, h);
  111.         IF h > w THEN
  112.             IF sH <= h THEN GraphicUtils.PrintBox (x, y + sdY, w, sH) END
  113.         ELSE
  114.             IF sH <= w THEN GraphicUtils.PrintBox (x + sdY, y, sH, h) END
  115.         END
  116.     END PrintSlider;
  117.     PROCEDURE (s: Item) CheckdY* (VAR dY: INTEGER);
  118.     (** checks whether dY is a possible value for sliderdY *)
  119.         VAR x, y, w, h, sH: INTEGER;
  120.     BEGIN
  121.         s.GetDim (x, y, w, h); sH := s.CalculatesH (); 
  122.         IF w > h THEN
  123.             w := w - 2 * h; dY := Max (0, dY); dY := Min (dY, w - sH)
  124.         ELSE
  125.             h := h - 2 * w; dY := Max (0, dY); dY := Min (dY, h - sH)
  126.         END
  127.     END CheckdY;
  128.     PROCEDURE (s: Item) Change (delta: INTEGER; pressed: BOOLEAN; x, y: INTEGER);
  129.         VAR msg: MoveSliderMsg; dY: INTEGER;
  130.     BEGIN
  131.         dY := s.sliderdY + delta; s.CheckdY (dY);  
  132.         msg.s := s; msg.dY := dY; msg.x := x; msg.y := y; msg.pressed := pressed; Viewers.Broadcast (msg);
  133.         s.sliderdY := dY; 
  134.     END Change;
  135.     PROCEDURE (s: Item) TrackButton* (f: Display.Frame; x, y, w, mx, my: INTEGER; VAR keysum : SET; down: BOOLEAN);
  136.     (** handles mouse events concerning the button *)
  137.         VAR pressed, oldpressed, first: BOOLEAN; keys : SET; arrow: Display.Pattern; i: LONGINT;
  138.     BEGIN
  139.         pressed := FALSE; first := TRUE;
  140.         REPEAT
  141.             oldpressed := pressed; pressed := (x <= mx) & (mx <= x + w) & (y <= my) & (my <=  y + w);
  142.             arrow := s.Arrow (down);
  143.             IF oldpressed # pressed THEN s.DrawButton (f, pressed, arrow, x, y, w, Display.paint) END;
  144.             IF pressed & ((keysum = {MM}) OR (keysum = {ML}) OR (keysum = {MR}))THEN 
  145.                 i := Oberon.Time(); WHILE Oberon.Time () - i < 300 DO END; first := FALSE;
  146.                 IF down THEN s.Change (- s.delta, FALSE, 0, 0) ELSE s.Change (s.delta, FALSE, 0, 0) END
  147.             END;
  148.             Input.Mouse(keys, mx, my); keysum := keysum + keys
  149.         UNTIL keys = {};
  150.         IF pressed THEN s.DrawButton(f, FALSE, arrow, x, y, w, Display.paint) END
  151.     END TrackButton;
  152.     PROCEDURE (s: Item) MoveSlider* (f: Display.Frame; pressed: BOOLEAN; dY: INTEGER);
  153.     (** changes the position of the bar to dY *)
  154.         VAR i, sdY, x, y, w, h, sH: INTEGER; 
  155.     BEGIN
  156.         sdY := s.sliderdY; sH := s.CalculatesH (); s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
  157.         IF w > h THEN x := x + h; w := w - 2 * h ELSE y := y + w; h := h - 2 * w END; 
  158.         IF sH > Max (w, h) THEN RETURN END;
  159.         IF w > h THEN
  160.             IF dY > sdY THEN i := x + sdY ELSE i := x + dY + sH END; 
  161.             Display.ReplConstC (f, backCol, i, y, ABS (dY - sdY), h, Display.replace);
  162.             Display.ReplPatternC (f, patternCol, hBgPat, i, y, ABS (dY - sdY), h, 0, 0, Display.paint);
  163.             GraphicUtils.DrawBox (f, pressed, x + dY, y, sH, h, Display.paint)
  164.         ELSE
  165.             IF dY > sdY THEN i := y + sdY ELSE i := y + dY + sH END;
  166.             Display.ReplConstC (f, backCol, x, i, w, ABS (dY - sdY) , Display.replace);
  167.             Display.ReplPatternC (f, patternCol,vBgPat, x, i, w, ABS (dY - sdY), 0, 0 , Display.paint);
  168.             GraphicUtils.DrawBox (f, pressed, x, y + dY, w, sH, Display.paint)
  169.         END    
  170.     END MoveSlider;
  171.     PROCEDURE (s: Item) TrackSlider (f: Display.Frame; x, y, w, h, mx, my : INTEGER; VAR keysum : SET);
  172.         VAR pressed, oldPressed: BOOLEAN; keys: SET; sH, dY, dYOld, x0, y0, w0, h0: INTEGER; 
  173.     BEGIN
  174.         sH := s.CalculatesH (); dYOld := s.sliderdY; pressed := FALSE; s.GetDim (x0, y0, w0, h0);
  175.         REPEAT
  176.             IF h0 > w0 THEN dY := my - y - sH ELSE dY := mx - x - sH END; 
  177.             s.CheckdY (dY); 
  178.             oldPressed := pressed; pressed := (x <= mx) & (mx <= x + w) & (y <= my) & (my <= y + h);
  179.             IF oldPressed # pressed THEN
  180.                 IF h > w THEN GraphicUtils.DrawBox (f, pressed, x, y + s.sliderdY, w, sH, Display.paint)
  181.                 ELSE GraphicUtils.DrawBox (f, pressed, x + s.sliderdY, y, sH, h, Display.paint)
  182.                 END
  183.             ELSIF dY # s.sliderdY THEN
  184.                 s.Change (dY - s.sliderdY, pressed, x, y);
  185.             END;
  186.              Input.Mouse(keys, mx, my); keysum := keysum + keys;
  187.         UNTIL keys = {};
  188.         IF (keysum = {MM}) OR (keysum = {MR}) OR (keysum = {ML}) OR (dYOld = s.sliderdY) THEN
  189.             IF pressed THEN s.Restore END; 
  190.         ELSE
  191.             s.Change (dYOld - s.sliderdY, FALSE, 0, 0);
  192.         END
  193.     END TrackSlider;
  194.     PROCEDURE (s: Item) TrackScrollBar* (f: Display.Frame; mx, my : INTEGER; keys : SET);
  195.     (** handles mouse events concerning the full scrollbar *)
  196.         VAR x, y, w, h : INTEGER; t1: Texts.Text;
  197.     BEGIN
  198.         s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
  199.         IF ((keys = {MM}) OR (keys = {ML}) OR (keys = {MR})) & (Max (w, h) >= 2 * Min (w, h)) THEN    
  200.             Oberon.RemoveMarks (x, y, w, h);
  201.             IF w > h THEN
  202.                 IF mx < x + h THEN s.TrackButton (f, x, y, h, mx, my, keys, TRUE)
  203.                 ELSIF mx >= x + w - h THEN s.TrackButton (f, x + w - h, y, h, mx, my, keys, FALSE)
  204.                 ELSIF w >= 2 * Min (w, h) + s.CalculatesH () THEN
  205.                     s.TrackSlider (f, x + h, y, w - 2 * h, h, mx, my, keys)
  206.                 END 
  207.             ELSE
  208.                 IF my < y + w THEN s.TrackButton (f, x, y, w, mx, my, keys, TRUE)
  209.                 ELSIF my >= y + h - w THEN s.TrackButton (f, x, y + h - w, w, mx, my, keys, FALSE)
  210.                 ELSIF h >= 2 * Min (w, h) + s.CalculatesH () THEN 
  211.                     s.TrackSlider (f, x, y + w, w, h - 2 * w, mx, my, keys)
  212.                 END
  213.             END;
  214.             IF (keys = {MM}) OR (keys = {ML}) OR (keys = {MR}) & (s.cmd[0] # 0X) THEN
  215.                 DialogTexts.GetParText (s.par, s.panel, t1);
  216.                 s.CallCmd (f, Viewers.This (x,y), t1)
  217.             END
  218.         END
  219.     END TrackScrollBar;
  220.     PROCEDURE (s: Item) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  221.     (** handles messages which were sent to frame f *)
  222.         VAR x, y, w, h: INTEGER; pressed: BOOLEAN;
  223.     BEGIN
  224.         s.Handle^ (f, msg);
  225.         WITH f : DialogFrames.Frame DO
  226.             WITH msg : Oberon.InputMsg DO
  227.                 IF msg.id = Oberon.track THEN 
  228.                     s.TrackScrollBar (f, msg.X, msg.Y, msg.keys); Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y) 
  229.                 END
  230.             | msg: MoveSliderMsg DO
  231.                 IF msg.s = s THEN 
  232.                     s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
  233.                     pressed :=  
  234.                         ((h > w) & (x = msg.x) & (y + w = msg.y) OR (w > h) & (x + h = msg.x) & (y = msg.y)) & msg.pressed;
  235.                     s.MoveSlider (f, pressed, msg.dY)
  236.                 END
  237.             ELSE
  238.             END
  239.         ELSE
  240.         END
  241.     END Handle;
  242.     PROCEDURE (s: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  243.     (** displays the object at (x, y) in frame f *)
  244.         VAR x0, y0, w, h, mode: INTEGER; bgPat, up, down: Display.Pattern;
  245.     BEGIN
  246.         IF s.selected THEN mode := Display.invert ELSE mode := Display.paint END;
  247.         s.GetDim(x0, y0, w, h); 
  248.         up := s.Arrow (FALSE); down := s.Arrow (TRUE);
  249.         IF w > h THEN bgPat := hBgPat ELSE bgPat := vBgPat END;
  250.         IF (Max (w, h) >=  2 * Min (w, h)) & (Min (w, h) >= downW + 5) THEN
  251.             IF w > h THEN
  252.                 s.DrawButton (f, FALSE, down, x, y, h, mode);
  253.                 s.DrawSlider (f, FALSE, x + h, y, w - 2 * h, h, mode);
  254.                 s.DrawButton (f, FALSE, up, x + w - h, y, h, mode)
  255.             ELSE
  256.                 s.DrawButton (f, FALSE, up, x, y + h - w, w, mode);
  257.                 s.DrawSlider (f, FALSE, x, y + w, w, h - 2 * w, mode);
  258.                 s.DrawButton (f, FALSE, down, x, y, w, mode)
  259.             END
  260.         ELSE
  261.             Display.ReplConstC (f, backCol, x, y, w, h, Display.replace); 
  262.             Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, mode) 
  263.         END 
  264.     END Draw;
  265.     PROCEDURE (s: Item) Print* (x, y: INTEGER);
  266.     (** prints the object at printer coordinates (x, y) *)
  267.         VAR x0, y0, w, h: INTEGER; up, down: Display.Pattern;
  268.     BEGIN
  269.         s.GetPDim (x0, y0, w, h);
  270.         up := s.Arrow (FALSE); down := s.Arrow (TRUE);
  271.         IF (Max (w, h) >= 2 * Min (w, h)) & (Min (w, h) >= downW + 5) THEN
  272.             IF w > h THEN
  273.                 s.PrintButton (down, x, y, h);
  274.                 s.PrintSlider (x + h, y, w - 2 * h, h);
  275.                 s.PrintButton (up, x + w - h, y, h)
  276.             ELSE
  277.                 s.PrintButton (up, x, y + h - w, w);
  278.                 s.PrintSlider (x, y + w, w, h - 2 * w);
  279.                 s.PrintButton (down, x, y, w)
  280.             END
  281.         ELSE
  282.             GraphicUtils.PrintBox (x, y, w, h)
  283.         END
  284.     END Print; 
  285.     PROCEDURE (s: Item) SetdY* (dY: INTEGER);
  286.     (** sets sliderdY to the new value dy *)
  287.     BEGIN
  288.         s.CheckdY (dY); s.sliderdY := dY; s.Hide; s.Restore
  289.     END SetdY;
  290.     PROCEDURE Insert*;
  291.     (** Insert ([name] [x y w h] | ^ ) inserts a slider - item in the panel containing the caret position *)
  292.         VAR x, y, x1, y1, w, h: INTEGER; p : Dialogs.Panel; s: Item; name: ARRAY 64 OF CHAR;
  293.     BEGIN
  294.         NEW (s); 
  295.         DialogFrames.GetCaretPosition (p, x, y);
  296.         IF (p # NIL) THEN
  297.             s.Init; In.Open; In.Name (name);
  298.             IF ~In.Done THEN COPY ("", name); In.Open END;
  299.             s.SetName (name); 
  300.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  301.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  302.             ELSE
  303.                 IF w < 0 THEN w := W END;
  304.                 IF h < 0 THEN h := H END
  305.             END;
  306.             s.SetDim (x1, y1, w, h, FALSE); p.Insert (s, FALSE)
  307.         ELSE
  308.             Dialogs.res := Dialogs.noPanelSelected
  309.         END;
  310.         IF Dialogs.res # 0 THEN Dialogs.Error ("DialogSliders") END;
  311.     END Insert;
  312. BEGIN
  313.     Vpat[0] := {};    Hpat[0] := {};
  314.     Vpat[1] := {0,3,4,7,8,11,12,15};    Hpat[1] := {0,4,8,12};
  315.     Vpat[2] := {};    Hpat[2] := {2,6,10,14};
  316.     Vpat[3] := {1,2,5,6,9,10,13,14};    Hpat[3] := {2,6,10,14};
  317.     Vpat[4] := {};    Hpat[4] := {0,4,8,12};
  318.     Vpat[5] := {0,3,4,7,8,11,12,15};    Hpat[5] := {0,4,8,12};
  319.     Vpat[6] := {};    Hpat[6] := {2,6,10,14};
  320.     Vpat[7] := {1,2,5,6,9,10,13,14};    Hpat[7] := {2,6,10,14};
  321.     Vpat[8] := {};    Hpat[8] := {0,4,8,12};
  322.     vBgPat := Display.NewPattern (Vpat,16, 8);
  323.     hBgPat := Display.NewPattern (Hpat,16, 8);
  324.     upArrowImage[0] := {};    downArrowImage[0] := {};    
  325.     upArrowImage[1] := {2..6};    downArrowImage[8] := {2..6};
  326.     upArrowImage[2] := {2..6};    downArrowImage[7] := {2..6};
  327.     upArrowImage[3] := {2..6};    downArrowImage[6] := {2..6}; 
  328.     upArrowImage[4] := {0..8};    downArrowImage[5] := {0..8};
  329.     upArrowImage[5] := {1..7};    downArrowImage[4] := {1..7};
  330.     upArrowImage[6] := {2..6};    downArrowImage[3] := {2..6};
  331.     upArrowImage[7] := {3..5};    downArrowImage[2] := {3..5};
  332.     upArrowImage[8] := {4};    downArrowImage[1] := {4};
  333.     upArrow := Display.NewPattern (upArrowImage, 9, 8);
  334.     downArrow := Display.NewPattern (downArrowImage, 9, 8);
  335.     leftArrowImage[0] := {};    rightArrowImage[0] := {};
  336.     leftArrowImage[1] := {3};    rightArrowImage[9] := {4};
  337.     leftArrowImage[2] := {3,4};    rightArrowImage[8] := {3,4};
  338.     leftArrowImage[3] := {0..5};    rightArrowImage[7] := {2..7};
  339.     leftArrowImage[4] := {0..6};    rightArrowImage[6] := {1..7};
  340.     leftArrowImage[5] := {0..7};    rightArrowImage[5] := {0..7};
  341.     leftArrowImage[6] := {0..6};    rightArrowImage[4] := {1..7};
  342.     leftArrowImage[7] := {0..5};    rightArrowImage[3] := {2..7};
  343.     leftArrowImage[8] := {3,4};    rightArrowImage[2] := {3,4};
  344.     leftArrowImage[9] := {3};    rightArrowImage[1] := {4};
  345.     leftArrow := Display.NewPattern (leftArrowImage, 8, 9);
  346.     rightArrow := Display.NewPattern (rightArrowImage, 8, 9)
  347. END DialogSliders.
  348.