Clear[t];
Rounder[y_]:=Module[{x=y},If[x<=-π,x+=Ceiling[(Abs[x]-π)/(2π)]*2π];If[x>π,x-=Ceiling[(x-π)/(2π)]*2π];x];
Manipulate[
s=NDSolve[{θ''[t]==-θ'[t]/q-Sin[θ[t]]+g*Cos[ωd*t],θ[0]==θi,θ'[0]==ωi},θ,{t,tmin,tmax},MaxSteps->∞];
strobetimes=Table[N[i+StrobeAngle/ωd],{i,2π/ωd*Ceiling[ωd*tmin/(2π)],tmax-2π/ωd,2π/ωd}];i=1;poincaretable=Table[{Rounder[θ[strobetimes[[i]]]/.s[[1]]],θ'[strobetimes[[i]]]/.s[[1]]},{i,1,Length[strobetimes]}];
Show[ListPlot[{{time,(Rounder[θ[time]/.s[[1]]])}},PlotStyle->Directive[Purple,PointSize[Large]]],Plot[Rounder[θ[t]/.s[[1]]],{t,tmin,tmax},PlotRange->All],PlotRange->All,ImageSize->Large,AxesLabel->{"t","θ"},ImageSize->Large,PlotLabel->"Angular Displacement vs. Time"]
Show[ParametricPlot[{θ[t]/.s[[1]],θ'[t]/.s[[1]]},{t,tmin,tmax},AxesLabel->{"θ","ω"},PlotRange->All],
(*ListPlot[{{θ[time]/.s[[1]],θ'[time]/.s[[1]]}},PlotStyle->Directive[Purple,PointSize[0.02]]],*)ImageSize->Large,PlotLabel->"Phase Portrait"]
ListPlot[poincaretable,PlotLabel->"Poincare Plot",PlotRange->{{-π,π},{-1.2Max[Abs[poincaretable[[All,2]]]],1.2Max[Abs[poincaretable[[All,2]]]]}},ImageSize->Large,PlotStyle->PointSize[Large],AxesLabel->{"θ","ω"}]
ParametricPlot[{hyp*Sin[θ[time]],-hyp*Cos[θ[time]]}/.s,{hyp,0,1},PlotLabel->"Pendulum Visualization",Ticks->None,PlotRange->{{-1,1},{-1,1}},ImageSize->Medium,PlotStyle->Directive[Purple,Thickness[0.01]]],
{{time,tmin, "time (t)"},tmin,tmax},{{q,2,"Damping (q)"},0,10},{{ωd,2/3,"Drive frequency ((Subscript[ω, D]))"},0,10},{{g,0,"Drive amplitude (g)"},0,10},{{StrobeAngle,0},0,2π},{{θi,π/6,"Initial angular displacement ((Subscript[θ, i]))"},-π,π},{{ωi,0,"Intial angular speed ((Subscript[ω, i]))"},-10,10},{{tmin,20},0,tmax-.1},{{tmax,100},tmin+.1,10000}]