Ballet de pendules(pendulum waves) en 3D avec l'ombre des pendules

 Les fichiers :
Pendulum-Waves

% Le listing :

\documentclass[10]{article}
\usepackage{pst-solides3d}
\usepackage{animate}
\def\macrosPSPendulumWaves{
    /TabLongueursPendules [
         0 1 np 1 sub {/indicePendule exch def
         gp Gamma 2 Pi mul N0 indicePendule add mul div dup mul mul
         } for
         ] def
         /y0 0.02 def
/asin {neg dup dup mul neg 1 add sqrt neg atan 180 sub} bind def
    /TabAlpha0 [
    0 1 np 1 sub {/iP exch def
        y0 TabLongueursPendules iP get div asin
        } for
    ] def
    /TabZPendules [
    0 1 np 1 sub {/iP exch def
        TabLongueursPendules iP get
        TabAlpha0 iP get cos mul
        } for
    ] def
%    /ti 5 def
    /TabAlphan {[
     0 1 np 1 sub {/iP exch def
        /Alpha TabAlpha0 iP get def
        /Omega 360 Gamma N0 iP add div div def
         Alpha Omega ti mul cos mul
        } for
    ] }def }%
\makeatletter
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% la macro \psRotIIID
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Rotation autour d'un axe
%\define@key[psset]{pst-solides3d}{angle}{\def\psk@solides@angle{#1 }}% rotation autour de l'axe en degres
%#1 = angle de rotation
%\psRotIIID[solid=...]{angle}(x,y,z)
% (x,y,z) sont les coordonnées du solide comme pour \psSolid[..](x,y,z)
% les coordonnées du vecteur axe sont données par les coordonnées de
% 2 points avec l'option :
% base=x1 y1 z1 x2 y2 z2\def\psRotIIID{\pst@object{psRotIIID}}
\def\psRotIIID@i#1(#2,#3,#4){{%
  \pst@killglue%
  \use@par%
\addto@pscode{
    \tx@optionssolides
    SolidesDict begin
    /cosT {#1 cos} bind def
    /sinT {#1 sin} bind def
     base aload pop
       /f_ exch def
       /e_ exch def
       /d_ exch def
       /c_ exch def
       /b_ exch def
       /a_ exch def
       /u' {d_ a_ sub } bind def
       /v' {e_ b_ sub } bind def
       /w' {f_ c_ sub } bind def
       u' v' w' unitaire3d
       /w_ exch def /v_ exch def /u_ exch def
% end} def
/Rotation3D {
4 dict begin
   /M defpoint3d % on récupère les coordonnées
   M /z exch def
     /y exch def
     /x exch def
%   AXE
   a_ v_ dup mul w_ dup mul add mul
   u_
   b_ v_ mul c_ w_ mul add u_ x mul sub v_ y mul sub w_ z mul sub
   mul
   sub
   1 cosT sub mul
   x cosT mul add
   c_ v_ mul neg b_ w_ mul add w_ y mul sub v_ z mul add sinT mul add % x'
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   b_ u_ dup mul w_ dup mul add mul
   v_
   a_ u_ mul c_ w_ mul add u_ x mul sub v_ y mul sub w_ z mul sub
   mul
   sub
   1 cosT sub mul
   y cosT mul add
   c_ u_ mul a_ w_ mul sub w_ x mul add u_ z mul sub sinT mul add  % y'
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   c_ u_ dup mul v_ dup mul add mul
   w_
   a_ u_ mul b_ v_ mul add u_ x mul sub v_ y mul sub w_ z mul sub
   mul
   sub
   1 cosT sub mul
   z cosT mul add
   b_ u_ mul neg a_ v_ mul add v_ x mul sub u_ y mul add sinT mul add %z'
end} def
    end}%
\psSolid[transform=Rotation3D](#2,#3,#4)
\composeSolid%
}\ignorespaces%
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% transformation d'un point
\def\psRotIIIDPoint{\pst@object{psRotIIIDPoint}}
\def\psRotIIIDPoint@i#1(#2,#3,#4)#5{{% coordonnees cartesiennes
  \pst@killglue%
  \use@par%
\pnode(!
    \tx@optionssolides
    SolidesDict begin
    /cosT {#1 cos} bind def
    /sinT {#1 sin} bind def
     base aload pop
       /f_ exch def
       /e_ exch def
       /d_ exch def
       /c_ exch def
       /b_ exch def
       /a_ exch def
       /u' {d_ a_ sub } bind def
       /v' {e_ b_ sub } bind def
       /w' {f_ c_ sub } bind def
       u' v' w' unitaire3d
       /w_ exch def /v_ exch def /u_ exch def
    #2 #3 #4
     /z_ exch def
     /y_ exch def
     /x_ exch def
   a_ v_ dup mul w_ dup mul add mul
   u_
   b_ v_ mul c_ w_ mul add u_ x_ mul sub v_ y_ mul sub w_ z_ mul sub
   mul
   sub
   1 cosT sub mul
   x_ cosT mul add
   c_ v_ mul neg b_ w_ mul add w_ y_ mul sub v_ z_ mul add sinT mul add % x'
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   b_ u_ dup mul w_ dup mul add mul
   v_
   a_ u_ mul c_ w_ mul add u_ x_ mul sub v_ y_ mul sub w_ z_ mul sub
   mul
   sub
   1 cosT sub mul
   y_ cosT mul add
   c_ u_ mul a_ w_ mul sub w_ x_ mul add u_ z_ mul sub sinT mul add  % y'
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   c_ u_ dup mul v_ dup mul add mul
   w_
   a_ u_ mul b_ v_ mul add u_ x_ mul sub v_ y_ mul sub w_ z_ mul sub
   mul
   sub
   1 cosT sub mul
   z_ cosT mul add
   b_ u_ mul neg a_ v_ mul add v_ x_ mul sub u_ y_ mul add sinT mul add %z'
   3dto2d cm_1 exch cm_1 exch
   end){#5}%
  }\ignorespaces}
\makeatother
% 15 septembre 2014
\begin{document}

\begin{center}
\def\nImages{201}%  images
\def\base{10 0 0 0 0 0 }%
\begin{animateinline}[controls,loop,%palindrome,
                     begin={\begin{pspicture}(-3,-8)(5,3)},%
                     end={\end{pspicture}}]{5}% 5 images/s
\multiframe{\nImages}{r=0.0+0.035}{%
\psset{viewpoint=25 200 20 rtp2xyz,lightsrc=75 150 20 rtp2xyz,Decran=12.5,unit=1}
\psframe*(-3,-8)(5,3)%
\psPolygonIIID[fillstyle=solid](19,-5,-15)(18,5,0)(18,5,0)(0,5,0)(-1,5,-15)(-1,-5,-15)
\psPolygonIIID[fillstyle=solid,fillcolor=yellow!20](19,-5,-15)(19,5,-15)(19,5,0)(19,-5,0)
\psPolygonIIID[fillstyle=solid,fillcolor=yellow!20](19,5,-15)(-1,5,-15)(-1,5,0)(19,5,0)
\psSolid[object=grille,base=-1 19 -5 5,ngrid=10](0,0,-15)%
\pstVerb{/ti \r\space def
            /Gamma 7 def
            /N0 10 def % nombre d'oscillations de n=0
            /np 10 def % nombre de pendules
            /gp 9.81 def % pesanteur
            /Pi 3.14159265359 def
            /di 2 def % distance entre 2 pendules en cm
            \macrosPSPendulumWaves
            /Lx {gp Gamma 2 Pi mul N0 t di div add mul div dup mul mul} def
            /alpha0 {y0 Lx div asin} def
            /Omega0 {360 Gamma N0 t di div add div div} def
            /alphax {alpha0 Omega0 ti mul cos mul} def%
            /Hh 0 def /Hs 1 def /Hb 1 def /color {Hh Hs Hb} def /dH 1 np div def}%
%\defFunction{Waves}(t){t}{Lx alphax sin mul 100 mul}{Lx alphax cos mul 100 mul neg}%{-15}%
%\psSolid[object=courbe,
%        r=0,
%        range=0 18,
%        linecolor=gray,
%        resolution=360,
%        function=Waves]%
\psset{solidmemory}%
\multido{\i=9+-1}{10}{%
\definecolor[ps]{macouleur}{hsb}{color}%
\pstVerb{
    /Ln TabLongueursPendules \i\space get 100 mul def
    /ANGLE TabAlphan \i\space get neg def
    }%
\psPoint(\i\space di mul,0,0){O}
\psRotIIIDPoint[base=\base,
    ]{ANGLE}(\i\space di mul,0,Ln neg){P}
\psline(O)(P)%\psdot(P)
\psRotIIID[object=sphere,r=0.9,ngrid=9 18,linewidth=0.01,
    name=A,
    fillcolor=macouleur,
    base=\base,
    ]{ANGLE}(\i\space di mul,0,Ln neg)
\pstVerb{/Hh Hh dH add def}%
\psSolid[object=plan,
   definition=equation,
   args={[0 0 1 15] 0},
   action=none,
   name=monplan]
   \psProjection[object=cercle,
    plan=monplan,
    args=\i\space di mul Ln ANGLE neg sin mul .9,linecolor=darkgray,fillcolor=darkgray,linewidth=0.01,fillstyle=solid,opacity=0.6,
    range=0 360]\composeSolid}%
\psLineIIID(-1,5,0)(-1,-5,0)(19,-5,0)
\psLineIIID(-1,-5,0)(-1,-5,-15)
\psLineIIID[linecolor=black,linewidth=0.1](-1,0,0)(19,0,0)%
    }%
\end{animateinline}
\end{center}

\end{document}

Rappel : quelques explications du phénomène et une référence avaient déjà été données dans un précédent article, elles sont dans le document "pspendulumwave-version-couleur.pdf" dans le répertoire :

 Pendulum-Waves