<* PRAGMA LL *> MODULE; IMPORT Color, Filter, Fmt, GraphVBT, IntList, PaintOp, R2, RealList, Thread, VBT, View, ZeusPanel; REVEAL T = Public BRANDED OBJECT W: INTEGER; (* number of weights *) weights: REF ARRAY OF Weight; (* the weights *) OVERRIDES <* LL=0 *> oeSetup := Setup; oeNewWeight := NewWeight; oePack := Pack; oeIgnore := Ignore; createGraph := CreateGraph; createWeight := CreateWeight; <* LL=VBT.mu *> ueRepackBin := RepackBin; END; PROCEDURE PackingView2 New (): View.T = BEGIN RETURN NEW(T).init(NEW(GraphVBT.T).init()) END New; PROCEDURESetup (view: T; nBins, nWts: INTEGER) = BEGIN view.W := nWts; view.weights := NEW(REF ARRAY OF Weight, nWts); WITH mg = view.createGraph(nBins, nWts) DO LOCK VBT.mu DO EVAL Filter.Replace(view, mg) END END END Setup; PROCEDURENewWeight (view: T; id: INTEGER; wt: REAL) = VAR mg: GraphVBT.T := Filter.Child(view); BEGIN view.curr := view.createWeight(id, wt); view.weights[id] := view.curr; mg.redisplay() END NewWeight; PROCEDUREPack (view: T; bin: INTEGER; total: REAL) = VAR mg: GraphVBT.T := Filter.Child(view); BEGIN LOCK mg.mu DO view.curr.move( R2.T{0.5 + FLOAT(bin), total - view.curr.amt / 2.0}, animated := FALSE) END; mg.redisplay() END Pack; PROCEDUREIgnore (view: T) = VAR mg: GraphVBT.T := Filter.Child(view); BEGIN LOCK mg.mu DO view.curr.remove() END; mg.redisplay() END Ignore; PROCEDURERepackBin (view : T; bin : INTEGER; old, new: IntList.T; amts : RealList.T ) RAISES {Thread.Alerted} = <* LL = VBT.mu *> VAR mg : GraphVBT.T := Filter.Child(view); total: REAL := 0.0; o, n : IntList.T; a : RealList.T; BEGIN o := old; WHILE o # NIL DO IF NOT IntList.Member(new, o.head) THEN WITH id = o.head, bar = NARROW(view.weights[id], Weight) DO bar.remove(); view.weights[id] := NIL; END END; o := o.tail END; n := new; a := amts; WHILE n # NIL DO WITH id = n.head, amt = a.head, bar = NARROW(view.weights[id], Weight) DO total := total + amt; bar.move(R2.T{0.5 + FLOAT(bin), total - amt / 2.0}, animated := TRUE) END; n := n.tail; a := a.tail END; mg.animate (0.0, 1.0); END RepackBin; VAR font: GraphVBT.WorldFont; PROCEDURECreateGraph (<* UNUSED *> view : T; nBins: INTEGER; <* UNUSED *> nWts : INTEGER ): GraphVBT.T = VAR graph := NEW(GraphVBT.T, world := GraphVBT.WorldRectangle{ w := 0.0, s := 0.0, e := FLOAT(nBins), n := 1.0}, pixelSizeDivisor := ARRAY [0 .. 1] OF CARDINAL{nBins, 1}).init(); BEGIN font := graph.font(family := "Helvetica", weight := "bold", slant := GraphVBT.Slant.Roman, size := 0.05); RETURN graph; END CreateGraph; PROCEDURECreateWeight (view: T; id: INTEGER; amt: REAL): Weight = VAR mg := NARROW(Filter.Child(view), GraphVBT.T); rgb := Color.FromHSV(Color.HSV{FLOAT(id + 1) / FLOAT(view.W), 1.0, 1.0}); op := PaintOp.FromRGB(rgb.r, rgb.g, rgb.b); BEGIN RETURN NEW(Weight, id := id, amt := amt, graph := mg, pos := R2.T{-100.0,-100.0}, color := op, size := R2.T{1.0, amt}, border := 0.0025, borderColor := PaintOp.Fg, label := Fmt.Int(id), font := font, fontColor := PaintOp.Fg).init() END CreateWeight; BEGIN ZeusPanel.RegisterView (New, "Packing", "Binpack"); END PackingView2.