%% $Id: pst-fourbarlinkage.pro 1195 2025-12-19 07:58:03Z herbert $ %% %% This is file `pst-fourbarlinkage.pro', %% %% Jürgen Gilg & Manuel Luque & Herbert Voß %% %% This program can be redistributed and/or modified under the terms %% of the LaTeX Project Public License Distributed from CTAN archives %% in directory macros/latex/base/lppl.txt. %% %% version 0.01 / 2025-12-19 % /FourBarLinkage 100 dict def FourBarLinkage begin %% les macros suivantes sont de Dominique Rodriguez %% elles sont extraites de pst-eucl.pro %% https://www.ctan.org/pkg/pst-eucl %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% x1 y1 x2 y2 -> a b c (ax-by+c=0 with a^2+b^2=1) /EqDr { 4 copy 3 -1 roll sub 7 1 roll exch sub 5 1 roll 4 -1 roll mul 3 1 roll mul exch sub 2 index dup mul 2 index dup mul add sqrt 4 -1 roll 1 index div exch 4 -1 roll 1 index div exch 4 -1 roll 1 index div exch pop } bind def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% x1 y1 x2 y2 x3 y3 x4 y4 -> x y /InterLines { EqDr /D1c exch def /D1b exch def /D1a exch def EqDr /D2c exch def /D2b exch def /D2a exch def D1a D2b mul D1b D2a mul sub dup ZeroEq % { pop pop pop 0 0 } %% parallel lines % --- hv 20110714 { pop 0 0 } %% parallel lines --- hv 20110714 { /Det exch def D1b D2c mul D1c D2b mul sub Det div D1a D2c mul D2a D1c mul sub Det div } ifelse } bind def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% x -> true (if |x| < 1E-6) /ZeroEq { abs 1E-6 lt } bind def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /arctan { /dx exch def /dy exch def dx 0 eq {dy 0 gt {90}{dy 0 ne {270}{0}ifelse} ifelse}{dy dx atan }ifelse } def %% 3 macros de pstricks.pro /arccos { dup dup mul neg 1 add abs sqrt % rajout de abs pour quelques limites exch atan } def /arcsin { dup 1 eq { 90 } { dup dup mul neg 1 add sqrt atan dup 90 lt {} {360 sub} ifelse } ifelse } def /tan { dup cos abs 1.e-10 lt { pop 1.e10 } % return 1.e10 as infinit { dup sin exch cos div } ifelse % default sin/cos } def %% la macro suivante est personnelle % Centre instantané de rotation repère fixe % xO yO xA yA xC yC xB yB InterLines /yCIR exch def /xCIR exch def % repère mobile % angle x1 y1 MovingReference => x' y' /MovRef { 3 dict begin /y exch def /x exch def /A exch def x xI sub A cos mul y yI sub A sin mul add x xI sub A sin mul neg y yI sub A cos mul add end } def %%%%% pst-solides3d.pro %%%%% /append { 2 dict begin /tab2 exch def /tab1 exch def [ tab1 aload pop tab2 aload pop ] end } def %% syntaxe : string1 string2 append --> concatene les 2 chaines /appendtring { 3 dict begin /str2 exch def /str1 exch def /result str1 length str2 length add string def str1 result copy pop result str1 length str2 putinterval result end } def %%%%% ### min ### /S { Fourbar 0 get 1 1 Fourbar length 1 sub { /i exch def Fourbar i get min } for } def %%%%% ### max ### /max { 2 copy lt {exch} if pop } def /L { % max Fourbar 0 get 1 1 Fourbar length 1 sub { /i exch def Fourbar i get max } for } def /T { % sum Fourbar 0 get 1 1 Fourbar length 1 sub { /i exch def Fourbar i get add } for } def /PQ { T S sub L sub} def % % length of P plus length of Q % /FourBar-Solve { 9 dict begin % /t exch def % l'angle de la barre avec Ox % suivant les cas : thetta2, theta3 ou theta4 % on en déduit les deux autres angles /s exch def /r exch def /p exch def /q exch def /D r dup mul s dup mul add p dup mul q dup mul add sub 2 p mul q mul div def crossed { /delta D arccos neg def }{ /delta D arccos def } ifelse /A p q D mul add def /B q delta sin mul def A s mul B r mul sub A r mul B s mul add atan % theta0 dup delta add % theta1 end } def % /Fourbar-classify { S L add PQ lt { % Grashof linkages d S eq {/class 1 def /t3 N def} if a S eq {/class 2 def /t2 N def} if b S eq {/class 3 def /t3 N def} if % seul b fait un tour complet c S eq {/class 4 def /t4 N def} if % seul c fait un tour complet } if S L add PQ gt { % non-Grashof linkages a c lt d L eq and {/class 5 def} if a c ge d L eq and {/class 6 def} if a L eq {/class 7 def} if a c lt b L eq and {/class 8 def} if a c gt b L eq and {/class 9 def} if c L eq {/class 10 def} if } if % special case linkages S L add PQ eq nS length 1 eq and nL length 1 eq and { d S eq {/class 11 def} if a S eq {/class 12 def} if b S eq {/class 13 def} if c S eq {/class 14 def} if } if S L add PQ eq nS length 2 eq and { a S eq d S eq and {/class 15 def} if a S eq b S eq and {/class 16 def} if b S eq c S eq and {/class 17 def} if c S eq d S eq and {/class 18 def} if b S eq d S eq and a S eq c S eq and or {/class 19 def} if } if nS length 4 eq nL length 4 eq or {/class 19 def} if } def /crank { 2 dict begin /r 1 MM def gsave xA yA translate t2 rotate /barA { newpath 0 0 r 45 315 arc a MM r 2 div 2 sqrt mul sub r 2 div 2 sqrt mul neg lineto a MM 0 r -135 135 arc closepath } def 0.5 1 0.5 setrgbcolor barA fill 0 setgray barA stroke grestore end } def /rocker { 2 dict begin /r 1 MM def gsave xD yD translate t4 rotate /barC { newpath 0 0 r 45 315 arc c MM r 2 div 2 sqrt mul sub r 2 div 2 sqrt mul neg lineto c MM 0 r -135 135 arc closepath } def 1 0 0 setrgbcolor barC fill 0 setgray barC stroke grestore end } def % /barB { newpath 0 0 r 45 315 arc b MM r 2 div 2 sqrt mul sub r 2 div 2 sqrt mul neg lineto b MM 0 r -135 135 arc closepath } def % /coupler { 1 dict begin /r 1 MM def gsave xB yB translate t3 rotate 1 0.5 0 setrgbcolor barB fill 0 setgray barB stroke grestore end } def % /pivot{ newpath 1 MM 20 cos mul 1 MM 20 sin mul moveto 0 0 1 MM 20 160 arc 1 MM 20 cos 20 sin add 1.5 20 dup sin exch cos div mul add mul neg 1.5 MM neg lineto 1 MM 20 cos 20 sin add 1.5 20 dup sin exch cos div mul add mul 1.5 MM neg lineto closepath } def % /FourbarDraw { gsave 0.75 setgray pivot fill 0 setgray pivot stroke gsave xD 0 translate 0.75 setgray pivot fill 0 setgray pivot stroke grestore gsave 1 setlinejoin 2 setlinecap 0.75 MM setlinewidth xB yB moveto xM yM lineto xC yC lineto stroke 0.5 MM setlinewidth xB yB moveto xM yM lineto xC yC lineto 1 0.5 0 setrgbcolor stroke 0.5 setlinewidth 0 setgray xM yM 0.25 MM 0 360 arc stroke grestore crank rocker 0.5 setgray xA yA 0.5 MM 0 360 arc fill xD yD 0.5 MM 0 360 arc fill coupler xB yB 0.5 MM 0 360 arc fill xC yC 0.5 MM 0 360 arc fill 0 0.8 0 setrgbcolor xB yB 0.25 MM 0 360 arc fill 0.9 0 0 setrgbcolor xC yC 0.25 MM 0 360 arc fill grestore } def end