
(* :Title: Graphics Legends *)

(* :Author: John M. Novak *)

(* :Summary: A package for placing a legend box on a graphic.
	Includes numerous options to assist in making it just
	right. *)

(* :Context: Graphics`Legends` *)

(* :Package Version: 1.0 *)

(* :History: Version 1.0 by John M. Novak, Feb. 91 *)

(* :Keywords: graphics, legends, key *)

(* :Mathematica Version: 2.0 *)

(* :Warning: adds rules to Plot[]. *)

(* :Warning: Uses the package Utilities`FilterOptions`. *)

(* :Limitation: Does not yet deal with scaled coordinates. *)

(* :Limitation: Automatic placing of legend boxes is not very
	good; tweaking by hand is likely to be required (definitely
	if there is more than one box being placed). *)

(* :Limitation: Graphics options affect the entire graphic (with
	legend box emplaced). Because the boxes generally contain
	graphics in rectangles, if AspectRatio is changed, unexpected
	changes may occur.  This applies even more so to Legend (as
	opposed to ShowLegend). *)

(* :Limitation: Error checking is somewhat limited at this time. *)

BeginPackage["Graphics`Legend`","Utilities`FilterOptions`"]

(* Usage Messages *)

ShowLegend::usage =
	"ShowLegend[graphic,{legendargs}...] creates and shows a graphic
	with legends (keys).  legendargs are in the same format as
	a call to Legend would be (see: Legend). This routine attempts
	to place the graphic in a coordinate system in which the
	center of the graphic is at {0,0}, and the graphic fits
	inside of a box {{-1,-1},{1,1}}. It retains its original
	aspect ratio, so if this routine cannot find that aspect
	ratio, the box may be oversized (requiring possible adjustments
	to the PlotRange).  The position for each legend should be
	determined according to this coordinate system. The routine
	will attempt to place the first legend in the lower left
	corner if no position is explicitly stated; all others will
	be placed in the default position specified in Legend.  Be careful to
	count braces with this function! You may need three in a row
	for some arguments."

Legend::usage =
	"There are two forms with which Legend may be called.
	Legend[function,num,(mintext),(maxtext),opts] will apply
	the function to numbers between 0 and 1, incremented by
	the number of boxes num - 1.  This will generate a color
	directive or graphic suitable for a box in the legend.
	Legend[{{box,text},...},opts] is the simpler usage; it
	creates the legend with the specified boxes and text.  Boxes
	can be color directives (e.g., Hue) or graphics.  Text can
	be a string or have FontForm[] wrapped around it.  Note:
	options for ShadowBox will also be accepted and passed on
	to ShadowBox."

PlotLegend::usage = 
"PlotLegend is an option for Plot, which assigns text to lines in a 2D
plot to create a legend for that plot. PlotLegend->{txt1,txt2...}
assigns text to each line in the fashion of PlotStyle.  PlotLegend
also enables Plot to accept options for Legend, which will modify the
legend produced."

ShadowBox::usage =
"ShadowBox[pos,size,opts] creates a box with a drop shadow,
with colors specified by opts.  It is generated at position
pos ({x,y}) with size specified by {x-length, y-length}."

LegendPosition::usage =
"LegendPosition is an option for Legend, which specifies the exact
location of a legend box (the lower-left corner).  If called from
ShowLegend, the position will be in the coordinate system, with the
graphic centered at {0,0} and scaled to fit inside {{-1,-1},{1,1}}."

LegendSize::usage =
"LegendSize specifies the size of a Legend box.  
LegendSize->Automatic means that a routine determines the size.
LegendSize-Number will scale the size so that it fits in a box of
width the longest side of the length given.  LegendSize->{number,
number} uses {x-length, y-length} to determine size."

LegendShadow::usage =
"LegendShadow is an option for Legend.  LegendShadow->None specifies
no shadow and a transparent backdrop to the legend box.
LegendShadow->Automatic specifies that the shadow is placed by
routine.  LegendShadow->{x-offset, y-offset} specifies offset of
shadow from the box."

LegendTextSpace::usage =
"LegendTextSpace specifies the space in the legend box for text.
Arguments can be a number corresponding to the ratio of the text space
to the size of a key box, or Automatic."

LegendTextDirection::usage =
"LegendTextDirection is an option for Legend, which specifies the
direction of text next to the key box.  Argument can be standard
Text[], number pair, or Automatic."

LegendTextOffset::usage =
"LegendTextOffset is an option for Legend, which specifies the offset
of text next to the key box.  Arguments can be standard Text[], number
pair, or Automatic."

LegendLabel::usage =
"LegendLabel is an option for Legend, which specifies the text to be
used as the label for the legend box.  Arguments can be String,
FontForm, or None."

LegendLabelSpace::usage =
"LegendLabelSpace is an option for Legend, which sets the space for
LegendLabel.  It can be expressed as a ratio of a keybox size (see
LegendTextSpace) or be Automatic."

LegendOrientation::usage =
"LegendOrientation is an option for Legend, which specifies the
direction in which key boxes are laid out.  Settings can be Horizontal
(left to right) or Vertical (top to bottom)."

LegendSpacing::usage =
"LegendSpacing is an option for Legend, which can be set to a number or
Automatic.  Determines the amount of space around each key box on a
scale where the box is 1.  For the boxes to be adjacent (a continuous
line for instance) LegendSpacing should be set to 0."

LegendBorderSpace::usage =
"LegendBorderSpace is an option for Legend which sets the space around
the entire set of key boxes and text in the legend."

LegendBorder::usage =
"LegendBorder is an option for Legend, which specifies the style of the
line surrounding key boxes and text in a legend."

LegendBackground::usage =
"LegendBackground is an option for Legend, which specifies the style of
background to use with a legend.  LegendBackground sets
ShadowForeground and will override any value passed to
ShadowForeground."

ShadowBorder::usage =
"ShadowBorder is an option for ShadowBox or Legend, which sets a border
around the rectangle above a shadow.  Styles are same as those for a
Line[] primitive."

ShadowForeground::usage =
"ShadowForeground is an option for ShadowBox or Legend, which
specifies a style for the foreground of a shadow box.  If used from
Legend, this will be the style behind the keys/text.  The style should
be a color primitive."

ShadowBackground::usage =
"ShadowBackground is an option for Shadowbox or Legend, which sets the
style for a drop shadow.  The style should be a color primitive.  The
default is GrayLevel[0]."

ShadowOffset::usage =
"ShadowOffset is an option for ShadowBox or Legend, which sets the
Offset of a shadow from the rest of the box.  It is expresses as
{x-distance,y-distance}.  When using from Legend, set ShadowOffset to
{0,0} to get a background with no shadow."

Horizontal::usage =
	"Value for option LegendOrientation."

Vertical::usage =
	"Value for option LegendOrientation."

Begin["`Private`"]

Options[ShadowBox] =
	{ShadowBorder->{Thickness[.001],GrayLevel[0]},
	ShadowForeground->GrayLevel[1],
	ShadowBackground->GrayLevel[0],
	ShadowOffset->{.1,-.1}};

ShadowBox[pos:{_,_},size:{_,_},opts___] :=
	Module[{bordsty,foresty,backsty,offset,forebox,
				backbox,border},
		{bordsty,foresty,backsty,offset} =
			{ShadowBorder,ShadowForeground,ShadowBackground,ShadowOffset}/.
			{opts}/.Options[ShadowBox];
		If[foresty === Automatic, foresty = GrayLevel[1]];
		If[bordsty === Automatic, bordsty = {Thickness[.001],
					GrayLevel[0]}];
		If[backsty === Automatic, backsty = GrayLevel[0]];
		forebox = Rectangle[pos,pos + size];
		backbox = Rectangle[pos + offset,pos + size + offset];
		border = Line[{pos,pos + {First[size],0},
			pos + size,pos + {0,Last[size]},pos}];
		Flatten[{backsty,backbox,foresty,forebox,
					bordsty,border}]]

Options[Legend] =
	{LegendPosition->{-1,-1},LegendSize->Automatic,
	LegendShadow->Automatic,LegendTextSpace->Automatic,
	LegendTextDirection->Automatic,LegendTextOffset->Automatic,
	LegendLabel->None,LegendLabelSpace->Automatic,
	LegendOrientation->Vertical, LegendSpacing->Automatic,
	LegendBorder->Automatic,
	LegendBorderSpace->Automatic,LegendBackground->Automatic};

Legend[fn:(_Function | _Symbol),boxes_?NumberQ,
		minstr_String:"",maxstr_String:"",opts___] :=
	Module[{its,strs},
		its = Map[fn,Range[0,1,1/(boxes - 1)]];
		strs = Table["",{Length[its]}];
		strs[[1]] = minstr;strs[[Length[strs]]] = maxstr;
		Legend[Transpose[{its,strs}],opts,
			LegendSpacing->0]]

Legend[items:{{_,_}..},opts___] :=
	Module[{ln = Length[items],boxes,lb,n,inc,rn,as,gr,sbox,
			pos,size,shadow,tspace,lspace,bspace,tdir,toff,
			label,orient,space,back,bord},
		{pos,size,shadow,tspace,tdir,label,lspace,
			orient,space,bspace,toff,back,bord} =
			{LegendPosition,LegendSize,LegendShadow,
			LegendTextSpace,LegendTextDirection,LegendLabel,
			LegendLabelSpace,LegendOrientation,
			LegendSpacing,LegendBorderSpace,
			LegendTextOffset,LegendBackground,
			LegendBorder}/.{opts}/.Options[Legend];
		If[Not[NumberQ[space]], inc = .08,inc = space];
		If[tspace === Automatic,
			If[Count[Transpose[items][[2]],""] == ln,
				tspace = 0,
				If[orient === Vertical,
					tspace = 2,
					tspace = 1]]];
		If[lspace === Automatic,
			If[(label =!= None) && (label =!= ""),
				lspace = 1,
				lspace = 0]];
		If[bspace === Automatic,
			bspace = .1];
		If[toff === Automatic,
			If[orient === Vertical,toff = {-1,0},
				toff = {0,-1}]];
		If[tdir === Automatic,
			tdir = {1,0}];
		boxes =
			If[orient === Vertical,
			Table[pt = {inc,inc (2 n - 1) + (n - 1)};
				{rec[pt,{1,1},items[[ln - n + 1,1]]],
				Text[items[[ln - n + 1,2]],
					pt + {1 + inc + .05,1/2},toff,tdir]},
				{n,ln}],
			Table[pt = {inc (2 n - 1) + (n - 1),inc};
				{rec[pt,{1,1},items[[n,1]]],
				Text[items[[n,2]],
					pt + {1/2, 1 + inc},toff,tdir]},
				{n,ln}]];
		lb = If[lspace != 0,
			Text[label,
				If[orient === Vertical,
					{(2 inc + 1 + tspace)/2,
						(2 inc + 1) ln + lspace/2},
					{(2 inc + 1) ln /2,
						2 inc + 1 + tspace + lspace/2}],
				{0,0}],
			{}];
		rn = If[orient === Vertical,
			{{-bspace,2 inc + 1 + tspace + bspace},
				{-bspace,(2 inc + 1) ln + lspace + bspace}},
			{{-bspace,(2 inc + 1) ln + bspace},
				{-bspace,2 inc + 1 + tspace + lspace + bspace}}];
		If[Not[Head[size] === List],
			If[Not[NumberQ[size]], size = .8];
			tmp = Map[#[[2]] - #[[1]] &,rn];
			size = tmp (size/Max[tmp])];
		as = size[[2]]/size[[1]];
		gr = Graphics[{boxes,lb},AspectRatio->as,PlotRange->rn];
		If[shadow =!= None,
			If[shadow === Automatic, shadow = {.05,-.05}];
			sbox = ShadowBox[pos,size,ShadowForeground->back,
				ShadowBorder->bord,ShadowOffset->shadow,opts],
			sbox = {}];
		Flatten[{sbox,Rectangle[pos,pos + size,gr]}]]
			

rec[start:{_,_},size:{_,_},style_] :=
	Module[{nrec},
		nrec = Rectangle[start, start + size];
		If[MemberQ[{RGBColor,Hue,CMYKColor,GrayLevel},
				Head[style]],
			{style,nrec},
			Append[nrec,style]]]


ShowLegend[agr_,largs:({__}..),opts:(_Rule | _RuleDelayed)...] :=
	Module[{as,ls={largs},rec,ap},
		as = FullOptions[agr,AspectRatio];
		bk = FullOptions[agr,Background];
		If[!NumberQ[as], as = 1];
		If[as > 1,
			rec = Rectangle[{-1/as,-1},{1/as,1},agr];
				ap = {-1/as - .2,-1.2},
			rec = Rectangle[{-1,-as},{1,as},agr];
				ap = {-1.2,-as - .2}];
		ls = MapAt[Append[#,LegendPosition->ap]&,ls,1];
		ls = Apply[Legend,ls,{1}];
		Show[Graphics[{rec,ls},FilterOptions[Graphics,opts],
			Background->bk,AspectRatio->Automatic,PlotRange->All]]]


Unprotect[Plot];

Plot/: Plot[fn_,r_,o1___,PlotLegend->None,o2___] :=
	Plot[fn,r,Evaluate[FilterOptions[Plot,o1,o2]]]

Plot/: Plot[fn_,r_,o1___,PlotLegend->lg_,o2___] :=
	Module[{txt = lg,sopts,gopts,lopts,ps,disp,ln,gr,tb},
		gopts = FilterOptions[Plot,o1,o2];
		sopts = FilterOptions[ShadowBox,o1,o2];
		lopts = FilterOptions[Legend,o1,o2];
		{ps,disp} = {PlotStyle,DisplayFunction}/.{gopts}/.
				Options[Plot];

		ln = If[Head[fn] === List, Length[fn],1];

		If[Head[txt] =!= List, txt = {txt},
		If[Length[txt] == 0, txt = {""}]];
		While[Length[txt] < ln,txt = Join[txt,txt]];
		txt = Take[txt,ln];
			
		If[ps === Automatic,ps = {}];
		If[Head[ps] =!= List, ps = {ps},
		If[Length[ps] == 0, ps = {{}}]];
		While[Length[ps] < ln,ps = Join[ps,ps]];
		ps = Take[ps,ln];
		ps = ps/.Dashing[x_] -> Dashing[2/.3 x]; (* scale dashes *)

		tb = Table[{Graphics[Flatten[{ps[[n]],
			Line[{{0,0},{1,0}}]}]],txt[[n]]},{n,ln}];

		gr = Insert[
			Plot[fn,r,DisplayFunction->Identity,Evaluate[gopts]],
			DisplayFunction->disp,2];

		ShowLegend[gr,{tb,sopts,lopts}]]

Protect[Plot];

End[]

EndPackage[]
