MODULE ObxLines;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
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.