********************************************************************
* NOTE: This file is generated automatically from the event
* definition file Binpack.evt.
********************************************************************
<* PRAGMA LL *>
MODULE BinpackmyviewObliqView ;
<*NOWARN*> IMPORT ObLibM3, ObLibUI, SynWr, Obliq, ObliqParser, Rd;
<*NOWARN*> IMPORT IntList, Filter, BinpackAux, Fmt;
<*NOWARN*> IMPORT BinpackViewClass, RealList, ObLibAnim, ZFmt;
<*NOWARN*> IMPORT ZeusPanel, ObValue, TextWr, View, VBT, Thread;
<*NOWARN*> IMPORT TextRd, Rsrc;
CONST
ViewName = "myview.obl";
TYPE
T = BinpackViewClass.T BRANDED OBJECT
object : Obliq.Val;
env : Obliq.Env;
wr : TextWr.T;
swr : SynWr.T;
parser : ObliqParser.T;
OVERRIDES
<* LL.sup < VBT.mu *>
startrun := Startrun;
<* LL.sup < VBT.mu *>
oeSetup := Setup;
oeNewWeight := NewWeight;
oePack := Pack;
oeIgnore := Ignore;
oeProbe := Probe;
<* LL.sup = VBT.mu *>
ueRepackBin := RepackBin;
END;
OUTPUT and UPDATE event handling methods:
PROCEDURE Setup (view: T; nBins, nWts: INTEGER) =
<* LL.sup < VBT.mu *>
BEGIN
IF FieldDefined(view.object, "Setup") THEN
Invoke (view, "Setup", ""
& Fmt.Int(nBins)
& ","
& Fmt.Int(nWts)
)
END
END Setup;
PROCEDURE NewWeight (view: T; id: INTEGER; wt: REAL) =
<* LL.sup < VBT.mu *>
BEGIN
IF FieldDefined(view.object, "NewWeight") THEN
Invoke (view, "NewWeight", ""
& Fmt.Int(id)
& ","
& Fmt.Real(wt)
)
END
END NewWeight;
PROCEDURE Pack (view: T; bin: INTEGER; total: REAL) =
<* LL.sup < VBT.mu *>
BEGIN
IF FieldDefined(view.object, "Pack") THEN
Invoke (view, "Pack", ""
& Fmt.Int(bin)
& ","
& Fmt.Real(total)
)
END
END Pack;
PROCEDURE Ignore (view: T; ) =
<* LL.sup < VBT.mu *>
BEGIN
IF FieldDefined(view.object, "Ignore") THEN
Invoke (view, "Ignore", ""
)
END
END Ignore;
PROCEDURE Probe (view: T; bin: INTEGER; total: REAL) =
<* LL.sup < VBT.mu *>
BEGIN
IF FieldDefined(view.object, "Probe") THEN
Invoke (view, "Probe", ""
& Fmt.Int(bin)
& ","
& Fmt.Real(total)
)
END
END Probe;
PROCEDURE RepackBin (view: T; bin: INTEGER; old, new: IntList.T; amts: RealList.T) =
<* LL = VBT.mu *>
BEGIN
IF FieldDefined(view.object, "RepackBin") THEN
Invoke (view, "RepackBin", ""
& Fmt.Int(bin)
& ","
& BinpackAux.IntListToText(old)
& ","
& BinpackAux.IntListToText(new)
& ","
& BinpackAux.RealListToText(amts)
)
END
END RepackBin;
PROCEDURE RegisterView () =
BEGIN
ZeusPanel.RegisterView(New, "myview.obl", "Binpack")
END RegisterView;
PROCEDURE New (): View.T =
BEGIN
RETURN NEW(T).init(NIL)
END New;
CONST
ObliqStackSizeMultiplier = 8;
TYPE
Closure = Thread.SizedClosure OBJECT
view: T;
OVERRIDES
apply := ForkedStartrun;
END;
PROCEDURE Startrun (view: T) =
<* LL.sup < VBT.mu *>
BEGIN
EVAL
Thread.Join(
Thread.Fork(
NEW(Closure, view := view,
stackSize := ObliqStackSizeMultiplier * Thread.GetDefaultStackSize())));
END Startrun;
PROCEDURE ForkedStartrun (cl: Closure): REFANY =
VAR rd: Rd.T; view := cl.view;
BEGIN
IF view.parser = NIL THEN
view.wr := TextWr.New();
view.swr := SynWr.New(view.wr);
view.parser := ObliqParser.New(view.swr);
END;
view.object := NIL;
TRY
rd := Rsrc.Open(ViewName, ZeusPanel.GetPath());
view.env := ParseRd(view.parser, ViewName, rd);
WITH obj = Obliq.Lookup("view", view.env) DO
IF NOT ISTYPE(obj, ObValue.ValObj) THEN
ZeusPanel.ReportError(
"not an Obliq object in '" & ViewName & "'")
ELSIF FieldDefined (obj, "graphvbt") THEN
WITH graphvbt =
NARROW(Obliq.ObjectSelect(obj, "graphvbt"),
ObLibAnim.ValGraph).vbt DO
LOCK VBT.mu DO
EVAL Filter.Replace(view, graphvbt)
END
END;
view.object := obj;
ELSIF FieldDefined (obj, "rectsvbt") THEN
WITH rectsvbt =
NARROW(Obliq.ObjectSelect(obj, "rectsvbt"),
ObLibAnim.ValRects).vbt DO
LOCK VBT.mu DO
EVAL Filter.Replace(view, rectsvbt)
END
END;
view.object := obj;
ELSIF FieldDefined (obj, "formsvbt") THEN
WITH formsvbt =
NARROW(Obliq.ObjectSelect(obj, "formsvbt"),
ObLibUI.ValForm).vbt DO
LOCK VBT.mu DO
EVAL Filter.Replace(view, formsvbt)
END
END;
view.object := obj;
ELSE
ZeusPanel.ReportError(
"cannot find 'graphvbt', 'rectsvbt', or 'formsvbt' in '" & ViewName & "'")
END
END
EXCEPT
| Rsrc.NotFound =>
ZeusPanel.ReportError("cannot find '" & ViewName & "'")
| ObValue.Error (packet) => OblError(view, packet)
| ObValue.Exception (packet) => OblException(view, packet)
END;
RETURN NIL;
END ForkedStartrun;
PROCEDURE ParseRd (p: ObliqParser.T; name: TEXT; rd: Rd.T):
Obliq.Env RAISES {ObValue.Error, ObValue.Exception} =
VAR env := Obliq.EmptyEnv();
BEGIN
ObliqParser.ReadFrom(p, name, rd, TRUE);
TRY
LOOP
EVAL ObliqParser.EvalPhrase(p, ObliqParser.ParsePhrase(p), env)
END
EXCEPT
ObliqParser.Eof => (* clean exit of loop *)
END;
RETURN env
END ParseRd;
PROCEDURE Invoke (view: T; event, args: TEXT) =
VAR
exp := "view." & event & "(" & args & ");";
name := "Zeus Event <" & event & ">";
BEGIN
ObliqParser.ReadFrom (view.parser, name, TextRd.New(exp), FALSE);
TRY
EVAL Obliq.EvalTerm(ObliqParser.ParseTerm(view.parser), view.env)
EXCEPT
| ObliqParser.Eof => <* ASSERT FALSE *>
| ObValue.Error (packet) => OblError(view, packet)
| ObValue.Exception (packet) => OblException(view, packet)
END
END Invoke;
PROCEDURE FieldDefined (object: Obliq.Val; event: TEXT): BOOLEAN =
BEGIN
TRY
RETURN object # NIL AND Obliq.ObjectHas(object, event)
EXCEPT
| ObValue.Error =>
| ObValue.Exception =>
END;
RETURN FALSE
END FieldDefined;
PROCEDURE OblError (view: T; packet: ObValue.ErrorPacket) =
BEGIN
Obliq.ReportError(view.swr, packet);
ZeusPanel.ReportError(
"Obliq error: " & TextWr.ToText(view.wr))
END OblError;
PROCEDURE OblException (view: T; packet: ObValue.ExceptionPacket) =
BEGIN
Obliq.ReportException(view.swr, packet);
ZeusPanel.ReportError(
"Obliq exception: " & TextWr.ToText(view.wr))
END OblException;
BEGIN
SynWr.Setup();
ObliqParser.PackageSetup();
ObLibM3.PackageSetup();
ObLibUI.PackageSetup();
ObLibAnim.PackageSetup();
RegisterView ();
END BinpackmyviewObliqView.