%% This work may be distributed and/or modified under the
%% conditions of the LaTeX Project Public License, either version 1.3
%% of this license or (at your option) any later version.
%% The latest version of this license is in
%%   http://www.latex-project.org/lppl.txt
%% and version 1.3 or later is part of all distributions of LaTeX
%% version 2003/12/01 or later.

\csname PSTGEARSLoaded\endcsname
\let\PSTGEARSLoaded\endinput
% Requires some packages
\ifx\PSTricksLoaded\endinput\else \input pstricks \fi
\ifx\PSTXKeyLoaded\endinput\else  \input pst-xkey \fi
\def\fileversion{0.1}
\def\filedate{2013/07/03}
\message{`PSTGEARS' v\fileversion, \filedate}

\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax

\pst@addfams{pst-gears}
\define@key[psset]{pst-gears}{Z1}{\def\psk@ZA{#1 }}
\psset[pst-gears]{Z1=20}
\define@key[psset]{pst-gears}{Z2}{\def\psk@ZB{#1 }}
\psset[pst-gears]{Z2=10}
\define@key[psset]{pst-gears}{m}{\def\psk@m{#1 }}
\psset[pst-gears]{m=0.5}
\define@key[psset]{pst-gears}{ap}{\def\psk@ap{#1 }}
\psset[pst-gears]{ap=20}
\define@key[psset]{pst-gears}{Rarct}{\def\psk@Rarct{#1 }}
\psset[pst-gears]{Rarct=0.1}
\define@key[psset]{pst-gears}{wheelrotation}{\def\psk@wheelrotation{#1 }}
\psset[pst-gears]{wheelrotation=0}
\define@key[psset]{pst-gears}{polarangle}{\def\psk@polarangle{#1 }}
\psset[pst-gears]{polarangle=0}
\define@key[psset]{pst-gears}{color1}{\pst@getcolor{#1}\pscolora}
\psset[pst-gears]{color1={[rgb]{0.625 0.75 1}}}
\define@key[psset]{pst-gears}{color2}{\pst@getcolor{#1}\pscolorb}
\psset[pst-gears]{color2={[rgb]{0.75 1 0.75}}}
\define@key[psset]{pst-gears}{colorcircles}{\pst@getcolor{#1}\pscolorc}
\psset[pst-gears]{colorcircles=red}
%
%% === Option pour ne pas dessiner le type d'engrenage ---------------------
\newif\ifPst@gears@int
\define@key[psset]{pst-gears}{int}[true]{\@nameuse{Pst@gears@int#1}}
\psset[pst-gears]{int=false}
%
%% === pour dessiner cercle de base et cercle primitif
\newif\ifPst@gears@circles
\define@key[psset]{pst-gears}{circles}[true]{\@nameuse{Pst@gears@circles#1}}
\psset[pst-gears]{circles=false}
%
\newif\ifPst@gears@notDrawWheel
\define@key[psset]{pst-gears}{notdrawWheel1}[true]{\@nameuse{Pst@gears@notDrawWheel#1}}
\psset[pst-gears]{notdrawWheel1=false}
%
\def\pstgears{\def\pst@par{}\pst@object{pstgears}}
\def\pstgears@i{\@ifnextchar({\pstgears@do}{\pstgears@do(0,0)}}
\def\pstgears@do(#1){%
\begin@SpecialObj
\pst@@getcoor{#1}%
\addto@pscode{%
\pst@coor /t@@y ED /t@@x ED
/cm {\pst@number\psunit mul } bind def
/Z1 \psk@ZA def
/m1 \psk@m def
/Z2 \psk@ZB def
/m2 \psk@m def
/ap \psk@ap def
/facteurRayonRaccord {\psk@Rarct mul} def
/polarAngle  \psk@polarangle def
/color1 {\pst@usecolor\pscolora } def
/color2 {\pst@usecolor\pscolorb } def
/colorcircles {\pst@usecolor\pscolorc } def
/linecolor  {\pst@usecolor\pslinecolor} def
/Pi 3.14159265359 def
/rad2deg { 180 mul Pi div } bind def
/deg2rad { 180 div Pi mul } bind def
/Datas1 {
         /Z@ exch def
         /m@ exch def
         /R@ {m@ Z@ mul 2 div } bind def % cercle primitif
         /Rb {R@ ap cos mul } bind def % cercle de base
         /Rp {R@ 2 mul 2.5 m@ mul sub 2 div } bind def % cercle de pied
         /Rt {R@ 2 mul 2 m@ mul add 2 div } bind def % cercle de tête
         } def
/Datas2 {
         /Z@ exch def
         /m@ exch def
         /R@ {m@ Z@ mul 2 div } bind def % cercle primitif
         /Rb {R@ ap cos mul } bind def % cercle de base
         /Rp {R@ 2 mul 2 m@ mul sub 2 div } bind def % cercle de pied
         /Rt {R@ 2 mul 2.5 m@ mul add 2 div } bind def % cercle de tête
         } def
/Calculs {
         % les valeurs suivantes sont en radians
         /ThetaP {R@ Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle primitif
         /ThetaT {Rt Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle de tete
         % Les valeurs suivantes ont en degrés
         /ThetaTdeg {Rt Rb div dup mul 1 sub sqrt rad2deg } bind def %
         /ThetaPdeg {R@ Rb div dup mul 1 sub sqrt rad2deg } bind def
         /DeltaP {ThetaPdeg sin ThetaP ThetaPdeg cos mul sub
                  ThetaPdeg cos ThetaP ThetaPdeg sin mul add
                  atan } bind def
         /DeltaT {ThetaTdeg sin ThetaT ThetaTdeg cos mul sub
                  ThetaTdeg cos ThetaT ThetaTdeg sin mul add
                  atan } bind def
         /DeltaS {Pi 2 div Z@ div } bind def
         /DeltaSdeg {90 Z@ div } bind def
         /AngleDent {360 Z@ div} bind def
         /Alpha {DeltaSdeg DeltaP add DeltaT sub } bind def
         /2Beta {DeltaSdeg DeltaP add 2 mul } bind def
         /Beta_  {DeltaSdeg DeltaP add neg} bind def
          Rp Rb gt {/Rp Rb def} if
         /ptA {Rp cm 0} bind def
         /ptB {Rb cm 0} bind def
         /ptC {Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add cos mul
               Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add sin mul} bind def
         /ptA'{Rp cm DeltaP DeltaSdeg add 2 mul cos mul
               Rp cm DeltaP DeltaSdeg add 2 mul sin mul} bind def
         /ptB'{Rb cm DeltaP DeltaSdeg add 2 mul cos mul
               Rb cm DeltaP DeltaSdeg add 2 mul sin mul} bind def
         /ptC'{Rp cm DeltaSdeg 3 mul DeltaP add cos mul
               Rp cm DeltaSdeg 3 mul DeltaP add sin mul} bind def
         /Raxe {Rp 4 div } bind def
         /A@0 14.5 def % position et largeur de la clavette
% rayon de raccordement sur le cercle de pied
         /Rarct {Rp Pi mul Z@ div facteurRayonRaccord cm} bind def
         }
         def
% Le symetrique P' de P par rapport a la l'axe de la dent
% Delta(axe de la dent) y=x*tan(Beta)
% x'=y*sin(2*Beta)+x*cos(2*Beta)
% y'=x*sin(2*Beta)-y*cos(2*Beta)
% x y symAxe -> x' y'
/symAxe {
 2 dict begin
  /y exch def
  /x exch def
  y 2Beta sin mul x 2Beta cos mul add % x'
  x 2Beta sin mul y 2Beta cos mul sub % y'
 end
 }
 def
 %
% Rotation pour amener l'axe de la dent horizontal
%
/RotDent {
 2 dict begin
/y exch def
/x exch def
 i@ cos x mul i@ sin y mul sub
 i@ sin x mul i@ cos y mul add
end
} def
%
% developpante du cercle de base
%
 /devCercle {
  1 dict begin
  /t exch def % en degres
  Rb t cos t deg2rad t sin mul add mul cm % x
  Rb t sin t deg2rad t cos mul sub mul cm % y
 end
 }
 def
% trace des cercles
/Circles {
gsave
[ \psk@dash\space ] 0 setdash
newpath
0 0 R@ cm 0 360 arc
closepath
colorcircles
stroke
newpath
0 0 Rb cm 0 360 arc
closepath
stroke
grestore
} def
%%%% definition de la roue dentee %%%%%%
/Roue {
% arc de développante
/tabArcDev [
0 1 ThetaTdeg { /i@ exch def
 [i@ devCercle] } for
 ] def
%
/n@ tabArcDev length def
%
/tabDent [
% l'arc de developpante initial
  tabArcDev aload pop
% l'arc ce cercle de tete
DeltaT 0.1 2Beta DeltaT sub {/i@ exch def
 [Rt cm i@ cos mul
  Rt cm i@ sin mul]
 } for
% le symetrique de l'arc de developpante par rapport a l'axe de la dent
n@ 1 sub -1 0  {
    /compteur exch def
    [tabArcDev compteur get aload pop symAxe]
    } for
    ] def
% tracé de la dent
/n2@ tabDent length def
newpath
ptC moveto
0 1 Z@ 1 sub {/i@ exch AngleDent mul def
\ifPst@gears@int
wheel 2 eq {
ptA RotDent ptB RotDent Rarct arct
ptB RotDent lineto
    }{
ptA RotDent lineto ptB RotDent lineto}
ifelse
\else
Rp Rb eq {
    ptA RotDent lineto ptB RotDent lineto
    }{
    ptA RotDent ptB RotDent Rarct arct
    ptB RotDent lineto }
ifelse
\fi
0 1 n2@ 1 sub {
    /compteur exch def
    tabDent compteur get aload pop
    RotDent lineto } for
\ifPst@gears@int
wheel 2 eq {
Rp Rb eq {
    ptA' RotDent lineto ptC' RotDent lineto
    }{
    ptA' RotDent ptC' RotDent Rarct arct
    ptC' RotDent lineto }
ifelse
    } {
ptA' RotDent lineto ptC' RotDent lineto }
ifelse
\else
Rp Rb eq {
    ptA' RotDent lineto ptC' RotDent lineto
    }{
    ptA' RotDent ptC' RotDent Rarct arct
    ptC' RotDent lineto }
ifelse
\fi
} for
} def
%%%% fin de la definition de la roue dentee %%%
%%% axe de la roue %%%
/AXE {
%newpath
 Raxe 4 div cm
 A@0 cos Raxe mul cm moveto
 0 0 Raxe cm 90 A@0 sub 90 A@0 add arcn
 Raxe 4 div cm neg
 A@0 cos Raxe mul cm
 lineto
 Raxe 4 div cm neg
 Raxe A@0 cos 0.2 add mul cm
 lineto
 Raxe 4 div cm
 Raxe A@0 cos 0.2 add mul cm
 lineto
} def
%%% clavette %%%
/CLAVETTE {
newpath
 Raxe 4 div cm
 A@0 cos 0.2 sub Raxe mul cm moveto
 Raxe 4 div cm
 Raxe A@0 cos 0.2 add mul cm lineto
 Raxe 4 div cm neg
 Raxe A@0 cos 0.2 add mul cm lineto
 Raxe 4 div cm neg
 A@0 cos 0.2 sub Raxe mul cm lineto
closepath
} def
/COURONNE {
% pour l'engrenage interieur
0 0 Rt 1.1 mul cm 360 0 arcn
} def
/AngleRotation \psk@wheelrotation def
%%% Les dessins de l'engrenage %%%%%%
%%%%%%%%%% Roue N°1 %%%%%%%%%%%%%%%%%
\ifPst@gears@notDrawWheel
    \else
/wheel 1 def
gsave
t@@x t@@y translate
m1 Z1
\ifPst@gears@int
    Datas2
    Calculs
    Beta_ AngleRotation sub rotate
    Roue
    COURONNE
    closepath
\ifx\psk@fillstyle\relax\else
    color1
    fill
\fi
Roue
closepath
linecolor
stroke
COURONNE
closepath
linecolor
stroke
\ifPst@gears@circles
    Circles
\fi
\else
    Datas1
    Calculs
    Beta_ AngleRotation sub rotate
    Roue
    AXE
    closepath
\ifx\psk@fillstyle\relax\else
    color1
    fill
\fi
Roue
closepath
linecolor
stroke
AXE
closepath
\ifx\psk@fillstyle\relax\else
    0.8 setgray
    fill
\fi
AXE
closepath
linecolor
stroke
CLAVETTE
\ifx\psk@fillstyle\relax\else
    0 0.125 0.25 0.25 setcmykcolor
    fill
\fi
CLAVETTE
linecolor
stroke
\ifPst@gears@circles
    Circles
\fi
\fi
grestore
\fi
%%%%%%%%%% Roue N°2 %%%%%%%%%%%%%%%%%
/wheel 2 def
gsave
m2 Z2 Datas1
Calculs
/a@ex m2 Z1 Z2 add mul 2 div cm def % entraxe engrenage exterieur
/a@in m2 Z1 Z2 sub mul 2 div cm def % entraxe engrenage interieur
\ifPst@gears@int
    a@in polarAngle cos mul t@@x add a@in polarAngle sin mul t@@y add translate
    Beta_ Z1 Z2 div AngleRotation mul sub polarAngle Z1 Z2 sub Z2 div mul sub rotate
\else
    a@ex polarAngle cos mul t@@x add a@ex polarAngle sin mul t@@y add translate
    DeltaSdeg DeltaP add neg 180 Z2 div add 180 add Z1 Z2 div AngleRotation mul add polarAngle Z1 Z2 add Z2 div mul add rotate
\fi
Roue
AXE
closepath
\ifx\psk@fillstyle\relax\else
    color2
    fill
\fi
Roue
closepath
linecolor
stroke
AXE
closepath
\ifx\psk@fillstyle\relax\else
    0.8 setgray
    fill
\fi
AXE
closepath
linecolor
stroke
CLAVETTE
\ifx\psk@fillstyle\relax\else
    0 0.125 0.25 0.25 setcmykcolor
    fill
\fi
CLAVETTE
linecolor
stroke
\ifPst@gears@circles
    Circles
\fi
grestore
}%
\end@SpecialObj}% % fin de la commande PSTricks
\catcode`\@=\PstAtCode\relax
%
\endinput 