Fichier cycloide_spherique_01.jps — Modifié le 12 Février 2008 à 10 h 58
%% d'apres les donnees de
%% http://www.mathcurve.com/courbes3d/cycloidspheric/cycloidspheric.shtml
-3 3 setxrange
-2 4 setyrange
70 setxunit
10 10 6 SetCamPos
0 0 0 SetCamView
-10 10 setxrange3d
-3 3 setyrange3d
2 setlinejoin
rouge
%% donnees
/a 3 def
/q 2 def
/w pi 2 div def
%% calculs
/b a q div def
/h b a w Cos mul sub w Sin div def
/R a dup mul h dup mul add sqrt def
/g {
3 dict begin
settvar
#rpn# (a/q)*((q - Cos(w))*Cos (t) + Cos (w)*Cos (t)*Cos (q*t) + Sin(t)*Sin(q*t))
#rpn# (a/q)*((q - Cos(w))*Sin (t) + Cos (w)*Sin (t)*Cos (q*t) - Cos(t)*Sin(q*t))
#rpn# (a/q)*(Sin (w*(1-Cos (q*t))))
end
} def
/g' {
3 dict begin
settvar
#rpn# (a/q)*((Cos(w)-q)*Sin (t) - Cos (w)*Sin (t)*Cos (q*t) - q*Cos (w)*Cos (t)*Sin (q*t) + Cos(t)*Sin(q*t)+ q*Sin(t)*Cos(q*t))
#rpn# (a/q)*((q - Cos(w))*Cos (t) + Cos (w)*Cos (t)*Cos (q*t) - q*Cos (w)*Sin (t)*Sin (q*t) + Sin(t)*Sin(q*t) - q*Cos(t)*Cos (q*t))
#rpn# (a/q)*((q^2)*w*Cos(q*t) * Cos (w*(1-Cos (q*t))) - (w*q*Sin(q*t))*q*w*Sin (q*t) * Sin (w*(1-Cos (q*t))))
end
} def
/g'' {
3 dict begin
settvar
#rpn# (a/q)*((Cos(w)-q)*Cos (t) - Cos (w)*Cos (t)*Cos (q*t) + q*Cos (w)*Sin (t)*Sin (q*t) + q*Cos (w)*Sin (t)*Sin (q*t) - (q^2)*Cos (w)*Cos (t)*Cos (q*t) - Sin(t)*Sin(q*t) + q*Cos(t)*Cos(q*t) + q*Cos(t)*Cos(q*t) - (q^2)*Sin(t)*Sin(q*t))
#rpn# (a/q)*((Cos(w)-q)*Sin (t) - Cos(w)*Sin(t)*Cos(q*t) - q*Cos(w)*Cos(t)*Sin(q*t) - q*Cos(w)*Cos(t)*Sin(q*t) - (q^2)*Cos(w)*Sin(t)*Cos(q*t) + Cos(t)*Sin(q*t) + q*Sin(t)*Cos(q*t) + q*Sin(t)*Cos (q*t) + (q^2)*Cos(t)*Sin(q*t))
#rpn# (a/q)*(q*w*Sin (q*t) * Cos (w*(1-Cos (q*t))))
end
} def
%% 0 pi 12 mul {g} CourbeR3
%% stop
.3 setlinewidth
/aretescachees false def
noir
GetCamPos setlightsrc
solidgridOff
0 2 pi mul (g) .05 [200 6] newtube
dup (rouge) outputcolors
R .15 sub [36 36] newsphere
{0 0 h translatepoint3d} solidtransform
dup (.5 setfillopacity jaune) outputcolors
solidfuz
drawsolid**