(* Copyright (C) 1992, Digital Equipment Corporation *)
(* All rights reserved. *)
(* See the file COPYRIGHT for a full description. *)

(* Last modified on Fri Jan 15 14:40:22 PST 1993 by jdd *)
(*      modified on Fri Jan 15 12:20:22 PST 1993 by mhb *)
(*      modified on Thu Apr 23 18:57:36 PDT 1992 by muller *)

UNSAFE MODULE Main;

IMPORT Axis, ButtonVBT, ColorName, Color, Fmt, HVSplit, PaintOp, Point,
       Rd, Rect, Region, Split, Stdio, Text, TextVBT, Trestle, VBT, Wr;

IMPORT RTHeapComm, RTHeapEvent, RTHeapRep, RTMisc;

FROM RTHeapRep IMPORT Desc, Generation, Note, Page, Space;

<*FATAL ANY*>

(*------------------------------------------------------------ heap state
   ---*)

CONST
  NewHue      = 0.667;           (* blue *)
  CopiedHue   = 1.000;           (* red *)
  ImmobileHue = 0.500;           (* cyan *)
  OlderHue    = 0.167;           (* yellow *)

VAR
  collections: INTEGER := 0;
  firstPage  : Page    := 1;
  lastPage   : Page    := 0;
  desc                 := NEW(UNTRACED REF ARRAY OF Desc, 0);

TYPE Counter = {None, New, Copied, Immobile, Older};

VAR
  count := ARRAY Counter OF CARDINAL{0, ..};
  countVBT, countTextVBT: ARRAY Counter OF VBT.T;

PROCEDURE CounterOf (d: Desc): Counter =
  VAR
    hue := hsv[d.space, d.generation, d.pure, d.note, d.gray, d.protected];
  BEGIN
    IF hue.h = NewHue THEN
      RETURN Counter.New;
    ELSIF hue.h = CopiedHue THEN
      RETURN Counter.Copied;
    ELSIF hue.h = ImmobileHue THEN
      RETURN Counter.Immobile;
    ELSIF hue.h = OlderHue THEN
      RETURN Counter.Older;
    ELSE
      RETURN Counter.None;
    END;
  END CounterOf;

(*---------------------------------------------------------------- colors
   ---*)

VAR
  hsv: ARRAY Space, Generation, BOOLEAN (* pure *), Note,
         BOOLEAN (* gray *), BOOLEAN (* protected *) OF
         Color.HSV;
  tint: ARRAY Space, Generation, BOOLEAN (* pure *), Note,
          BOOLEAN (* gray *), BOOLEAN (* protected *) OF
          PaintOp.T;
  mapBackGround := ComputeColor("LightLightGray");
  red           := ComputeColor("Red");
  black         := ComputeColor("Black");
  white         := ComputeColor("White");

  gcOnQuad  := PaintOp.MakeColorQuad(black, red);
  gcOffQuad := PaintOp.MakeColorQuad(white, black);

PROCEDURE ComputeColor (name: Text.T): PaintOp.T =
  VAR t: Color.T;
  BEGIN
    t := ColorName.ToRGB(name);
    RETURN PaintOp.FromRGB(t.r, t.g, t.b);
  END ComputeColor;

PROCEDURE InitColors () =
  BEGIN
    FOR space := FIRST(Space) TO LAST(Space) DO
      FOR generation := FIRST(Generation) TO LAST(Generation) DO
        FOR pure := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
          FOR note := FIRST(Note) TO LAST(Note) DO
            FOR gray := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
              FOR protected := FIRST(BOOLEAN) TO LAST(BOOLEAN) DO
                CASE space OF
                | Space.Unallocated =>
                    hsv[space, generation, pure, note, gray, protected] :=
                      Color.HSV{0.0, 0.0, 0.0};
                | Space.Free =>
                    hsv[space, generation, pure, note, gray, protected] :=
                      Color.HSV{0.0, 0.0, 1.0};
                | Space.Previous =>
                    hsv[space, generation, pure, note, gray, protected] :=
                      Color.HSV{0.0, 0.0, 0.75};
                | Space.Current =>
                    CASE note OF
                    | Note.Allocated =>
                        hsv[space, generation, pure, note, gray, protected] :=
                          Color.HSV{NewHue, 0.75, 0.6};
                    | Note.Copied, Note.Large =>
                        IF pure THEN
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{CopiedHue, 0.7, 0.75};
                        ELSIF gray THEN
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{CopiedHue, 1.0, 0.5};
                        ELSE
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{CopiedHue, 0.7, 0.6};
                        END;
                    | Note.AmbiguousRoot =>
                        IF gray THEN
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{ImmobileHue, 1.0, 0.5};
                        ELSE
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{ImmobileHue, 0.7, 0.4};
                        END;
                    | Note.Frozen =>
                        IF gray THEN
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{ImmobileHue, 1.0, 0.5};
                        ELSE
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{ImmobileHue, 0.7, 0.7};
                        END;
                    | Note.OlderGeneration =>
                        IF gray THEN
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{OlderHue, 0.7, 0.5};
                        ELSE
                          hsv[
                            space, generation, pure, note, gray, protected] :=
                            Color.HSV{OlderHue, 1.0, 0.4};
                        END;
                    END;
                END;
                VAR
                  rgb := Color.FromHSV(hsv[space, generation, pure, note,
                                            gray, protected]);
                BEGIN
                  tint[space, generation, pure, note, gray, protected] :=
                    PaintOp.FromRGB(rgb.r, rgb.g, rgb.b);
                END;
              END;
            END;
          END;
        END;
      END;
    END;
    VAR
      rgb := Color.FromHSV(Color.HSV{NewHue, 0.75, 0.6});
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.New] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.New] := TextVBT.New("new", bgFg := quad);
    END;
    VAR
      rgb := Color.FromHSV(Color.HSV{CopiedHue, 0.6, 0.7});
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.Copied] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Copied] := TextVBT.New("copied", bgFg := quad);
    END;
    VAR
      rgb := Color.FromHSV(Color.HSV{ImmobileHue, 0.65, 0.4});
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.Immobile] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Immobile] :=
        TextVBT.New("immobile", bgFg := quad);
    END;
    VAR
      rgb := Color.FromHSV(Color.HSV{OlderHue, 0.5, 0.5});
      quad := PaintOp.MakeColorQuad(
                PaintOp.FromRGB(rgb.r, rgb.g, rgb.b), PaintOp.Fg);
    BEGIN
      countVBT[Counter.Older] := TextVBT.New("", bgFg := quad);
      countTextVBT[Counter.Older] := TextVBT.New("older", bgFg := quad);
    END;
  END InitColors;

(*------------------------------------------------------------ Heap map
   ---*)

TYPE
  HeapMapVBT = VBT.Leaf OBJECT
                 rect                    := Rect.T{0, 1, 0, 1};
                 side        : INTEGER;
                 nCols, nRows: INTEGER   := 1;
                 firstSquare : Rect.T;
                 displayedTints: REF ARRAY OF PaintOp.T := NIL;
               OVERRIDES
                 repaint := RepaintHeapMap;
                 reshape := ReshapeHeapMap;
                 shape   := ShapeHeapMap;
               END;

PROCEDURE LayoutHeapMap (self: HeapMapVBT) = (* Given the rectangle to be
                                                occupied by the heap map
                                                and the number of pages to
                                                display, compute the size
                                                of each square *)
  VAR
    tryLarger              := TRUE;
    p                      := MAX(lastPage - firstPage + 1, 1);
    width, height: INTEGER;
  BEGIN                          (* Recompute the layout of the map *)
    width := self.rect.east - self.rect.west;
    height := self.rect.south - self.rect.north;
    self.side := 1;
    self.nCols := width;
    self.nRows := height;

    WHILE tryLarger DO
      WITH largerSide = self.side + 1,
           largerCols = width DIV largerSide,
           largerRows = height DIV largerSide DO

        IF p <= largerCols * largerRows THEN (* ok *)
          self.side := largerSide;
          self.nCols := largerCols;
          self.nRows := largerRows;
        ELSE
          tryLarger := FALSE;
        END;
      END;
    END;

    self.firstSquare :=
      Rect.FromCorner(
        Point.MoveHV(Rect.NorthWest(self.rect),
                     (width - self.side * self.nCols) DIV 2,
                     (height - self.side * self.nRows) DIV 2), self.side,
        self.side);

  END LayoutHeapMap;

PROCEDURE RepaintHeapMap (                    self: HeapMapVBT;
                          <*UNUSED*> READONLY rgn : Region.T    ) =
  VAR
    p       := 0;
    nbPages := lastPage - firstPage + 1;
    square  := self.firstSquare;
  BEGIN                          (* Fill the map with the background
                                    color *)
    VBT.PaintTint(self, self.rect, mapBackGround);

    (* redisplay each page *)
    FOR y := 0 TO self.nRows - 1 DO
      FOR x := 0 TO self.nCols - 1 DO
        IF p < nbPages THEN
          VAR
            d  := desc[p];
            sq := square;
          BEGIN
            INC(sq.north, 1);
            DEC(sq.south, 1);
            IF NOT d.continued THEN INC(sq.west, 2); END;
            VBT.PaintTint(self, square, white);
            VBT.PaintTint(self, sq, tint[d.space, d.generation, d.pure,
                                         d.note, d.gray, d.protected]);
          END;
        END;
        INC(p);
        INC(square.east, self.side);
        INC(square.west, self.side);
      END;
      square.east := self.firstSquare.east;
      square.west := self.firstSquare.west;
      INC(square.north, self.side);
      INC(square.south, self.side);
    END;
  END RepaintHeapMap;

PROCEDURE RepaintOnePage (self: HeapMapVBT; page: Page) =
  VAR
    p     := page - firstPage;
    row   := p DIV MAX(self.nCols, 1);
    col   := p - row * self.nCols;
    west  := self.firstSquare.west + col * self.side;
    east  := west + self.side;
    north := self.firstSquare.north + row * self.side;
    south := north + self.side;
    square := Rect.T{
                west := west, east := east, north := north, south := south};
  BEGIN
    VBT.PaintTint(self, square, white);
    VAR
      d := desc[p];
      t := tint[d.space, d.generation, d.pure, d.note, d.gray, d.protected];
      sq := square;
    BEGIN
      INC(sq.north, 1);
      DEC(sq.south, 1);
      IF NOT d.continued THEN INC(sq.west, 2); END;
      VBT.PaintTint(self, sq, t);
    END;
  END RepaintOnePage;

PROCEDURE ReshapeHeapMap (self: HeapMapVBT; READONLY cd: VBT.ReshapeRec) =
  BEGIN
    self.rect := cd.new;
    LayoutHeapMap(self);
    RepaintHeapMap(self, Region.T{r := cd.new});
  END ReshapeHeapMap;

PROCEDURE ShapeHeapMap (<*UNUSED*> self: HeapMapVBT;
                                   ax  : Axis.T;
                        <*UNUSED*> n   : CARDINAL    ): VBT.SizeRange =
  BEGIN
    IF ax = Axis.T.Hor THEN
      RETURN (VBT.SizeRange{lo := 200, pref := 300, hi := 100 * 1000});
    ELSE
      RETURN (VBT.SizeRange{lo := 200, pref := 200, hi := 100 * 1000});
    END;
  END ShapeHeapMap;

(*---------------------------------------------------------- various VBTs
   ---*)

PROCEDURE ShowValueVBT (name: Text.T; value: VBT.T): VBT.T =
  BEGIN
    RETURN HVSplit.Cons(Axis.T.Hor, TextVBT.New(name, 0.0), value);
  END ShowValueVBT;

TYPE A = REF RECORD p: PROCEDURE ();  END;

PROCEDURE ActionVBT (name: Text.T; action: PROCEDURE ()): VBT.T =
  BEGIN
    RETURN
      ButtonVBT.New(TextVBT.New(name), DoActionVBT, NEW(A, p := action));
  END ActionVBT;

PROCEDURE DoActionVBT (                    self: ButtonVBT.T;
                       <*UNUSED*> READONLY cd  : VBT.MouseRec ) =
  BEGIN
    NARROW(VBT.GetProp(self, TYPECODE(A)), A).p();
  END DoActionVBT;

(*------------------------------------------------------- Number Displays
   ---*)

VAR
  gcs := TextVBT.New("");
  off := TextVBT.New("");

(*-------------------------------------------------------------- controls
   ---*)

VAR
  root, control: VBT.T;
  map          : HeapMapVBT;

PROCEDURE StartAction () =
  BEGIN
    Wr.PutChar(Stdio.stdout, 'g');
    Wr.Flush(Stdio.stdout);
  END StartAction;

PROCEDURE QuitAction () =
  BEGIN
    Trestle.Delete(root);
    RTMisc.Exit(0);
  END QuitAction;

PROCEDURE SetupVBT () =
  BEGIN
    control := HVSplit.New(Axis.T.Ver);
    Split.AddChild(
      control, countVBT[Counter.New], countTextVBT[Counter.New],
      countVBT[Counter.Copied], countTextVBT[Counter.Copied],
      countVBT[Counter.Immobile], countTextVBT[Counter.Immobile],
      countVBT[Counter.Older], countTextVBT[Counter.Older]);
    Split.AddChild(
      control, ShowValueVBT("gcs = ", gcs), ShowValueVBT("off = ", off));
    Split.AddChild(control, ActionVBT("start", StartAction),
                   ActionVBT("quit", QuitAction));
    map := NEW(HeapMapVBT);
    root := HVSplit.Cons(Axis.T.Hor, control, map);
    Trestle.Install(root);
  END SetupVBT;

(*---------------------------------------------------------------------------*)

PROCEDURE Run () =
  BEGIN
    TRY
      LOOP
        VAR e := RTHeapComm.Receive(Stdio.stdin);
        BEGIN
          CASE e.kind OF
          | RTHeapEvent.Kind.Begin =>
              INC(collections);
              TextVBT.SetFont(gcs, TextVBT.GetFont(gcs), gcOnQuad);
              TextVBT.Put(gcs, Fmt.Int(collections));
          | RTHeapEvent.Kind.Flip =>
          | RTHeapEvent.Kind.Roots =>
          | RTHeapEvent.Kind.End =>
              TextVBT.SetFont(gcs, TextVBT.GetFont(gcs), gcOffQuad);
          | RTHeapEvent.Kind.Grow =>
              VAR
                newFirstPage, newLastPage: Page;
                newDesc                  : UNTRACED REF ARRAY OF Desc;
              BEGIN
                IF firstPage = 1 AND lastPage = 0 THEN
                  newFirstPage := e.first;
                  newLastPage := e.first + e.nb - 1;
                ELSE
                  newFirstPage := MIN(e.first, firstPage);
                  newLastPage := MAX(e.first + e.nb - 1, lastPage);
                END;
                newDesc := NEW(UNTRACED REF ARRAY OF Desc,
                               newLastPage - newFirstPage + 1);
                FOR p := e.first TO e.first + e.nb - 1 DO
                  newDesc[p - newFirstPage].space := Space.Free;
                  newDesc[p - newFirstPage].pure := TRUE;
                  newDesc[p - newFirstPage].continued := FALSE;
                END;
                IF NOT (firstPage = 1 AND lastPage = 0) THEN
                  SUBARRAY(newDesc^, firstPage - newFirstPage,
                           lastPage - firstPage + 1) := desc^;
                  FOR p := e.first + e.nb TO firstPage - 1 DO
                    newDesc[p - newFirstPage].space := Space.Unallocated;
                  END;
                  FOR p := lastPage + 1 TO e.first - 1 DO
                    newDesc[p - newFirstPage].space := Space.Unallocated;
                  END;
                END;
                desc := newDesc;
                firstPage := newFirstPage;
                lastPage := newLastPage;
              END;
              LayoutHeapMap(map);
              RepaintHeapMap(map, Region.T{r := map.rect});
          | RTHeapEvent.Kind.Change =>
              VAR new := CounterOf(e.desc);
              BEGIN
                VAR old := CounterOf(desc[e.first - firstPage]);
                BEGIN
                  desc[e.first - firstPage] := e.desc;
                  IF new # old THEN
                    IF old # Counter.None THEN
                      DEC(count[old]);
                      TextVBT.Put(countVBT[old], Fmt.Int(count[old]));
                    END;
                    IF new # Counter.None THEN
                      INC(count[new]);
                      TextVBT.Put(countVBT[new], Fmt.Int(count[new]));
                    END;
                  END;
                END;
                e.desc.continued := TRUE;
                FOR p := e.first + 1 TO e.first + e.nb - 1 DO
                  VAR old := CounterOf(desc[p - firstPage]);
                  BEGIN
                    desc[p - firstPage] := e.desc;
                    IF new # old THEN
                      IF old # Counter.None THEN
                        DEC(count[old]);
                        TextVBT.Put(countVBT[old], Fmt.Int(count[old]));
                      END;
                      IF new # Counter.None THEN
                        INC(count[new]);
                        TextVBT.Put(countVBT[new], Fmt.Int(count[new]));
                      END;
                    END;
                  END;
                END;
              END;
              FOR p := e.first TO e.first + e.nb - 1 DO
                RepaintOnePage(map, p);
              END;
          | RTHeapEvent.Kind.Bye => EXIT;
          | RTHeapEvent.Kind.Off => TextVBT.Put(off, Fmt.Int(e.nb));
          | RTHeapEvent.Kind.CollectNow, RTHeapEvent.Kind.GCOff,
              RTHeapEvent.Kind.GCOn => <* ASSERT FALSE *>
          END;
        END;
      END;
    EXCEPT
    | Rd.EndOfFile =>
    END;
  END Run;

BEGIN
  InitColors();
  SetupVBT();
  Run();
  Trestle.AwaitDelete(root);
END Main.