Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
3 May 95
Syntax10b.Scn.Fnt
ParcElems
Alloc
MODULE DialogSliders;
	(** Christian Mayrhofer, Markus Knasm
ller 25 May 94 -  
	IMPORT DialogFrames, Dialogs, DialogTexts, Display, Files, GraphicUtils, In, Input, Oberon, TextFrames, Texts, Viewers;
	CONST MM = 1; ML = 0; MR = 2; white = 0; grey1 = 12; grey2 = 13; grey3 = 14; black = 15; downW = 9; 
				patternCol* = grey3; backCol* = white; W* = 20; H* = 70;
	TYPE
		Item* = POINTER TO ItemDesc;
		ItemDesc* = RECORD (Dialogs.ObjectDesc)
			sliderdY*: INTEGER; 	(** position of the small bar inside *) 
			delta*: INTEGER;		(** slightest possible change of the bar *)
		END;
		MoveSliderMsg = RECORD (Display.FrameMsg)
			s: Item; 
			x, y, dY: INTEGER;
			pressed: BOOLEAN;
		END;
	VAR 
		hBgPat*, vBgPat*: Display.Pattern;
		downArrow*, upArrow*, leftArrow*, rightArrow*: Display.Pattern;
		downArrowImage, upArrowImage, Hpat, Vpat: ARRAY 9 OF SET;
		leftArrowImage, rightArrowImage: ARRAY 20 OF SET;
	PROCEDURE Min (x, y: INTEGER): INTEGER;
	BEGIN IF x > y THEN RETURN y ELSE RETURN x END
	END Min;
	PROCEDURE Max (x, y: INTEGER): INTEGER;
	BEGIN IF x > y THEN RETURN x ELSE RETURN y END
	END Max;
	PROCEDURE (s: Item) Copy* (VAR dup: Dialogs.Object);
	(** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
		VAR x: Item; 
	BEGIN IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; s.Copy^ (dup); x.delta := s.delta; 
	END Copy;
	PROCEDURE (s: Item) Load* (VAR r: Files.Rider);
	(** reads the object from rider r *)
	BEGIN s.Load^(r); Files.ReadInt(r, s.delta); s.sliderdY := 0
	END Load;
	PROCEDURE (s: Item) Store* (VAR r: Files.Rider);
	(** writes the object to rider r *)
	BEGIN s.Store^(r); Files.WriteInt(r, s.delta)
	END Store;	
	PROCEDURE (s: Item) Init*;
	(** initialies the object, should be called after allocating the object with NEW *)
	BEGIN s.Init^; s.delta := 1
	END Init;
	PROCEDURE (s: Item) DrawButton (f: Display.Frame; pr : BOOLEAN; but: Display.Pattern; x, y, w, mode : INTEGER);
		VAR i: INTEGER; 
	BEGIN
		i := (w - downW) DIV 2; 
		GraphicUtils.DrawPatternBox (f, pr, but, x, y, w, w, i, i, mode)
	END DrawButton;
	PROCEDURE (s: Item) PrintButton (but: Display.Pattern; x, y, w: INTEGER);
		VAR i: INTEGER;
	BEGIN
		i := (w - downW) DIV 2; i := SHORT (i * Dialogs.dUnit DIV Dialogs.pUnit);
		GraphicUtils.PrintPatternBox (but, x, y, w, w, i, i)
	END PrintButton;
	PROCEDURE (s: Item) CalculatesH (): INTEGER;
		VAR x, y, w, h: INTEGER;
	BEGIN
		s.GetDim (x, y, w, h); RETURN (Min (w, h) + Min (w,h) DIV 2)
	END CalculatesH;
	PROCEDURE (s: Item) MaxValue* (): INTEGER;
	(** returns the highest possible value of sliderdY *)
		VAR x, y, w, h: INTEGER;
	BEGIN
		s.GetDim (x, y, w, h); 
		x := Max (w, h) - 2 * Min (w, h);
		RETURN Max (x, 0)
	END MaxValue;
	PROCEDURE (s: Item) Arrow* (down: BOOLEAN): Display.Pattern;
	(** returns the pattern for the up or down arrow (depending on down) *)
		VAR x, y, w, h: INTEGER;
	BEGIN
		s.GetDim (x, y, w, h);
		IF w > h THEN
			IF down THEN RETURN (rightArrow) ELSE RETURN (leftArrow) END
		ELSE
			IF down THEN RETURN (downArrow) ELSE RETURN (upArrow) END
		END
	END Arrow;
	PROCEDURE (s: Item) DrawSlider* (f: Display.Frame; pressed : BOOLEAN; x, y, w, h, mode : INTEGER);
	(** displays the slider of the item at (x, y) in frame f *)
		VAR sdY, sH: INTEGER;
	BEGIN
		sdY := s.sliderdY; sH := s.CalculatesH ();
		Display.ReplConstC (f, backCol, x, y , w, h, Display.replace);
		IF h > w THEN
			Display.ReplPatternC (f, patternCol, vBgPat, x, y, w, h, 0, 0, mode);
			IF sH <= h THEN GraphicUtils.DrawBox (f, pressed, x, y + sdY, w, sH, mode) END
		ELSE	
			Display.ReplPatternC (f, patternCol, hBgPat, x, y, w, h, 0, 0, mode);
			IF sH <= w THEN GraphicUtils.DrawBox (f, pressed, x + sdY, y, sH, h, mode) END
		END
	END DrawSlider;
	PROCEDURE (s: Item) PrintSlider* (x, y, w, h: INTEGER);
	(** prints the slider of the item at printer coordinates (x, y) *)
		VAR sdY, sH: INTEGER;
	BEGIN
		sdY := SHORT (s.sliderdY * Dialogs.dUnit DIV Dialogs.pUnit); 
		sH := SHORT (s.CalculatesH () * Dialogs.dUnit DIV Dialogs.pUnit); 
		GraphicUtils.PrintBox (x, y, w, h);
		IF h > w THEN
			IF sH <= h THEN GraphicUtils.PrintBox (x, y + sdY, w, sH) END
		ELSE
			IF sH <= w THEN GraphicUtils.PrintBox (x + sdY, y, sH, h) END
		END
	END PrintSlider;
	PROCEDURE (s: Item) CheckdY* (VAR dY: INTEGER);
	(** checks whether dY is a possible value for sliderdY *)
		VAR x, y, w, h, sH: INTEGER;
	BEGIN
		s.GetDim (x, y, w, h); sH := s.CalculatesH (); 
		IF w > h THEN
			w := w - 2 * h; dY := Max (0, dY); dY := Min (dY, w - sH)
		ELSE
			h := h - 2 * w; dY := Max (0, dY); dY := Min (dY, h - sH)
		END
	END CheckdY;
	PROCEDURE (s: Item) Change (delta: INTEGER; pressed: BOOLEAN; x, y: INTEGER);
		VAR msg: MoveSliderMsg; dY: INTEGER;
	BEGIN
		dY := s.sliderdY + delta; s.CheckdY (dY);  
		msg.s := s; msg.dY := dY; msg.x := x; msg.y := y; msg.pressed := pressed; Viewers.Broadcast (msg);
		s.sliderdY := dY; 
	END Change;
	PROCEDURE (s: Item) TrackButton* (f: Display.Frame; x, y, w, mx, my: INTEGER; VAR keysum : SET; down: BOOLEAN);
	(** handles mouse events concerning the button *)
		VAR pressed, oldpressed, first: BOOLEAN; keys : SET; arrow: Display.Pattern; i: LONGINT;
	BEGIN
		pressed := FALSE; first := TRUE;
		REPEAT
			oldpressed := pressed; pressed := (x <= mx) & (mx <= x + w) & (y <= my) & (my <=  y + w);
			arrow := s.Arrow (down);
			IF oldpressed # pressed THEN s.DrawButton (f, pressed, arrow, x, y, w, Display.paint) END;
			IF pressed & ((keysum = {MM}) OR (keysum = {ML}) OR (keysum = {MR}))THEN 
				i := Oberon.Time(); WHILE Oberon.Time () - i < 300 DO END; first := FALSE;
				IF down THEN s.Change (- s.delta, FALSE, 0, 0) ELSE s.Change (s.delta, FALSE, 0, 0) END
			END;
			Input.Mouse(keys, mx, my); keysum := keysum + keys
		UNTIL keys = {};
		IF pressed THEN s.DrawButton(f, FALSE, arrow, x, y, w, Display.paint) END
	END TrackButton;
	PROCEDURE (s: Item) MoveSlider* (f: Display.Frame; pressed: BOOLEAN; dY: INTEGER);
	(** changes the position of the bar to dY *)
		VAR i, sdY, x, y, w, h, sH: INTEGER; 
	BEGIN
		sdY := s.sliderdY; sH := s.CalculatesH (); s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
		IF w > h THEN x := x + h; w := w - 2 * h ELSE y := y + w; h := h - 2 * w END; 
		IF sH > Max (w, h) THEN RETURN END;
		IF w > h THEN
			IF dY > sdY THEN i := x + sdY ELSE i := x + dY + sH END; 
			Display.ReplConstC (f, backCol, i, y, ABS (dY - sdY), h, Display.replace);
			Display.ReplPatternC (f, patternCol, hBgPat, i, y, ABS (dY - sdY), h, 0, 0, Display.paint);
			GraphicUtils.DrawBox (f, pressed, x + dY, y, sH, h, Display.paint)
		ELSE
			IF dY > sdY THEN i := y + sdY ELSE i := y + dY + sH END;
			Display.ReplConstC (f, backCol, x, i, w, ABS (dY - sdY) , Display.replace);
			Display.ReplPatternC (f, patternCol,vBgPat, x, i, w, ABS (dY - sdY), 0, 0 , Display.paint);
			GraphicUtils.DrawBox (f, pressed, x, y + dY, w, sH, Display.paint)
		END	
	END MoveSlider;
	PROCEDURE (s: Item) TrackSlider (f: Display.Frame; x, y, w, h, mx, my : INTEGER; VAR keysum : SET);
		VAR pressed, oldPressed: BOOLEAN; keys: SET; sH, dY, dYOld, x0, y0, w0, h0: INTEGER; 
	BEGIN
		sH := s.CalculatesH (); dYOld := s.sliderdY; pressed := FALSE; s.GetDim (x0, y0, w0, h0);
		REPEAT
			IF h0 > w0 THEN dY := my - y - sH ELSE dY := mx - x - sH END; 
			s.CheckdY (dY); 
			oldPressed := pressed; pressed := (x <= mx) & (mx <= x + w) & (y <= my) & (my <= y + h);
			IF oldPressed # pressed THEN
				IF h > w THEN GraphicUtils.DrawBox (f, pressed, x, y + s.sliderdY, w, sH, Display.paint)
				ELSE GraphicUtils.DrawBox (f, pressed, x + s.sliderdY, y, sH, h, Display.paint)
				END
			ELSIF dY # s.sliderdY THEN
				s.Change (dY - s.sliderdY, pressed, x, y);
			END;
			 Input.Mouse(keys, mx, my); keysum := keysum + keys;
		UNTIL keys = {};
		IF (keysum = {MM}) OR (keysum = {MR}) OR (keysum = {ML}) OR (dYOld = s.sliderdY) THEN
			IF pressed THEN s.Restore END; 
		ELSE
			s.Change (dYOld - s.sliderdY, FALSE, 0, 0);
		END
	END TrackSlider;
	PROCEDURE (s: Item) TrackScrollBar* (f: Display.Frame; mx, my : INTEGER; keys : SET);
	(** handles mouse events concerning the full scrollbar *)
		VAR x, y, w, h : INTEGER; t1: Texts.Text;
	BEGIN
		s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
		IF ((keys = {MM}) OR (keys = {ML}) OR (keys = {MR})) & (Max (w, h) >= 2 * Min (w, h)) THEN	
			Oberon.RemoveMarks (x, y, w, h);
			IF w > h THEN
				IF mx < x + h THEN s.TrackButton (f, x, y, h, mx, my, keys, TRUE)
				ELSIF mx >= x + w - h THEN s.TrackButton (f, x + w - h, y, h, mx, my, keys, FALSE)
				ELSIF w >= 2 * Min (w, h) + s.CalculatesH () THEN
					s.TrackSlider (f, x + h, y, w - 2 * h, h, mx, my, keys)
				END 
			ELSE
				IF my < y + w THEN s.TrackButton (f, x, y, w, mx, my, keys, TRUE)
				ELSIF my >= y + h - w THEN s.TrackButton (f, x, y + h - w, w, mx, my, keys, FALSE)
				ELSIF h >= 2 * Min (w, h) + s.CalculatesH () THEN 
					s.TrackSlider (f, x, y + w, w, h - 2 * w, mx, my, keys)
				END
			END;
			IF (keys = {MM}) OR (keys = {ML}) OR (keys = {MR}) & (s.cmd[0] # 0X) THEN
				DialogTexts.GetParText (s.par, s.panel, t1);
				s.CallCmd (f, Viewers.This (x,y), t1)
			END
		END
	END TrackScrollBar;
	PROCEDURE (s: Item) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
	(** handles messages which were sent to frame f *)
		VAR x, y, w, h: INTEGER; pressed: BOOLEAN;
	BEGIN
		s.Handle^ (f, msg);
		WITH f : DialogFrames.Frame DO
			WITH msg : Oberon.InputMsg DO
				IF msg.id = Oberon.track THEN 
					s.TrackScrollBar (f, msg.X, msg.Y, msg.keys); Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y) 
				END
			| msg: MoveSliderMsg DO
				IF msg.s = s THEN 
					s.GetDim (x, y, w, h); x := x + f.X; y := y + f.Y + f.H;
					pressed :=  
						((h > w) & (x = msg.x) & (y + w = msg.y) OR (w > h) & (x + h = msg.x) & (y = msg.y)) & msg.pressed;
					s.MoveSlider (f, pressed, msg.dY)
				END
			ELSE
			END
		ELSE
		END
	END Handle;
	PROCEDURE (s: Item) Draw* (x, y: INTEGER; f: Display.Frame);
	(** displays the object at (x, y) in frame f *)
		VAR x0, y0, w, h, mode: INTEGER; bgPat, up, down: Display.Pattern;
	BEGIN
		IF s.selected THEN mode := Display.invert ELSE mode := Display.paint END;
		s.GetDim(x0, y0, w, h); 
		up := s.Arrow (FALSE); down := s.Arrow (TRUE);
		IF w > h THEN bgPat := hBgPat ELSE bgPat := vBgPat END;
		IF (Max (w, h) >=  2 * Min (w, h)) & (Min (w, h) >= downW + 5) THEN
			IF w > h THEN
				s.DrawButton (f, FALSE, down, x, y, h, mode);
				s.DrawSlider (f, FALSE, x + h, y, w - 2 * h, h, mode);
				s.DrawButton (f, FALSE, up, x + w - h, y, h, mode)
			ELSE
				s.DrawButton (f, FALSE, up, x, y + h - w, w, mode);
				s.DrawSlider (f, FALSE, x, y + w, w, h - 2 * w, mode);
				s.DrawButton (f, FALSE, down, x, y, w, mode)
			END
		ELSE
			Display.ReplConstC (f, backCol, x, y, w, h, Display.replace); 
			Display.ReplPatternC (f, patternCol, bgPat, x, y, w, h, 0, 0, mode) 
		END 
	END Draw;
	PROCEDURE (s: Item) Print* (x, y: INTEGER);
	(** prints the object at printer coordinates (x, y) *)
		VAR x0, y0, w, h: INTEGER; up, down: Display.Pattern;
	BEGIN
		s.GetPDim (x0, y0, w, h);
		up := s.Arrow (FALSE); down := s.Arrow (TRUE);
		IF (Max (w, h) >= 2 * Min (w, h)) & (Min (w, h) >= downW + 5) THEN
			IF w > h THEN
				s.PrintButton (down, x, y, h);
				s.PrintSlider (x + h, y, w - 2 * h, h);
				s.PrintButton (up, x + w - h, y, h)
			ELSE
				s.PrintButton (up, x, y + h - w, w);
				s.PrintSlider (x, y + w, w, h - 2 * w);
				s.PrintButton (down, x, y, w)
			END
		ELSE
			GraphicUtils.PrintBox (x, y, w, h)
		END
	END Print; 
	PROCEDURE (s: Item) SetdY* (dY: INTEGER);
	(** sets sliderdY to the new value dy *)
	BEGIN
		s.CheckdY (dY); s.sliderdY := dY; s.Hide; s.Restore
	END SetdY;
	PROCEDURE Insert*;
	(** Insert ([name] [x y w h] | ^ ) inserts a slider - item in the panel containing the caret position *)
		VAR x, y, x1, y1, w, h: INTEGER; p : Dialogs.Panel; s: Item; name: ARRAY 64 OF CHAR;
	BEGIN
		NEW (s); 
		DialogFrames.GetCaretPosition (p, x, y);
		IF (p # NIL) THEN
			s.Init; In.Open; In.Name (name);
			IF ~In.Done THEN COPY ("", name); In.Open END;
			s.SetName (name); 
			In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
			IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
			ELSE
				IF w < 0 THEN w := W END;
				IF h < 0 THEN h := H END
			END;
			s.SetDim (x1, y1, w, h, FALSE); p.Insert (s, FALSE)
		ELSE
			Dialogs.res := Dialogs.noPanelSelected
		END;
		IF Dialogs.res # 0 THEN Dialogs.Error ("DialogSliders") END;
	END Insert;
BEGIN
	Vpat[0] := {};	Hpat[0] := {};
	Vpat[1] := {0,3,4,7,8,11,12,15};	Hpat[1] := {0,4,8,12};
	Vpat[2] := {};	Hpat[2] := {2,6,10,14};
	Vpat[3] := {1,2,5,6,9,10,13,14};	Hpat[3] := {2,6,10,14};
	Vpat[4] := {};	Hpat[4] := {0,4,8,12};
	Vpat[5] := {0,3,4,7,8,11,12,15};	Hpat[5] := {0,4,8,12};
	Vpat[6] := {};	Hpat[6] := {2,6,10,14};
	Vpat[7] := {1,2,5,6,9,10,13,14};	Hpat[7] := {2,6,10,14};
	Vpat[8] := {};	Hpat[8] := {0,4,8,12};
	vBgPat := Display.NewPattern (Vpat,16, 8);
	hBgPat := Display.NewPattern (Hpat,16, 8);
	upArrowImage[0] := {};	downArrowImage[0] := {};	
	upArrowImage[1] := {2..6};	downArrowImage[8] := {2..6};
	upArrowImage[2] := {2..6};	downArrowImage[7] := {2..6};
	upArrowImage[3] := {2..6};	downArrowImage[6] := {2..6}; 
	upArrowImage[4] := {0..8};	downArrowImage[5] := {0..8};
	upArrowImage[5] := {1..7};	downArrowImage[4] := {1..7};
	upArrowImage[6] := {2..6};	downArrowImage[3] := {2..6};
	upArrowImage[7] := {3..5};	downArrowImage[2] := {3..5};
	upArrowImage[8] := {4};	downArrowImage[1] := {4};
	upArrow := Display.NewPattern (upArrowImage, 9, 8);
	downArrow := Display.NewPattern (downArrowImage, 9, 8);
	leftArrowImage[0] := {};	rightArrowImage[0] := {};
	leftArrowImage[1] := {3};	rightArrowImage[9] := {4};
	leftArrowImage[2] := {3,4};	rightArrowImage[8] := {3,4};
	leftArrowImage[3] := {0..5};	rightArrowImage[7] := {2..7};
	leftArrowImage[4] := {0..6};	rightArrowImage[6] := {1..7};
	leftArrowImage[5] := {0..7};	rightArrowImage[5] := {0..7};
	leftArrowImage[6] := {0..6};	rightArrowImage[4] := {1..7};
	leftArrowImage[7] := {0..5};	rightArrowImage[3] := {2..7};
	leftArrowImage[8] := {3,4};	rightArrowImage[2] := {3,4};
	leftArrowImage[9] := {3};	rightArrowImage[1] := {4};
	leftArrow := Display.NewPattern (leftArrowImage, 8, 9);
	rightArrow := Display.NewPattern (rightArrowImage, 8, 9)
END DialogSliders.