Obx/Mod/Lines.odc

MODULE ObxLines;
(**
	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 Stores, Ports, Models, Views, Controllers, Properties;

	CONST minVersion = 0; maxVersion = 0;

	TYPE
		Line = POINTER TO RECORD
			next: Line;
			x0, y0, x1, y1: INTEGER
		END;

		Model = POINTER TO RECORD (Models.Model)
			lines: Line
		END;

		View = POINTER TO RECORD (Views.View)
			color: Ports.Color;
			model: Model
		END;

		UpdateMsg = RECORD (Models.UpdateMsg)
			l, t, r, b: INTEGER
		END;

		LineOp = POINTER TO RECORD (Stores.Operation)
			model: Model;
			line: Line
		END;

		ColorOp = POINTER TO RECORD (Stores.Operation)
			view: View;
			color: Ports.Color
		END;


	PROCEDURE GetBox (x0, y0, x1, y1: INTEGER; VAR l, t, r, b: INTEGER);
	BEGIN
		IF x0 > x1 THEN l := x1; r := x0 ELSE l := x0; r := x1 END;
		IF y0 > y1 THEN t := y1; b := y0 ELSE t := y0; b := y1 END;
		INC(r, Ports.point); INC(b, Ports.point)
	END GetBox;


	PROCEDURE (op: LineOp) Do;
		VAR l: Line; msg: UpdateMsg;
	BEGIN
		l := op.line;
		IF l # op.model.lines THEN	(* insert op.line *)
			ASSERT(l # NIL, 100); ASSERT(l.next = op.model.lines, 101);
			op.model.lines := l
		ELSE	(* delete op.line *)
			ASSERT(l = op.model.lines, 102);
			op.model.lines := l.next
		END;
		GetBox(l.x0, l.y0, l.x1, l.y1, msg.l, msg.t, msg.r, msg.b); Models.Broadcast(op.model, msg)
	END Do;

	PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER; x0: INTEGER; p: Line;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN
			rd.ReadInt(x0); m.lines := NIL;
			WHILE x0 # MIN(INTEGER) DO
				NEW(p); p.next := m.lines; m.lines := p;
				p.x0 := x0; rd.ReadInt(p.y0); rd.ReadInt(p.x1); rd.ReadInt(p.y1);
				rd.ReadInt(x0)
			END
		END
	END Internalize;

	PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
		VAR p: Line;
	BEGIN
		wr.WriteVersion(maxVersion);
		p := m.lines;
		WHILE p # NIL DO
			wr.WriteInt(p.x0); wr.WriteInt(p.y0); wr.WriteInt(p.x1); wr.WriteInt(p.y1);
			p := p.next
		END;
		wr.WriteInt(MIN(INTEGER))
	END Externalize;

	PROCEDURE (m: Model) CopyFrom (source: Stores.Store);
	BEGIN
		m.lines := source(Model).lines	(* lines are immutable and thus can be shared *)
	END CopyFrom;

	PROCEDURE (m: Model) Insert (x0, y0, x1, y1: INTEGER), NEW;
		VAR op: LineOp; p: Line;
	BEGIN
		NEW(op); op.model := m;
		NEW(p); p.next := m.lines; op.line := p;
		p.x0 := x0; p.y0 := y0; p.x1 := x1; p.y1 := y1;
		Models.Do(m, "Insert Line", op)
	END Insert;


	PROCEDURE (op: ColorOp) Do;
		VAR color: Ports.Color;
	BEGIN
		color := op.view.color;	(* save old state *)
		op.view.color := op.color;	(* set new state *)
		Views.Update(op.view, Views.keepFrames);	(* restore everything *)
		op.color := color	(* old state becomes new state for undo *)
	END Do;


	PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
		VAR version: INTEGER; st: Stores.Store;
	BEGIN
		rd.ReadVersion(minVersion, maxVersion, version);
		IF ~rd.cancelled THEN
			rd.ReadInt(v.color);
			rd.ReadStore(st);
			v.model := st(Model)
		END
	END Internalize;

	PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
	BEGIN
		wr.WriteVersion(maxVersion);
		wr.WriteInt(v.color);
		wr.WriteStore(v.model)
	END Externalize;

	PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
	BEGIN
		ASSERT(model IS Model, 20);
		WITH source: View DO
			v.model := model(Model);
			v.color := source.color
		END
	END CopyFromModelView;

	PROCEDURE (v: View) ThisModel (): Models.Model;
	BEGIN
		RETURN v.model
	END ThisModel;

	PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
		VAR p: Line;
	BEGIN
		p := v.model.lines;
		WHILE p # NIL DO
			f.DrawLine(p.x0, p.y0, p.x1, p.y1, f.dot, v.color);
			p := p.next
		END
	END Restore;

	PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);
	BEGIN
		WITH msg: UpdateMsg DO
			Views.UpdateIn(v, msg.l, msg.t, msg.r, msg.b, Views.keepFrames)
		ELSE
		END
	END HandleModelMsg;

	PROCEDURE (v: View) SetColor (color: Ports.Color), NEW;
		VAR op: ColorOp;
	BEGIN
		NEW(op); op.view := v; op.color := color; Views.Do(v, "Set Color", op)
	END SetColor;

	PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
																VAR focus: Views.View);
		VAR x0, y0, x1, y1, x, y, res, l, t, r, b: INTEGER; modifiers: SET; isDown: BOOLEAN;
	BEGIN
		WITH msg: Controllers.TrackMsg DO
			x0 := msg.x; y0 := msg.y; x1 := x0; y1 := y0;
			f.SaveRect(f.l, f.t, f.r, f.b, res);	(* operation was successful if res = 0 *)
			IF res = 0 THEN f.DrawLine(x0, y0, x1, y1, Ports.point, v.color) END;
			REPEAT
				f.Input(x, y, modifiers, isDown);
				IF (x # x1) OR (y # y1) THEN
					GetBox(x0, y0, x1, y1, l, t, r, b); f.RestoreRect(l, t, r, b, Ports.keepBuffer);
					x1 := x; y1 := y;
					IF res = 0 THEN f.DrawLine(x0, y0, x1, y1, Ports.point, v.color) END
				END
			UNTIL ~isDown;
			GetBox(x0, y0, x1, y1, l, t, r, b); f.RestoreRect(l, t, r, b, Ports.disposeBuffer);
			v.model.Insert(x0, y0, x1, y1)
		| msg: Controllers.EditMsg DO
			IF msg.op = Controllers.pasteChar THEN
				CASE msg.char OF
				| "B": v.SetColor(Ports.black)
				| "r": v.SetColor(Ports.red)
				| "g": v.SetColor(Ports.green)
				| "b": v.SetColor(Ports.blue)
				ELSE
				END
			END
		ELSE
		END
	END HandleCtrlMsg;

	PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
	BEGIN
		WITH msg: Properties.FocusPref DO
			msg.setFocus := TRUE
		ELSE
		END
	END HandlePropMsg;


	PROCEDURE Deposit*;
		VAR m: Model; v: View;
	BEGIN
		NEW(m);
		NEW(v); v.model := m; Stores.Join(v, m);
		Views.Deposit(v)
	END Deposit;

END ObxLines.