From 714d34bcd751b70118d43b9592878923b509fa02 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sat, 23 Aug 2014 22:46:16 +0000 Subject: pst-spirograph (23aug14) git-svn-id: svn://tug.org/texlive/trunk@35026 c570f23f-e606-0410-a88d-b1316a301751 --- .../dvips/pst-spirograph/pst-spirograph.pro | 310 +++++++++++++++------ 1 file changed, 221 insertions(+), 89 deletions(-) (limited to 'Master/texmf-dist/dvips/pst-spirograph') diff --git a/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro b/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro index bdf690be00e..e1295ed6c3b 100644 --- a/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro +++ b/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro @@ -1,10 +1,10 @@ -%% $Id: pst-spirograph.pro 75 2014-08-19 18:38:05Z herbert $ +%% $Id: pst-spirograph.pro 80 2014-08-23 05:50:14Z herbert $ %% % PostScript prologue for pst-spirograph.tex. % -% Version 0.40, 2014/08/18 +% Version 0.41, 2014/08/23 % -/tx@spirographDict 10 dict def +/tx@spirographDict 50 dict def tx@spirographDict begin /coorPen { 1 dict begin @@ -23,23 +23,23 @@ tx@spirographDict begin /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 + /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 + /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 + % Les valeurs suivantes ont en degrés /ThetaTdeg {Rt Rb div dup mul 1 sub sqrt RadtoDeg } bind def % /ThetaPdeg {R@ Rb div dup mul 1 sub sqrt RadtoDeg } bind def /DeltaP {ThetaPdeg sin ThetaP ThetaPdeg cos mul sub @@ -47,25 +47,25 @@ tx@spirographDict begin /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 - /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 12 div cm} 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 + /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 12 div 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) @@ -93,6 +93,23 @@ tx@spirographDict begin } def % developpante du cercle de base % +/Circles { + gsave + setlinedash + newpath + 0 0 R@ cm 0 360 arc + closepath + circlescolor + stroke + % on ne dessine pas le cercle de base + %newpath + %0 0 Rb cm 0 360 arc + %closepath + %stroke + grestore +} def +% +% trace des cercles /devCercle { 1 dict begin /t exch def % en degres @@ -100,78 +117,193 @@ tx@spirographDict begin Rb t sin t DegtoRad t cos mul sub mul cm % y end } def -% trace des cercles +%% %%%% 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 [ + % arc de développante + /tabArcDev [ 0 1 ThetaTdeg { /i@ exch def [i@ devCercle] } for ] def + /n@ tabArcDev length def % l'arc de developpante initial - tabArcDev aload pop + /tabDent [ 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 + 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 + n@ 1 sub -1 0 { /compteur exch def [tabArcDev compteur get aload pop symAxe] } for ] def % trace de la dent -/n2@ tabDent length def -newpath -ptC moveto -0 1 Z@ 1 sub {/i@ exch AngleDent mul def -ifinner -{ - wheel 2 eq { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } - { ptA RotDent lineto ptB RotDent lineto } ifelse -} -{ - Rp Rb eq { ptA RotDent lineto ptB RotDent lineto } - { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } ifelse -} ifelse - 0 1 n2@ 1 sub { - /compteur exch def - tabDent compteur get aload pop - RotDent lineto } for -ifinner - {wheel 2 eq { - Rp Rb eq { - ptA' RotDent lineto ptC' RotDent lineto + /n2@ tabDent length def + newpath + ptC moveto + 0 1 Z@ 1 sub { + /i@ exch AngleDent mul def + ifinner { + wheel 2 eq { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } + { ptA RotDent lineto ptB RotDent lineto } ifelse }{ - ptA' RotDent ptC' RotDent Rarct arct - ptC' RotDent lineto } ifelse - } { - ptA' RotDent lineto ptC' RotDent lineto } ifelse -}{ - Rp Rb eq { - ptA' RotDent lineto ptC' RotDent lineto + Rp Rb eq { ptA RotDent lineto ptB RotDent lineto } + { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } ifelse + } ifelse + 0 1 n2@ 1 sub { + /compteur exch def + tabDent compteur get aload pop + RotDent lineto + } for + ifinner { + 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 }{ - ptA' RotDent ptC' RotDent Rarct arct - ptC' RotDent lineto } - ifelse -} ifelse -} for + Rp Rb eq + { ptA' RotDent lineto ptC' RotDent lineto } + { ptA' RotDent ptC' RotDent Rarct arct ptC' RotDent lineto } ifelse + } ifelse + } for } def +% % pour l'engrenage interieur -/COURONNE { 0 0 Rt 1.1 mul cm 360 0 arcn } def +/COURONNE { 0 0 Rt 1.1 mul cm 360 0 arcn } def +% +/trous { + 1 dict begin + /a@ { R@ cm 3 div Pi div } bind def + gsave + positionAngular rotate + 0 60 540 { + /THETA exch def + untrou + 1 setgray iffill { Fill } if + untrou + linecolor + stroke + } for + grestore + end +} def % /untrou { - newpath + newpath + a@ THETA DegtoRad mul THETA cos mul neg + a@ THETA DegtoRad mul THETA sin mul + 0.05 cm 0 360 arc + closepath +} def +% +%%%%%%%%%% Roue No 1 %%%%%%%%%%%%%%%%% +/Roue1 { + 1 dict begin + /wheel 1 def + gsave + t@@x t@@y translate + m1 Z1 + ifinner { + Datas2 + Calculs + Beta_ rotate + Roue + COURONNE + closepath + iffill { color1 Fill } if + Roue + closepath + linecolor + stroke + COURONNE + closepath + linecolor + stroke + ifcircles { Circles } if + }{ + Datas1 + Calculs + Beta_ rotate + Roue + closepath + iffill { color1 Fill } if + Roue + closepath + linecolor + stroke + ifcircles { Circles } if + } ifelse + grestore + % dessin de l'hypocycloide ou de l'epicycloide + gsave + t@@x t@@y translate + ifinner { + tabSpirograph 0 get aload pop moveto + 1 1 nPts { + /nP exch def + tabSpirograph nP get aload pop lineto + } for + }{ + tabSpirograph2 0 get aload pop moveto + 1 1 nPts2 { + /nP exch def + tabSpirograph2 nP get aload pop lineto + } for + } ifelse + curvecolor + SetCurveWidth + stroke + grestore + end +} def +%%%%%%%%%% Roue No 2 %%%%%%%%%%%%%%%%% +/Roue2 { + 5 dict begin + /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 + /a@ {R@ cm 3 div 3.14159 div} bind def + ifinner{ + a@in polarAngle cos mul t@@x add a@in polarAngle sin mul t@@y add translate + Beta_ polarAngle Z1 Z2 sub Z2 div mul sub rotate + /positionAngular 2Beta 2 div def + }{ + 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 polarAngle Z1 Z2 add Z2 div mul add rotate + /positionAngular Beta_ neg def + } ifelse + Roue + closepath + iffill { color2 Fill } if + Roue + closepath + linecolor + stroke + trous + ifcircles { Circles } if + grestore + gsave + newpath + ifinner { + a@in polarAngle cos mul t@@x add a@in polarAngle sin mul t@@y add translate + Beta_ polarAngle Z1 Z2 sub Z2 div mul sub rotate + /THETA 540 ni 60 mul sub def + positionAngular rotate a@ THETA DegtoRad mul THETA cos mul neg a@ THETA DegtoRad mul THETA sin mul - 0.05 cm 0 360 arc - closepath + 0.06 cm 0 360 arc + }{ + 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 polarAngle Z1 Z2 add Z2 div mul add rotate + /a@ {R@ cm 3 div 3.14159 div} bind def + /THETA 540 ni 60 mul sub def + positionAngular rotate + a@ THETA DegtoRad mul THETA cos mul neg + a@ THETA DegtoRad mul THETA sin mul + 0.06 cm 0 360 arc + } ifelse + closepath + curvecolor + fill + grestore + end } def -% end %% \ No newline at end of file -- cgit v1.2.3