MODULE Shadow;

(* Procedures for drawing 3D shadow effects. *)

IMPORT Color, R2, Geometry, PS;

CONST DefaultWidth = 4;

(* This module maintains a current shadow width. *)

PRIVATE VAR width := DefaultWidth;

PROC SetWidth(w) IS width := w END;

UI SetTool(SetWidth);

(* Set the current shadow width to "w". *)

UI Param(SetWidth, DefaultWidth);

UI Param(SetWidth, 1);

UI Param(SetWidth, 2);

UI Param(SetWidth, 3);

UI Param(SetWidth, 4);

UI Param(SetWidth, 5);

UI Param(SetWidth, 7);

UI Param(SetWidth, 10);

CONST 
  DefaultColors = (Color.Grey75, Color.Grey25), 
  ReverseColors = (Color.Grey25, Color.Grey75);

(* This module maintains a current pair of colors, 
   which are the two colors used to draw the shadows. 
   By default, the shadows are drawn so a light source 
   appears to be shining on a raised object from the 
   upper-left. *)

PRIVATE VAR colors := DefaultColors;

PROC SetColors(c) IS colors := c END;

UI SetTool(SetColors);

(* Set the current pair of colors to "c", which should 
   be a pair of colors produced using the "Color" 
   module. *)

UI Param(SetColors, DefaultColors);

UI Param(SetColors, ReverseColors);

PRIVATE PROC Rect0(a, b) IS 
  IF 
    VAR 
      c = Geometry.HorVer(b, a), 
      d = Geometry.HorVer(a, b), 
      e = R2.Minus(a, (width, width)), 
      f = R2.Plus(b, (width, width)), 
      g = Geometry.HorVer(f, e), 
      h = Geometry.HorVer(e, f) 
    IN 
      SAVE PS IN 
        PS.MoveTo(a); 
        PS.LineTo(c); 
        PS.LineTo(b); 
        PS.LineTo(f); 
        PS.LineTo(g); 
        PS.LineTo(e); 
        PS.Close(); 
        PS.SetColor(CAR(colors)); 
        PS.Fill(); 
        PS.MoveTo(a); 
        PS.LineTo(d); 
        PS.LineTo(b); 
        PS.LineTo(f); 
        PS.LineTo(h); 
        PS.LineTo(e); 
        PS.Close(); 
        PS.SetColor(CDR(colors)); 
        PS.Fill() 
      END 
    END 
  FI 
END;

PROC Rect(a, b) IS 
  IF 
    VAR ax, ay, bx, by IN 
      a = (ax, ay) AND b = (bx, by) -> 
        Rect0((MIN(ax, bx), MIN(ay, by)), 
              (MAX(ax, bx), MAX(ay, by))) 
    END 
  FI 
END;

UI PointTool(Rect);

(* Draw shadows around the rectangle with corners "a" 
   and "b" that is squarely oriented with the page. The 
   shadows are drawn in the current shadow width and 
   colors. The west and north shadows are filled with 
   the first color, and the east and south shadows are 
   filled with the second color. *)

PROC RectC(c, b) IS 
  IF VAR a = (-1, 0) REL (c, b) IN Rect(a, b) END FI 
END;

UI PointTool(RectC);

(* Like "Rect" above, but the rectangle is specified by 
   its center "c" and one of its corners "b". *)

PRIVATE VAR history := NIL;

PROC Save() IS 
  history := ((width, colors), history) 
END;

PROC Restore() IS 
  VAR head IN 
    head := CAR(history); 
    width := CAR(head); 
    colors := CDR(head) 
  END; 
  history := CDR(history) 
END;

UI PointTool(Save);

UI PointTool(Restore);

(* Save/restore the current shadow state. *)