
(* Author: Kevin McIsaac; modified by Igor Rivin, Tom Wickham-Jones and
			John M. Novak *)
Begin["System`"]

Unprotect[{ContourGraphics, 
           SurfaceGraphics, 
           DensityGraphics,
	   Graphics,
	   Graphics3D,
	   FullOptions,
	   FullGraphics,
	   Options
	   }]


Begin["Graphics`Private`"]

FilterOptions[command_Symbol, opts___] := 
	Block[{keywords = First /@ Options[command]},
		Sequence @@ Select[Flatten[{opts}],
                        MemberQ[keywords, First[#]]&]
	]
 
FullOptions[x_List,y_] :=
	Map[FullOptions[#,y]&,x]

FullOptions[x_,y_List] :=
	Map[FullOptions[x,#]&,y]

FullOptions[x_, y_]:=
        Module[{ names},
                names = Map[ First, Options[ Head[x]]] ;
                If[ MemberQ[ names, y], (y /. FullOptions[x]),
                                        Message[FullOptions::optx, y, x];
                                        y ]
        ] /; GTest[ Head[x]]
 
FullOptions[ x_] :=
        Module[{plrng, opts, names, vals, asp },
                plrng = PlotRange[x] ;
                names = Map[ First, Options[ Head[x]]] ;
		opts = Flatten[ If[ Length[x] == 0, {},
					  Drop[ List @@ x, 1]]] ;
                opts = Select[  opts, (Head[#] == RuleDelayed ||
                                       Head[#] == Rule)& ] ;
                opts = Join[ opts, Options[ Head[x]]] ;
                opts = CheckGopt[ Head[x], opts, plrng] ;
                opts = Prepend[ opts, PlotRange -> plrng] ;
                opts = Join[ GetAx[x], opts] ;
                vals = names /. opts ;
                opts = Transpose[ {names, vals}] ;
                Map[ Apply[Rule, #]&, opts]//N
        ]  /; GTest[ Head[x]] && Length[x] =!= 0
 
GTest[ x_] := MemberQ[ {Graphics, Graphics3D, GraphicsArray,
                        SurfaceGraphics, DensityGraphics,
                        ContourGraphics}, x]

CheckGopt[ x_, opts_, plrng_] :=
        Module[{asp, xmin, xmax,
                     ymin, ymax},
                asp = AspectRatio /. opts ;
                If[ asp === Automatic,
                        {{xmin, xmax}, {ymin, ymax}} = Take[ plrng, {1,2}];
                        If[ xmin != xmax, asp = ((ymax-ymin)/(xmax-xmin)),
                                          asp = 1., asp = 1.] ;
                        Prepend[ opts, AspectRatio -> asp] ,
                        opts ]
        ] /; MemberQ[ { Graphics, GraphicsArray,
                        ContourGraphics, DensityGraphics}, x]

CheckGopt[ x_, opt_, plrng_] :=
        Module[{box, xmin, xmax,
                     ymin, ymax,
                     zmin, zmax, opts = opt, vc},
                vc = ViewCenter /. opts ;
                If[ vc == Automatic, opts =
                          Prepend[ opts, ViewCenter -> {.5,.5,.5}]] ;
                box = BoxRatios /. opts ;
                If[ box === Automatic,
                        {{xmin, xmax}, {ymin, ymax}, {zmin, zmax}} =  plrng;
                        If[ zmin != zmax, box = {((xmax-xmin)/(zmax-zmin)),
                                                 ((ymax-ymin)/(zmax-zmin)),
                                                   1.},
                                        box = {1.,1.,1.},
                                        box = {1.,1.,1.}] ;
                        Prepend[ opts, BoxRatios -> box],
                        opts]
        ] /; MemberQ[ { SurfaceGraphics, Graphics3D}, x]


GetAx[x_Graphics] :=
        Module[{ res, xax, yax,
                      xaxs, yaxs,
                      xorg, yorg,
                      xlab, ylab,
                      xstyl, ystyl,
                      x1ax, y1ax, x2ax, y2ax,
                      x1xs, y1xs, x2xs, y2xs,
                      x1lab, y1lab, x2lab, y2lab,
                      x1styl, y1styl, x2styl, y2styl },
 
                res = FullAxes[x] ;
		If[ Head[ res] === FullAxes, Return[{}]] ;
                {xax, yax} = Map[ OptFlat[#,3]&, Axes /. res] ;
                {xaxs, xorg, xlab, xstyl} = GetAx1[ xax] ;
                {yaxs, yorg, ylab, ystyl} = GetAx1[ yax] ;
                {x1ax, y1ax, x2ax, y2ax} = Map[ OptFlat[#,2]&, Frame /. res]
;
                {x1xs, x1lab, x1styl} = GetAx2[ x1ax] ;
                {y1xs, y1lab, y1styl} = GetAx2[ y1ax] ;
                {x2xs, x2lab, x2styl} = GetAx2[ x2ax] ;
                {y2xs, y2lab, y2styl} = GetAx2[ y2ax] ;
 
                Join[ { Axes -> {xaxs, yaxs},
                        AxesOrigin -> {xorg, yorg},
                        AxesLabel -> {xlab, ylab},
                        AxesStyle -> {xstyl, ystyl},
                        Frame -> {x1xs, y1xs, x2xs, y2xs},
                        FrameLabel -> {x1lab, y1lab, x2lab, y2lab},
                        FrameStyle -> {x1styl, y1styl, x2styl, y2styl}},res]
        ]

GetAx[x_] := {}

GetAx1[ ax_] :=
        {True, ax[[1]], ax[[2]], ax[[3]]} /; Length[ax] == 3
GetAx1[ ax_] :=
        {False, None, None, None}
GetAx2[ ax_] :=
        {True, ax[[1]], ax[[2]]} /; Length[ax] == 2
GetAx2[ ax_] :=
        {False, None, None}

 
OptFlat[ x_, n_] := Flatten[x,1] /; Length[x] == 1 && Length[x[[1]]] == n
OptFlat[ x_, n_] := x

SurfaceGraphics /: 
ContourGraphics[SurfaceGraphics[data_,opt___]] :=
	ContourGraphics[data, Axes -> False, FilterOptions[ContourGraphics,opt]]
 
SurfaceGraphics /: 
DensityGraphics[SurfaceGraphics[data_,opt___]] :=
	DensityGraphics[data, Axes -> False,FilterOptions[ContourGraphics,opt]]
 
ContourGraphics /: 
SurfaceGraphics[ContourGraphics[data_,opt___]] :=
	SurfaceGraphics[data, FilterOptions[SurfaceGraphics,opt]]
 
ContourGraphics /: 
DensityGraphics[ContourGraphics[data_,opt___]] :=
	DensityGraphics[data, FilterOptions[DensityGraphics,opt]]
 
DensityGraphics /: 
SurfaceGraphics[DensityGraphics[data_,opt___]] :=
	SurfaceGraphics[data, FilterOptions[SurfaceGraphics,opt]]
 
DensityGraphics /: 
ContourGraphics[DensityGraphics[data_,opt___]] :=
	ContourGraphics[data, FilterOptions[ContourGraphics,opt]]

End[]

SetAttributes[ {ContourGraphics, 
           	 SurfaceGraphics, 
           	 DensityGraphics,
	   	 Graphics,
	   	 Graphics3D,
	   	 Options,
		 FullOptions,
	   	 FullGraphics},
	{Protected,ReadProtected}]


End[];

