********************************************************************
* NOTE: This file is generated automatically from the event * definition file PktRoute.evt. ********************************************************************<* PRAGMA LL *> MODULEOUTPUT and UPDATE event handling methods:; <*NOWARN*> IMPORT TextConv, ObLibM3, ObLibUI, SynWr, Obliq; <*NOWARN*> IMPORT ObliqParser, Rd, IntList, Filter; <*NOWARN*> IMPORT PktRouteViewClass, Fmt, ObLibAnim, ZFmt; <*NOWARN*> IMPORT IntListUtils, ZeusPanel, RefIntArray, ObValue; <*NOWARN*> IMPORT TextWr, View, VBT, Thread, OblFmt, TextRd, Rsrc; CONST ViewName = "ManyPacketsStep.obl"; TYPE T = PktRouteViewClass.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 *> oeStartGraph := StartGraph; oeNewNode := NewNode; oeNewStraightEdge := NewStraightEdge; oeNewCurvedEdge := NewCurvedEdge; oeNewLabel := NewLabel; oeEndGraph := EndGraph; oeStartPackets := StartPackets; oeNewPacket := NewPacket; oeEndPackets := EndPackets; oeBlocked := Blocked; oeMovePacket := MovePacket; oeQueueSizes := QueueSizes; oeAbsorb := Absorb; oeStep := Step; <* LL.sup = VBT.mu *> END; PktRouteManyPacketsStepObliqView PROCEDUREStartGraph (view: T; nodeCnt: CARDINAL; queueSize: CARDINAL; bounded: BOOLEAN; maxX, maxY: REAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartGraph") THEN Invoke (view, "StartGraph", "" & Fmt.Int(nodeCnt) & "," & Fmt.Int(queueSize) & "," & OblFmt.Bool(bounded) & "," & OblFmt.Real(maxX) & "," & OblFmt.Real(maxY) ) END END StartGraph; PROCEDURENewNode (view: T; id: CARDINAL; x, y: REAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NewNode") THEN Invoke (view, "NewNode", "" & Fmt.Int(id) & "," & OblFmt.Real(x) & "," & OblFmt.Real(y) ) END END NewNode; PROCEDURENewStraightEdge (view: T; id1, id2: CARDINAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NewStraightEdge") THEN Invoke (view, "NewStraightEdge", "" & Fmt.Int(id1) & "," & Fmt.Int(id2) ) END END NewStraightEdge; PROCEDURENewCurvedEdge (view: T; id1, id2: CARDINAL; x1, y1, x2, y2: REAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NewCurvedEdge") THEN Invoke (view, "NewCurvedEdge", "" & Fmt.Int(id1) & "," & Fmt.Int(id2) & "," & OblFmt.Real(x1) & "," & OblFmt.Real(y1) & "," & OblFmt.Real(x2) & "," & OblFmt.Real(y2) ) END END NewCurvedEdge; PROCEDURENewLabel (view: T; label: TEXT; x, y: REAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NewLabel") THEN Invoke (view, "NewLabel", "" & TextConv.Encode(label) & "," & OblFmt.Real(x) & "," & OblFmt.Real(y) ) END END NewLabel; PROCEDUREEndGraph (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EndGraph") THEN Invoke (view, "EndGraph", "" ) END END EndGraph; PROCEDUREStartPackets (view: T; pktCnt: CARDINAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartPackets") THEN Invoke (view, "StartPackets", "" & Fmt.Int(pktCnt) ) END END StartPackets; PROCEDURENewPacket (view: T; id, source, dest, fewestHops: CARDINAL; name: TEXT) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NewPacket") THEN Invoke (view, "NewPacket", "" & Fmt.Int(id) & "," & Fmt.Int(source) & "," & Fmt.Int(dest) & "," & Fmt.Int(fewestHops) & "," & TextConv.Encode(name) ) END END NewPacket; PROCEDUREEndPackets (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EndPackets") THEN Invoke (view, "EndPackets", "" ) END END EndPackets; PROCEDUREBlocked (view: T; id, from, to: CARDINAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "Blocked") THEN Invoke (view, "Blocked", "" & Fmt.Int(id) & "," & Fmt.Int(from) & "," & Fmt.Int(to) ) END END Blocked; PROCEDUREMovePacket (view: T; id, from, to: CARDINAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "MovePacket") THEN Invoke (view, "MovePacket", "" & Fmt.Int(id) & "," & Fmt.Int(from) & "," & Fmt.Int(to) ) END END MovePacket; PROCEDUREQueueSizes (view: T; sz: RefIntArray.T) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "QueueSizes") THEN Invoke (view, "QueueSizes", "" & RefIntArray.ToText(sz) ) END END QueueSizes; PROCEDUREAbsorb (view: T; pktId, node: CARDINAL) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "Absorb") THEN Invoke (view, "Absorb", "" & Fmt.Int(pktId) & "," & Fmt.Int(node) ) END END Absorb; PROCEDUREStep (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "Step") THEN Invoke (view, "Step", "" ) END END Step; PROCEDURERegisterView () = BEGIN ZeusPanel.RegisterView(New, "ManyPacketsStep.obl", "PktRoute") END RegisterView; PROCEDURENew (): View.T = BEGIN RETURN NEW(T).init(NIL) END New; CONST ObliqStackSizeMultiplier = 8; TYPE Closure = Thread.SizedClosure OBJECT view: T; OVERRIDES apply := ForkedStartrun; END; PROCEDUREStartrun (view: T) = <* LL.sup < VBT.mu *> BEGIN EVAL Thread.Join( Thread.Fork( NEW(Closure, view := view, stackSize := ObliqStackSizeMultiplier * Thread.GetDefaultStackSize()))); END Startrun; PROCEDUREForkedStartrun (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; PROCEDUREParseRd (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; PROCEDUREInvoke (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; PROCEDUREFieldDefined (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; PROCEDUREOblError (view: T; packet: ObValue.ErrorPacket) = BEGIN Obliq.ReportError(view.swr, packet); ZeusPanel.ReportError( "Obliq error: " & TextWr.ToText(view.wr)) END OblError; PROCEDUREOblException (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 PktRouteManyPacketsStepObliqView.