(* ::Package:: *)

(* ::Section:: *)
(*Zykloiden.m*)


(* ::Subsection:: *)
(*BeginPackage*)


BeginPackage["Zykloiden`"];


(* ::Subsection:: *)
(*Globale Objekte*)


(* ::Subsubsection:: *)
(*Radienlisten f\[UDoubleDot]r logarithmischer Slider*)


radienlisteEpi = Union[Sort[Flatten[Table[z/n, {z, 4}, {n, 4}]]]];
radienlisteEpiLog = Log[radienlisteEpi];
radienlisteHypo = Union[Sort[Flatten[Table[z/n, {z,5,8}, {n, 4}]]]];
radienlisteHypoLog = Log[radienlisteHypo];



imageSize = {400, 400};


r1r2;
colorControls;  (* declare Symbols in local context *)


(* ::Subsubsection:: *)
(*Farbeinsteller*)


makeColorControls[] :=
 Module[
  {color, colorName, colorSliders, resetButton},
  ClearColors[];
  {color, colorName} = Transpose@
    {{farbeZeiger, "Zeiger"},
     {farbeFestkreis, "Festkreis"},
     {farbeBahnkurve, "Bahnkurve"},
     {farbeRollkreis, "Rollkreis"},
     {farbeHintergrund, "Hintergrund"}};
  
  colorSliders = Transpose@{colorName, ColorSlider /@ Dynamic /@ color};
  resetColorsToDefault[];
  resetButton = {"", Button["Reset", resetColorsToDefault[]]};
  Grid[Append[colorSliders, resetButton], Alignment -> {Left, Left}]
 ]


(* ::Subsection::Closed:: *)
(*Normale Zykloide*)


(* ::Text:: *)
(*Parameter:*)
(*1. Abstand des Zeichenpunktes vom Mittelpunkt des Rollkreises*)
(*2. Gesamter Drehwinkel des Rollkreises*)
(*3. Aktueller Drehwinkel des Rollkreises*)


zeichneZykloide[stabLaenge_: - 1, maxWinkel_: - 1, winkel_: - 1] :=
 Module[{radius, pointRadius, offset, zykloide, rollkreisCenter, rollkreis, rollkreisRand, kurve, punkt, linie, grundlinie, a, b, c, d, checkParameter},
  
  (* Plausibilit\[ADoubleDot]tspr\[UDoubleDot]fung der Parameter*)
  checkParameter[] := stabLaenge >= 0 && maxWinkel > 0 && winkel >= 0 && winkel <= maxWinkel;
  If[checkParameter[] == False, Print["Usage: zeichneZykloide[stabLaenge,maxWinkel,winkel]"]; Return[]];
  
  (* PlotRange *)
  radius = 1;
  pointRadius = 0.08*radius;
  offset = 0.1;
  a = -Max[stabLaenge, radius] - offset;
  b = maxWinkel*radius + Max[stabLaenge, radius] + offset;
  c = -Max[stabLaenge - radius, 0] - pointRadius - offset;
  d = Max[stabLaenge + radius, 2 radius] + pointRadius + offset;
  
  (* Koordinatenberechnungsfunktionen f\[UDoubleDot]r bewegte Teile *)
  rollkreisCenter[t_] := {radius*t, radius};
  zykloide[t_] := rollkreisCenter[t] - stabLaenge {Sin[t], Cos[t]};
  
  (* Grafikobjekte *)
  rollkreis = Graphics[{Dynamic[farbeRollkreis], Disk[rollkreisCenter[winkel], radius]}];
  rollkreisRand = Graphics[{GrayLevel[0.3], Circle[rollkreisCenter[winkel], radius]}];
  linie = Graphics[{Dynamic[farbeZeiger], AbsoluteThickness[1.5], Line[ {rollkreisCenter[winkel], zykloide[winkel]}]}];
  grundlinie = Graphics[{Black, AbsoluteThickness[1.5], Line[ {{a, 0}, {b, 0}}]}];
  punkt = Graphics[{farbeZeiger, Disk[zykloide[winkel], pointRadius]}];
  kurve = {};
  If[winkel > 0,
   kurve = ParametricPlot[zykloide[t], {t, 0, winkel}, PlotStyle -> Dynamic[farbeBahnkurve]]
   ];
  
  Show[
   grundlinie, rollkreis, rollkreisRand, kurve, linie, punkt,
   PlotRange -> {{a, b}, {c, d}}, ImageSize -> imageSize, Background -> Dynamic[farbeHintergrund]
   ]
  ]


(* ::Subsubsection:: *)
(*Kurzaufruf *)


zeigeZykloide[opts___] :=
  Manipulate[
    zeichneZykloide[clamp[l], 4 Pi, 2 Pi x],
    {{l, 1, "Stabl\[ADoubleDot]nge"}, 0, 9},
    {{x, 1, "Ort"}, 0, 2}
  ]



(* ::Subsection:: *)
(*Epizykloide*)


(* ::Text:: *)
(*Parameter:*)
(*1. Verh\[ADoubleDot]ltnis Radius Rollkreis zum Radius Festkreis*)
(*2. Verh\[ADoubleDot]ltnis Entfernung des Zeichenpunktes vom Mittelpunkt des Rollkreises zum Radius des Rollkreises*)
(*3. Umlaufparameter, p=0...1*)
(*Optionen:	parameterRange->Fixed: das kleinere der beiden R\[ADoubleDot]der macht eine Umdrehung*)
(*		parameterRange->Automatic: der Parameter wird so skaliert, das ein voller Zyklus durchlaufen wird. Hierf\[UDoubleDot]r mussp  eine rationanle Zahl sein*)


zeichneEpizykloide[r1r2Ratio_, stablaengeRelativ_, p_, opts___] :=
 Module[
  {rInnen, rAussen, pointRadius, offset, stablaenge, ort, epizykloide, checkParameter, rollkreis, rollkreisRand, rollkreisCenter, linie, punkt, festkreis, festkreisRand, kurve, a, b, c, d, parameterRangeVal},
  
  (* Plausibilit\[ADoubleDot]tspr\[UDoubleDot]fung der Parameter*)
  checkParameter[] := r1r2Ratio > 0 && stablaengeRelativ >= 0 && p >= 0;
  If[checkParameter[] == False, Print["Usage: zeichneEpizykloide[radienverh\[ADoubleDot]ltnis,stablaengeRelativ,param]"]; Return[]];
  
  (* Optionen auswerten *)
  parameterRangeVal = parameterRange /. {opts};
  If[parameterRangeVal == parameterRange, parameterRangeVal = Automatic];(* default *)
  
  (* Werte setzen *)
  rInnen = 1;
  rAussen = rInnen*r1r2Ratio;
  stablaenge = stablaengeRelativ r1r2Ratio;
  pointRadius = 0.1*rAussen;
  ort = 2 Pi*p;
  If[parameterRangeVal == Automatic, ort = 2 Pi*p*Numerator[r1r2Ratio]];
  
  (* PlotRange *)
  offset = 0.2;
  a = -(rInnen + 2 rAussen + stablaenge + offset);
  b = rInnen + 2 rAussen + stablaenge + offset;
  c = -(rInnen + 2 rAussen + stablaenge + offset);
  d = rInnen + 2 rAussen + stablaenge + offset;
  
  (* Koordinatenberechnungsfunktionen f\[UDoubleDot]r bewegte Teile *)
  rollkreisCenter[t_] :=
   {(rInnen + rAussen)*Cos[t],
    (rInnen + rAussen)*Sin[t]
    };
  epizykloide[t_] :=
   rollkreisCenter[t] - stablaenge*
     {Cos[((rInnen + rAussen)/rAussen)*t],
      Sin[((rInnen + rAussen)/rAussen)*t]
      };
  
  (* Grafikobjekte *)
  rollkreis = Graphics[{Dynamic[farbeRollkreis], Disk[rollkreisCenter[ort], rAussen]}];
  rollkreisRand = Graphics[{GrayLevel[0.3], Circle[rollkreisCenter[ort], rAussen]}];
  linie = Graphics[{Dynamic[farbeZeiger], AbsoluteThickness[2], Line[ {rollkreisCenter[ort], epizykloide[ort]}]}];
  punkt = Graphics[{Dynamic[farbeZeiger], Disk[epizykloide[ort], pointRadius]}];
  festkreis = Graphics[{Dynamic[farbeFestkreis], Disk[{0, 0}, rInnen]}];
  festkreisRand = Graphics[{GrayLevel[0.6], Circle[{0, 0}, rInnen]}];
  kurve = {};
  If[ort > 0,
   kurve = ParametricPlot[Evaluate[epizykloide[t]], {t, 0, ort}, PlotStyle -> farbeBahnkurve]
   ];
  
  Show[
   festkreis, festkreisRand, rollkreis, rollkreisRand, kurve, linie, punkt,
   PlotRange -> {{a, b}, {c, d}}, Background -> Dynamic[farbeHintergrund], ImageSize -> imageSize]
  ]


(* ::Subsubsection:: *)
(*Kurzaufruf mit logarithmischem Slider und Listenwerte f\[UDoubleDot]r Radienverh\[ADoubleDot]ltnis*)


zeigeEpizykloide[opts___] :=
  Module[
  {radienliste, radienlisteLog},
  radienliste = Union[Sort[Flatten[Table[z/n, {z, 4}, {n, 4}]]]];
  radienlisteLog = Log[radienliste];
  Manipulate[
   TableForm[
    {rational2String[Exp[n\[ADoubleDot]chsterWert[r, radienlisteLog]]],
     zeichneEpizykloide[Exp[n\[ADoubleDot]chsterWert[r, radienlisteLog]], clamp[l], x, opts]}],
   {{r, Log[1/4], "Radienverh\[ADoubleDot]ltnis"}, Min[radienlisteLog], Max[radienlisteLog]},
   {{l, 1, "Stabl\[ADoubleDot]nge"}, 0, 9},
   {{x, 1, "Ort"}, 0, 1}
   ]
  ]


(* ::Subsection:: *)
(*Hypozykloide*)


(* ::Text:: *)
(*Parameter:*)
(*1. Verh\[ADoubleDot]ltnis Radius Festkreis zum Radius rollkreis*)
(*2. Abstand des Zeichenpunktes vom Mittelpunkt des rollkreises*)
(*3. Drehwinkel des Festkreises*)
(*4. Anzahl der Einzelbilder der Animation (x2 f\[UDoubleDot]r R\[UDoubleDot]ckzeichnen)*)
(*5. R\[UDoubleDot]ckzeichnen An/Aus (bool)*)


zeichneHypozykloide[r1r2Ratio_, stablaenge_, p_, opts___] :=
 Module[
  {rInnen, rAussen, pointRadius, offset, ort, hypozykloide,
   checkParameter, rollkreis, rollkreisRand, rollkreisCenter,
   linie, punkt, festkreis, festkreisRand, kurve, parameterRangeVal,
   a, b, c, d},
  
  (* Plausibilit\[ADoubleDot]tspr\[UDoubleDot]fung der Parameter*)
  checkParameter[] := r1r2Ratio > 1 && stablaenge >= 0 && p >= 0;
  If[checkParameter[] == False, Print["Usage: zeichneZykloide[radienverh\[ADoubleDot]ltnis,stablaengeRelativ,param]"]; Return[]];
  
  (* Debug-Ausgabe *)
  (*Print["r1r2Ratio = ",r1r2Ratio,", stablaenge = ",stablaenge,", p = ",p];*)
  
  (* Optionen auswerten *)
  parameterRangeVal = parameterRange /. {opts};
  If[parameterRangeVal == parameterRange, parameterRangeVal = Automatic];(* default *)
  
  (* Werte setzen *)
  rInnen = 1;
  rAussen = r1r2Ratio*rInnen;
  pointRadius = 0.08*rInnen;
  ort = 2 Pi*p;
  If[parameterRangeVal == Automatic, ort *= Denominator[r1r2Ratio]];
  
  (* PlotRange {{a,b}, {c,d}} *)
  offset = 0.2*rInnen;
  a = -(rAussen + Max[0, stablaenge - rInnen] + offset);
  b = -a;
  c = a;
  d = b;
  
  (* Darstellungsfunktionen f\[UDoubleDot]r variable Teile *)
  rollkreisCenter[t_] :=
   {(rAussen - rInnen)*Cos[t],
    (rAussen - rInnen)*Sin[t]
    };
  hypozykloide[t_] := rollkreisCenter[t] + stablaenge*
     {Cos[((rInnen - rAussen)/rInnen)*t],
      Sin[((rInnen - rAussen)/rInnen)*t]};
  
  (* Grafikobjekte *)
  rollkreis = Graphics[{Dynamic[farbeRollkreis], Disk[rollkreisCenter[ort], rInnen]}];
  rollkreisRand = Graphics[{GrayLevel[0.3], Circle[rollkreisCenter[ort], rInnen]}];
  linie = Graphics[{Dynamic[farbeZeiger], AbsoluteThickness[2], Line[ {rollkreisCenter[ort], hypozykloide[ort]}]}];
  punkt = Graphics[{Dynamic[farbeZeiger], Disk[hypozykloide[ort], pointRadius]}];
  festkreis = Graphics[{Dynamic[farbeHintergrund], Disk[{0, 0}, rAussen]}];
  festkreisRand = Graphics[{GrayLevel[0.7], Circle[{0, 0}, rAussen]}];
  kurve = {};(* falls ort=0 gibt es keine Kurve*)
  If[ort > 0,
   kurve = ParametricPlot[hypozykloide[t], {t, 0, ort}, PlotStyle -> Dynamic[farbeBahnkurve]]
  ];

  Show[
   festkreis, festkreisRand, rollkreis, rollkreisRand,
      kurve, linie, punkt,
   PlotRange -> {{a, b}, {c, d}},
   ImageSize -> imageSize,
   Background -> Dynamic[farbeFestkreis]]
  ]


(* ::Subsubsection:: *)
(*Kurzaufruf mit logarithmischem Slider und Listenwerte f\[UDoubleDot]r Radienverh\[ADoubleDot]ltnis*)


zeigeHypozykloide[opts___] :=
 Module[
  {radienliste, radienlisteLog},
  radienliste = Union[Sort[Flatten[Table[z/n, {z, 5, 8}, {n, 4}]]]];
  radienlisteLog = Log[radienliste];
  Manipulate[
   TableForm[
    {rational2String[Exp[n\[ADoubleDot]chsterWert[r, radienlisteLog]]],
     zeichneHypozykloide[Exp[n\[ADoubleDot]chsterWert[r, radienlisteLog]], clamp[l], x, opts]}
    ],
   {{r, Log[3], "Radienverh\[ADoubleDot]ltnis"}, Min[radienlisteLog], Max[radienlisteLog]},
   {{l, 1, "Stabl\[ADoubleDot]nge"}, 0, 9},
   {{x, 1, "Ort"}, 0, 1}
   ]
  ]


(* ::Subsection::Closed:: *)
(*Hilfsfunktionen*)


(* ::Subsubsection:: *)
(*n\[ADoubleDot]chsterWert*)



n\[ADoubleDot]chsterWert[x_, l_List] :=
 Module[{winner = 1, i},
  For[i = 2, i <= Length[l], i++,
   If[Abs[N[l[[winner]]] - x] > Abs[N[l[[i]]] - x], winner = i]
   ];
  l[[winner]]
 ]



(* ::Subsubsection:: *)
(*clamp: rastet inder Umgebung der 1 ein (f\[UDoubleDot]r den Radius)*)



clamp[x_] :=
 Module[
  {tol = 0.1},
  If[x < 1 + tol && x > 1 - tol, Return[1]];
  x
 ]



(* ::Subsubsection:: *)
(*Pane mit Controls erzeugen*)



controlsNormalzykloide[Dynamic@{t_, l\[ADoubleDot]nge_}] :=
 Module[
  {label},
  label =
   {Style["Ort", FontFamily -> "Helvetica"],
    Style["Stabl\[ADoubleDot]nge", FontFamily -> "Helvetica"],
    Spacer[79]};
   Grid[
   {{label[[1]], Spacer[3], Manipulator[Dynamic[t], {0, 2}]},
    {label[[2]], Spacer[3], Manipulator[Dynamic[l\[ADoubleDot]nge], {0, 9}]},
    {label[[3]], Spacer[3], Spacer[1]}
    },
    Alignment -> {{Right, Center, Left}, {Center, Center, Center}}
   ]
  ]




controlsEpizykloide[Dynamic@{t_, l\[ADoubleDot]nge_, r1r2_}] :=
 Module[
  {label, rMin, rMax},
  rMin = Min@radienlisteEpiLog;
  rMax = Max@radienlisteEpiLog;
  label =
   {Style["Ort", FontFamily -> "Helvetica"],
    Style["Stabl\[ADoubleDot]nge", FontFamily -> "Helvetica"],
    Style["Radienverh\[ADoubleDot]ltnis", FontFamily -> "Helvetica"]};
   Grid[
   {{label[[1]], Spacer[3], Manipulator[Dynamic[t], {0, 1}]},
    {label[[2]], Spacer[3], Manipulator[Dynamic[l\[ADoubleDot]nge], {0, 9}]},
    {label[[3]], Spacer[3], Manipulator[Dynamic[r1r2], {rMin, rMax}]},
    {Null,Spacer[3],Dynamic@rationalToString[Exp@r1r2,radienlisteEpi]}
    },
    Alignment -> {{Right, Center, Left}, {Center, Center, Center}}
   ]
  ]




controlsHypozykloide[Dynamic@{t_, l\[ADoubleDot]nge_, r1r2_}] :=
 Module[
  {label, rMin, rMax},
  rMin = Min@radienlisteHypoLog;
  rMax = Max@radienlisteHypoLog;
  label =
   {Style["Ort", FontFamily -> "Helvetica"],
    Style["Stabl\[ADoubleDot]nge", FontFamily -> "Helvetica"],
    Style["Radienverh\[ADoubleDot]ltnis", FontFamily -> "Helvetica"]};
   Grid[
   {{label[[1]], Spacer[3], Manipulator[Dynamic[t], {0, 1}]},
    {label[[2]], Spacer[3], Manipulator[Dynamic[l\[ADoubleDot]nge], {0, 9}]},
    {label[[3]], Spacer[3], Manipulator[Dynamic[r1r2], {rMin, rMax}]},
    {Null,Spacer[3],Dynamic@rationalToString[Exp@r1r2,radienlisteHypo]}
    },
   Alignment -> {{Right, Center, Left}, {Center, Center, Center}}
   ]
  ]



(* ::Subsection:: *)
(*Begin["`Private`"]*)


(************************************************************************)
Begin["`Private`"]
(************************************************************************)


(* ::Subsubsection:: *)
(*Radienverh\[ADoubleDot]ltnis als String darstellen*)


 Clear[farbeZeiger, farbeFestkreis, farbeBahnkurve, farbeRollkreis, farbeHintergrund];



(* ::Subsubsection:: *)
(*Radienverh\[ADoubleDot]ltnis als String darstellen*)


rationalToString[approxValue_, valueList_] :=
 Module[
  {r1r2},
  r1r2 = n\[ADoubleDot]chsterWert[approxValue, valueList];
  ToString[TraditionalForm["\!\(\*SubscriptBox[\"R\", \"1\"]\)"/"\!\(\*SubscriptBox[\"R\", \"2\"]\)"]] <> " = " <> ToString[TraditionalForm@r1r2]
 ]


(* ::Subsubsection:: *)
(*rational2String*)


rational2String[r_]:="r1/r2 = "<>ToString[Numerator[r]]<>"/"<>ToString[Denominator[r]]


(* ::Subsubsection:: *)
(*Farben*)


farben = {farbeZeiger, farbeFestkreis, farbeBahnkurve, 
farbeRollkreis, farbeHintergrund};


 ClearColors[] := Clear[farbeZeiger, farbeFestkreis, farbeBahnkurve, farbeRollkreis, farbeHintergrund];


resetColorsToDefault[] :=
 Module[{},
  farbeZeiger = RGBColor[0/255., 0/255., 159/255.];
  farbeFestkreis = RGBColor[157/255., 204/255., 197/255.];
  farbeBahnkurve = Red;
  farbeRollkreis = RGBColor[232/255., 213/255., 104/255.];
  farbeHintergrund = GrayLevel[0.95];
 ]


RGBColorByte[r_,g_,b_]:=RGBColor[r/255.,g/255.,b/255.]


(* ::Subsection::Closed:: *)
(*End Package*)


(************************************************************************)
End[]             (* end `Private` Context                              *)
(************************************************************************)


 (************************************************************************)
EndPackage[]      (* end package Context                                *)
(************************************************************************)
