Mirrors

MIRROR=Module[{xo,ho,xi,hi,G,F,PlotOBJECT,PlotIMAGE,PlotMIRROR,PL,IMAGE,FLAT},
Manipulate[
ho=2;
PlotOBJECT={
Graphics[Text[Style["Object",{Directive[18],FontFamily->"Palatino"}],{xo,-0.5}]],
Graphics[{Gray,Thickness[0.005],Arrowheads[0.02],Arrow[{{xo,0},{xo,ho}}]}]
};
If[Abs[xo G+1]>0.001,
{IMAGE=True;
xi:=-xo/(xo G+1);
hi:=ho/(xo G+1);
PlotIMAGE={
Graphics[Text[Style["Image",{Directive[18],FontFamily->"Palatino"}],{xi,-0.5 Sign[hi]}]],
Graphics[{Orange,Thickness[0.005],Arrowheads[0.02],Arrow[{{xi,0},{xi,hi}}]}]
}
},
IMAGE=False
];
If[Abs[G]<0.001,
{FLAT=True;
PlotMIRROR={
Graphics[{Cyan,Thickness[0.003],Line[{{0,-4},{0,4}}]}]
};
PL="Flat Mirror";
},
{FLAT=False;
F:=1/G;
PlotMIRROR={
ListPlot[{{-F,0}},PlotMarkers->{Automatic,Medium},PlotStyle->{Cyan}],
Graphics[Text[Style["F",{Directive[18],FontFamily->"Palatino"}],{-F,-0.5}]]
};
If[F>0,
{AppendTo[PlotMIRROR,
{Graphics[{Cyan,Thickness[0.003],,Circle[{-2 F,0},2F,{-ArcSin[-2/F],ArcSin[-2/F]}]}]}
];
PL="Concave Mirror"
},
{AppendTo[PlotMIRROR,
{Graphics[{Cyan,Thickness[0.003],Circle[{-2 F,0},-2F,{Pi-ArcSin[-2/F],Pi+ArcSin[-2/F]}]}]}
];
PL="Convex Mirror"
}
]
}
];
Figure={
ListPlot[{{0,0}},PlotMarkers->{Automatic,Medium},PlotStyle->{Cyan}, PlotRange->{{-22,20},{-10,10}},GridLines->{{-20,-19,-18,-17,-16,-15,-14,-13,-12,-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20},{-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7,8,9,10}},Ticks->{None,None},AspectRatio->Automatic,AxesLabel->{None,None},LabelStyle->{Directive[20],FontFamily->"Palatino"},PlotLabel->PL],
Graphics[{Thickness[0.001],Arrowheads[0.015],Arrow[{{20,0},{-20,0}}]}],
Graphics[Text[Style["(Subscript[s, o]),(Subscript[s, i])",Directive[20],FontFamily->"Palatino"],{-21,0}]]
};
AppendTo[Figure,PlotMIRROR];
AppendTo[Figure,PlotOBJECT];
AppendTo[Figure,{
Graphics[{Red,Thickness[0.001],Arrowheads[0.015],Arrow[{{xo,ho},{0,0}}]}],
Graphics[{Red,Thickness[0.001],Arrowheads[0.015],Arrow[{{0,0},{-20,40/xo}}]}],
Graphics[{Darker[Green],Thickness[0.001],Arrowheads[0.015],Arrow[{{xo,2},{0,2}}]}],
Graphics[{Darker[Green],Thickness[0.001],Arrowheads[0.015],Arrow[{{0,2},{-20,2(1-20G)}}]}]
}
];
If[IMAGE,
{AppendTo[Figure,PlotIMAGE];
AppendTo[Figure,
{Graphics[{Blue,Thickness[0.001],Arrowheads[0.015],Arrow[{{xo,2},{0,hi}}]}],
Graphics[{Blue,Thickness[0.001],Arrowheads[0.015],Arrow[{{0,hi},{-20,hi}}]}],
Graphics[{Dashed,Red,Thickness[0.001],Line[{{0,0},{xi,hi}}]}],
Graphics[{Dashed,Blue,Thickness[0.001],Line[{{0,hi},{xi,hi}}]}]
}
];
If[!FLAT,
If[ (hi>ho)||(hi<0) ,
AppendTo[Figure,{Graphics[{Dashed,Darker[Green],Thickness[0.001],Line[{{0,ho},{xi,hi}}]}]}],
AppendTo[Figure,{Graphics[{Dashed,Darker[Green],Thickness[0.001],Line[{{0,ho},{-F,0}}]}]}]
]
]
}
];
Show[Figure,ImageSize->Full],
{{G,0,"1/f"},-1/5,1/5},{{xo,-10,"-(Subscript[s, o])"},-20,-1,0.1},LabelStyle->{Directive[20],FontFamily->"Palatino"},ContinuousAction->True,ControlPlacement->Top
]
]

Export["Mirror.cdf",MIRROR,"CDF"]