Obx/Mod/Ctrls.odc

MODULE ObxCtrls;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT Meta, Dialog, Ports, Stores, Views, Controllers, Properties, Controls;

	CONST
		minVersion = 0; maxVersion = 0;
		arrowUp = 1EX; arrowDown = 1FX;

	TYPE Control = POINTER TO RECORD (Controls.Control) END;

	VAR x*: INTEGER;

	PROCEDURE Paint (c: Control; f: Views.Frame);
		VAR w, h, y, val: INTEGER;
	BEGIN
		c.context.GetSize(w, h);
		IF ~c.disabled & c.item.Valid() THEN
			val := c.item.IntVal();
			IF val < 0 THEN val := 0 ELSIF val > 100 THEN val := 100 END;
			y := f.dot + (h - 2 * f.dot) * (100 - val) DIV 100;
			IF val > 0 THEN f.DrawRect(f.dot, y, w - f.dot, h - f.dot, Ports.fill, Ports.blue) END;
			IF val < 100 THEN f.DrawRect(f.dot, f.dot, w - f.dot, y, Ports.fill, Ports.background) END
		ELSE
			f.DrawRect(f.dot, f.dot, w - f.dot, h - f.dot, Ports.fill, Ports.grey25)
		END;
		f.DrawRect(0, 0, w, h, f.dot, Ports.defaultColor)
	END Paint;

	PROCEDURE ChangeValue (c: Control; f: Views.Frame; new: INTEGER);
		VAR old: INTEGER;
	BEGIN
		old := c.item.IntVal();
		IF new < 0 THEN new := 0 ELSIF new > 100 THEN new := 100 END;
		IF new # old THEN
			c.item.PutIntVal(new);
			Paint(c, f);
			Controls.Notify(c, f, Dialog.changed, old, new)
		END
	END ChangeValue;

	PROCEDURE Track (c: Control; f: Views.Frame; VAR msg: Controllers.TrackMsg);
		VAR x, y, y0, w, h: INTEGER; m: SET; isDown: BOOLEAN;
	BEGIN
		c.context.GetSize(w, h); DEC(h, 2 * f.dot); y0 := -1;
		REPEAT
			f.Input(x, y, m, isDown);
			IF y # y0 THEN
				ChangeValue(c, f, 100 - y * 100 DIV h);
				y0 := y
			END
		UNTIL ~isDown;
	END Track;

	PROCEDURE Edit (c: Control; f: Views.Frame; VAR msg: Controllers.EditMsg);
		VAR val: INTEGER;
	BEGIN
		IF msg.op = Controllers.pasteChar THEN
			val := c.item.IntVal();
			IF msg.char = arrowUp THEN ChangeValue(c, f, val + 1)
			ELSIF msg.char = arrowDown THEN ChangeValue(c, f, val - 1)
			ELSE Dialog.Beep
			END
		END
	END Edit;


	(* Control *)

	PROCEDURE (c: Control) Internalize2 (VAR rd: Stores.Reader);
		VAR version: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version)
	END Internalize2;

	PROCEDURE (c: Control) Externalize2 (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteVersion(maxVersion)
	END Externalize2;

	PROCEDURE (c: Control) Restore (f: Views.Frame; l, t, r, b: INTEGER);
	BEGIN
		Paint(c, f)
	END Restore;

	PROCEDURE (c: Control) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
																	VAR focus: Views.View);
	BEGIN
		IF ~c.disabled & ~c.readOnly & c.item.Valid() THEN
			WITH msg: Controllers.PollCursorMsg DO
				msg.cursor := Ports.graphicsCursor
			| msg: Controllers.TrackMsg DO
				Track(c, f, msg)
			| msg: Controllers.EditMsg DO
				Edit(c, f, msg)
			ELSE
			END
		END
	END HandleCtrlMsg2;

	PROCEDURE (c: Control) HandlePropMsg2 (VAR msg: Properties.Message);
	BEGIN
		WITH msg: Properties.FocusPref DO
			IF ~c.disabled & ~c.readOnly THEN msg.setFocus := TRUE END
		| msg: Properties.SizePref DO
			msg.w := 10 * Ports.mm; msg.h := 50 * Ports.mm
		ELSE
		END
	END HandlePropMsg2;

	PROCEDURE (c: Control) CheckLink (VAR ok: BOOLEAN);
	BEGIN
		IF c.item.typ # Meta.intTyp THEN ok := FALSE END
	END CheckLink;

	PROCEDURE (c: Control) Update (f: Views.Frame; op, from, to: INTEGER);
	BEGIN
		Paint(c, f)
	END Update;


	PROCEDURE New* (p: Controls.Prop): Views.View;
		VAR c: Control;
	BEGIN
		NEW(c); Controls.OpenLink(c, p); RETURN c
	END New;

	PROCEDURE Deposit*;
		VAR p: Controls.Prop;
	BEGIN
		NEW(p); p.link := ""; p.label := ""; p.guard := ""; p.notifier := "";
		Views.Deposit(New(p))
	END Deposit;

	PROCEDURE Guard* (VAR par: Dialog.Par);
	BEGIN
		par.disabled := (x < 0) OR (x > 100)
	END Guard;

END ObxCtrls.

"ObxCtrls.Deposit; StdCmds.PasteView"