(* ::Package:: *)

(*Styling Options*)

StyleList = {AbsoluteThickness[1.0], AbsolutePointSize[5], #} & /@ {Blue, Red, Green, Purple};
SetOptions[Plot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[LogPlot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[ListLogPlot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[ParametricPlot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[ListPlot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[ListLinePlot, Frame -> True, Axes -> {True, False}, PlotStyle -> StyleList, AspectRatio -> 0.8, FrameStyle -> Directive[13]];
SetOptions[ListDensityPlot, Frame -> True, Axes -> {False, False}(*,  AspectRatio -> 0.8*), FrameStyle -> Directive[13]];
SetOptions[DensityPlot, Frame -> True, Axes -> {False, False}(*,  AspectRatio -> 0.8*), FrameStyle -> Directive[13]];
SetOptions[DensityHistogram, Frame -> True, Axes -> {False, False}(*,  AspectRatio -> 0.8*), FrameStyle -> Directive[13]];
SetOptions[ListContourPlot, Frame -> True, Axes -> {False, False}, FrameStyle -> Directive[13]];
SetOptions[Histogram, Frame -> True, Axes -> {True, False}, AspectRatio -> 0.8, FrameStyle -> Directive[13]];


XListPlot[list_, opt___] := Module[
                            {intfunc, xmin, xmax, pl1, pl2, pl},
                            
                           intfunc = Interpolation[list, InterpolationOrder -> 1(*3*)];
   
                           xmin = Min[Transpose[list][[1]]];
                           xmax = Max[Transpose[list][[1]]];
   
                           pl1 = Plot[intfunc[x], {x, xmax, xmin}, DisplayFunction -> Identity, opt];
                           pl2 = ListPlot[list, PlotStyle -> {Black, AbsolutePointSize[3]}, DisplayFunction -> Identity];
   
                           pl = Show[pl1, pl2, DisplayFunction -> $DisplayFunction];
   
                           Return[pl];
                           ];

Styli[colour_, text_]:=Style[Framed[text], 13, Black, Background -> Lighter[colour, 0.6]] ;


tYellow=RGBColor[1,0.8,0.2];

tColorList=ColorData[3,"ColorList"];
tColorList[[3]]=tYellow;
tColorList[[4]]=RGBColor[0,0.6,0];
tColorList=tColorList[[{6,2,4,7,5,10,8,9,3,1}]];

tCustomLegendItem::usage="tCustomLegendItem[type,text,options]";
tCustomLegend::usage="tCustomLegend[list,loc,options]";

(*Begin[''Privet''];*)
Unprotect[tCustomLegendItem];
Clear[tCustomLegendItem];

Options[tCustomLegendItem]={Rule[PlotStyle,{tColorList[[1]]}],Rule[LegendLabelStyle,{FontSize->15}]};

SyntaxInformation[tCustomLegendItem]={"ArgumentsPattern"->{_,_,OptionsPattern[]}};

tCustomLegendItem[type_,text_,options:OptionsPattern[]]:=Module[{object,styles,gfxOpts},Switch[type,Line,object=Line[{{0,0},{4,0}}];
gfxOpts={ImageSize->30,AspectRatio->1/4},Point,object=Disk[];
gfxOpts={ImageSize->{20,5}},Square,object=Rectangle[{0,0}];
gfxOpts={ImageSize->{20,5}},FullSquare,object=Rectangle[{0,0}];
gfxOpts={ImageSize->15}];
If[Head[OptionValue[PlotStyle]]===List,styles=Sequence@@OptionValue[PlotStyle],styles=OptionValue[PlotStyle]];
{Graphics[{styles,object},gfxOpts],Graphics[{Text[Style[text,OptionValue[LegendLabelStyle]]]},ImageSize->{Automatic,{20}}]}]

Protect[tCustomLegendItem];

Unprotect[tCustomLegend];
Clear[tCustomLegend];

Options[tCustomLegend]=Join[Options[GraphicsGrid],Options[tCustomLegendItem]];

SyntaxInformation[tCustomLegend]={"ArgumentsPattern"->{_,{_,_},OptionsPattern[]}};

tCustomLegend[list_,loc_,options:OptionsPattern[]]:=(Graphics@Inset[GraphicsGrid[list,Sequence@@Evaluate@FilterRules[{options},{Options[GraphicsGrid]}],Alignment->{{{Center,Left}}},Spacings->{1,0},PlotRangePadding->0.1],(*End of GraphicsGrid*)loc] (*End of Graphics@Inset*))

Protect[tCustomLegend];


reportColorRange[plotFunction_]:=Module[{p,min,max,plotHead,plotBody,colFunc,colScale,h,b,cf,cfs},{plotHead,plotBody}=First@Cases[Hold[plotFunction],h_[b__]->{h,Hold[b]},1];
(*plotBody is kept inside Hold because it will later be wrapped in plotHead which may have attribute HoldAll*)colFunc=Replace[(*Replace wraps string colorfunction names in ColorData[...]*)First@Join[Cases[plotBody,HoldPattern[ColorFunction->cf_]->cf],{colorD}
(*Extract color function or use default*)],s_String:>ColorData[s]];
colScale=First@Append[Cases[plotBody,HoldPattern[ColorFunctionScaling->cfs_]->cfs],True
(*ColorFunctionScaling is True by default*)];
(*Turn off ColorFunction and scaling:*)plotBody=plotBody/.HoldPattern[ColorFunction->_]|HoldPattern[ColorFunctionScaling->_]->Sequence[];
(*Make plot with Hue because it takes a single argument that's linear in the heigh value.*){min,max}={Min[#],Max[#]}&@Flatten@Last@Reap[p=Apply[plotHead,Join[(*Join creates a single Hold[...] expression,and Apply replaces hold with plotHead:*)plotBody,Hold[(*Collect the function values-color function scaling must be turned off:*)ColorFunction->{(Sow[#];Hue[#])&},ColorFunctionScaling->False]
(*Hue now could have arguments outside the interval[0,1].We'll recover them when restoring the original ColorFunction.*)]]];
(*Reap collects the unscaled height values,and we keep the extremal values max,min to rescale if desired:*){If[(*If p consists of ploygons colored by Hue,convert it back to the original color function:*)Cases[p,Hue[_],Infinity]=!={},If[(*Recover function values from Hue and plot them with desired color,scaled/unscaled:*)colScale,p/.Hue[x_]:>colFunc[(x-min)/(max-min)],p/.Hue[x_]:>colFunc[x]],(*If plotHead is one of my private custom plot functions,then p may be a raster image where Hue no longer appears explicitly.Then we have to re-do the entire plot with the original color function:*)plotFunction],colFunc,{min,max}}
(*The auxiliary Hue is replaced by the original ColorFunction stored in colFunc.*)]

SetAttributes[reportColorRange,HoldAll];
trimPoint[n_,digits_]:=(*display number n with given number of sig.digits,trim trailing decimal point*)NumberForm[n,digits,NumberFormat->(DisplayForm@RowBox[Join[{StringTrim[#1,RegularExpression["\\.$"]]},If[#3!="",{"\[Times]",SuperscriptBox[#2,#3]},{}]]]&)]

Options[colorLegend]={LabelStyle->Black,Background->LightGray,FrameStyle->None,RoundingRadius->10,"ColorSwathes"->None,"LeftLabel"->False,"Digits"->3,Contours->None,BoxFrame->0,"ColorBarFrameStyle"->Black,FrameStyle -> Directive[13]};

colorLegend[cFunc_,rawRange_,OptionsPattern[]]:=Module[{frameticks,tickPositions,nColor,nTick,range=N@Round[rawRange,10^Round[Log10[Abs@First@Differences[{-1.5,.5}]]]/1000],colors,contours=OptionValue[Contours],colorBarLabelStyle=OptionValue[LabelStyle],colorBarFrameStyle=OptionValue["ColorBarFrameStyle"],outerFrameStyle=OptionValue[FrameStyle],colorSwathes=OptionValue["ColorSwathes"]},(*Here we decide how many color gradations to diplay-either a given number,equally spaced,or "continuous," i.e.256 steps:*)Switch[colorSwathes,_?NumericQ,nColor=colorSwathes;
colors=(Range[nColor]-1/2)/nColor;
nTick=nColor,_,nColor=256;
colors=(Range[nColor]-1)/(nColor-1);
nTick=1];
(*Number of labels is nTick+1,unless changed by numerical Contours setting below:*)Switch[contours,_?NumericQ,tickPositions=(range[[1]]+(range[[-1]]-range[[1]]) (Range[contours+1]-1)/contours);,List[Repeated[_?NumericQ]],tickPositions=contours,_,tickPositions=(range[[1]]+(range[[-1]]-range[[1]]) (Range[nTick+1]-1)/nTick);];
frameticks={If[TrueQ[OptionValue["LeftLabel"]],Reverse[#],#]&@{None,Function[{min,max},{#,trimPoint[#,OptionValue["Digits"]],{0,.1}}&/@tickPositions]},{None,None}};
(*DisplayForm@FrameBox replaces Framed because it allows additional BoxFrame option to specify THICKNESS of frame:*)DisplayForm@FrameBox[(*Wrapped in Pane to allow unlimited resizing:*)Pane@Graphics[Inset[Graphics[(*Create strip of colored,translated unit squares.If colorSwathes are selected,colors don't vary inside squares.Otherwise,colors vary linearly in each of 256 squares to get smooth gradient using VertexColors:*)MapIndexed[{Translate[Polygon[{{0,0},{1,0},{1,1},{0,1}},VertexColors->{cFunc[#[[1]]],cFunc[#[[1]]],cFunc[#[[2]]],cFunc[#[[2]]]}],{0,#2[[1]]-1}]}&,Transpose[If[colorSwathes===None,{Most[colors],Rest[colors]}
(*Offset top versus bottom colors of polygons to create linear VertexColors*),{colors,colors}
(*Top and bottom colors are same when uniform colorSwathes are desired*)]]]  (**End MapIndexed**),(*Options for inset Graphics:*)ImagePadding->0,PlotRangePadding->0,AspectRatio->Full
(*AspectRatio->Full allows colored squares to strecth with resizing in the following.*)],(*Options for Inset:*){0,First[range]},{0,0},{1,range[[-1]]-range[[1]]}
(*this sets the size of the inset in the enclosing Graphics whose PlotRange is given next:*)],(*Options for enclosing Graphics:*)PlotRange->{{0,1},range[[{1,-1}]]},Frame->True,FrameTicks->frameticks,FrameTicksStyle->colorBarLabelStyle,FrameStyle->colorBarFrameStyle,AspectRatio->Full],(*Options for FrameBox:*)Background->OptionValue[Background],FrameStyle->outerFrameStyle,RoundingRadius->OptionValue[RoundingRadius],BoxFrame->OptionValue[BoxFrame]]]

at[position_,scale_: Automatic][obj_]:=(*convenience function to position objects in Graphics*)Inset[obj,position,{Left,Bottom},scale];

display[g_,opts:OptionsPattern[]]:=Module[{frameOptions=FilterRules[{opts},Options[Graphics]]},(*Same as Graphics,but with fixed PlotRange*)Graphics[g,PlotRange->{{0,1},{0,1}},Evaluate@Apply[Sequence,frameOptions]]];
