MODULE PieChart;

IMPORT Color, LineSkip, List, Math;

IMPORT PS, R2, Unparse, Circle, Arc, Rect;

(* A module for drawing pie charts and their legends. *)

(* \section{Pie Chart Colors} *)

VAR Saturation := 1, Brightness := 1;

(* The "Draw" procedure below for drawing pie charts chooses the 
   hue of each wedge so that subsequent hues are distinct. The 
   saturation and value (or brightness) of each wedge are 
   controlled by the current values of the global variables 
   "Saturation" and "Brightness". See the description of the 
   procedure "Color.FromHSV" of the hue-saturation-value color 
   model. *)

PRIVATE PROC c := ColorN(i) IS 
  c := Color.FromHSV(Color.HueN(i), Saturation, Brightness) 
END;

(* \section{Pie Charts} *)

PRIVATE CONST OuterLineWidth = 2, InnerLineWidth = 1;

/* The outer circumference of the pie is stroked in a line of 
   width "OuterLineWidth". The divisions between the pie slices 
   are stroked with lines of width "InnerLineWidth". */

PRIVATE FUNC p = Loc(a, b, k) IS 
  (E theta = -k * 2 * Math.Pi, q = (COS(theta), SIN(theta)) :: 
    p = q REL (a, b)) 
END;

/* "p" is the point on the circumference of the pie with center 
   "a" starting at "b" a fraction "k" of the way around the pie 
   (in the clockwise direction). */

PRIVATE PROC DrawWedge(a, b, from, to, i) IS 
  SAVE PS IN 
    VAR p, q IN 
      p, q := Loc(a, b, from), Loc(a, b, to); 
      SAVE PS IN 
        PS.MoveTo(a); 
        PS.LineTo(p); 
        Arc.Draw(a, q); 
        PS.Close(); 
        PS.SetColor(ColorN(i)); 
        PS.Fill() 
      END; 
      PS.MoveTo(p); 
      PS.LineTo(a); 
      PS.LineTo(q); 
      PS.SetEndStyle(PS.ButtEnds); 
      PS.SetJointStyle(PS.BevelJoints); 
      PS.Stroke() 
    END 
  END 
END;

/* Draw a wedge from "Loc(a,b,from)" to "Loc(a,b,to)" filled 
   with the color corresponding to index "i". */

PRIVATE PROC sum := Total(data) IS 
  sum := 0; 
  DO 
    data # NIL -> sum := sum + CAR(CAR(data)); data := CDR(data) 
  OD 
END;

/* Return the sum of the "CAR"'s of the elements of the list 
   "data". */

PROC Draw(a, b, data) IS 
  SAVE PS IN 
    PS.SetWidth(InnerLineWidth); 
    VAR sum, item, curr = 0, i = 0 IN 
      sum := Total(data); 
      DO 
        data # NIL -> 
          item := CAR(data); 
          data := CDR(data); 
          VAR new IN 
            new := curr + (CAR(item) / sum); 
            DrawWedge(a, b, curr, new, i); 
            curr := new 
          END; 
          i := i + 1 
      OD 
    END; 
    Circle.Draw(a, b); 
    PS.SetWidth(OuterLineWidth); 
    PS.Stroke() 
  END 
END;

(* Draw a pie chart with center "a" and circumference starting 
   point "b" on the given "data". "Data" must be a list of 
   "(value, name)" pairs. The "name" parts of the data are 
   ignored by this procedure, but they are used by the "Legend" 
   procedure below. *)

(* \section{Pie Chart Legends} *)

PRIVATE CONST 
  LegendLineWidth = 1, SquareScale = 0.7, LegendGap = 5;

PRIVATE PROC LegendSquare(p, ht, i) IS 
  VAR center, ht2, delta IN 
    ht2 := ht / 2; 
    delta := (ht2, -ht2); 
    center := R2.Plus(p, delta); 
    Rect.DrawC(center, 
               R2.Plus(center, R2.Times(SquareScale, delta))); 
    SAVE PS IN PS.SetColor(ColorN(i)); PS.Fill() END; 
    PS.Stroke() 
  END 
END;

PRIVATE PROC p:LegendItem(asc, ht, label, i) IS 
  LegendSquare(p, ht, i); 
  PS.Type(R2.Plus(p, (ht + LegendGap, -asc)), label); 
  p := R2.Minus(p, (0, ht + LineSkip.Get())) 
END;

PROC Legend(a, data, labelCl) IS 
  SAVE PS IN 
    PS.SetWidth(LegendLineWidth); 
    VAR asc, dec, ht, vert, sum, i = 0 IN 
      asc, dec := PS.FontHeight(); 
      ht := asc + dec; 
      vert := 
        List.Length(data) * (ht + LineSkip.Get()) - 
        LineSkip.Get(); 
      sum := Total(data); 
      a := R2.Plus(a, (0, vert / 2)); 
      DO 
        data # NIL -> 
          a:LegendItem(asc, ht, APPLY(labelCl, CAR(data), sum), i); 
          data := CDR(data); 
          i := i + 1 
      OD 
    END 
  END 
END;

(* Draw a legend for the given "data" located so its west edge 
   is centered at "a". The "data" should be a list of "(value, 
   name)" pairs. 

   The call "APPLY(labelCl, item, sum)" must return the textual 
   label associated with the given "item" (which is a name-value 
   pair), given that "sum" is the sum of the values of all the 
   items. There are predefined label closures defined below for 
   common cases. 

   The legend names are printed in the current font, separated 
   by the nominal height of the font plus the current "LineSkip" 
   value (as maintained by the "LineSkip" module). *)

PROC res := OnlyLabel(item, sum) IS res := CDR(item) END;

(* A label closure that returns only the name of the label *)

PROC res := AbsoluteLabel(item, sum) IS 
  res := CDR(item) & " (" & Unparse.Value(CAR(item)) & ")" 
END;

(* A label closure that returns the name of the label and its 
   associated value. *)

PROC res := PercentLabel(item, sum) IS 
  res := 
    CDR(item) & " (" & Unparse.Value(100 * CAR(item) / sum) & 
    "%)" 
END;

(* A label closure that returns the name of the label and its 
   associated percentage. *)