[pstricks] Geometry type macros

[Faton Berisha]

Dear Herbert,

Recently, I had to deal with pictures involving basic geometric plain
constructions. Since I couldn't find any appropriate pstricks based package,
inspired by your macros of the types \psPrallelLine and \psIntersectionPoint
from pstricks-add, I wrote my own ones. The idea is, of course, having
postscript compute the node angles and distances, and intersection nodes,
instead of doing it from TeX. The macros follow up at the end of the
message. I also include a very simple testing example. I am sorry if the
code is too long. (It might have been a better idea to include it as an
attachment.)

Could you, please, tell me if there is already something similar written for
pstricks. If not, do you think it would be worth while having them uploaded
on CTAN; maybe it could _eventually_ develop into a new ps-geometry package.

Best regards,
Dr. Faton Berisha
University of Prishtina, Fac. Math. Sci.
Prishtine, Kosove

\makeatletter

% Modified from pstricks-add.tex
% #4*|#1#2|/|#1#3|*#1#3=#1#5
\def\psRelLineI{\pst at object{psRelLineI}}
\def\psRelLineI at i{\@ifnextchar({\psRelLineI at iii}{\psRelLineI at ii}}
\def\psRelLineI at ii#1{%
  \addto at par{arrows=#1}%
  \psRelLineI at iii%
}
\def\psRelLineI at iii(#1)(#2)(#3)#4#5{{%
  \pst at killglue
  \use at par
  \pst at getcoor{#1}\pst at tempa
  \pst at getcoor{#2}\pst at tempb
  \pst at getcoor{#3}\pst at tempc
  \pnode(!
    \pst at tempa /YA exch \pst at number\psyunit div def
    /XA exch \pst at number\psxunit div def
    \pst at tempb /YB exch \pst at number\psyunit div def
    /XB exch \pst at number\psxunit div def
%
    /AlphaStrich
    \pst at tempc /YC exch \pst at number\psyunit div def
    /XC exch \pst at number\psxunit div def
    /YAB YB YA sub def
    /XAB XB XA sub def
    /YAC YC YA sub def
    /XAC XC XA sub def
    XAB XAC mul YAB YAC mul add
    /lenAB XAB dup mul YAB dup mul add sqrt def
    lenAB
    XAC dup mul YAC dup mul add sqrt
    mul div
    dup
    dup mul neg 1 add sqrt
    exch atan
    def
    /laenge lenAB #4 mul def
    /Alpha YAB XAB atan def
    /beta Alpha AlphaStrich add def
    laenge beta cos mul XA add
    laenge beta sin mul YA add ){#5}%
  \psline(#1)(#5)%
}\ignorespaces}

% Modified from pstricks-add.tex
%
% Build the linear combination
% #3*#1#2+#5*#1#4=#1#5
\def\setLCNodeI(#1)(#2)#3(#4)#5#6{%
  \pst at getcoor{#1}\pst at tempo%
  \pst at getcoor{#2}\pst at tempa%
  \pst at getcoor{#4}\pst at tempb%
  \pnode(!%
    \pst at tempo /YO exch \pst at number\psyunit div def
    /XO exch \pst at number\psxunit div def
    \pst at tempa /YA exch \pst at number\psyunit div def
    /XA exch \pst at number\psxunit div def
    \pst at tempb /YB exch \pst at number\psyunit div def
    /XB exch \pst at number\psxunit div def
    XA XO sub #3\space mul XB XO sub #5\space mul add XO add
    YA XO sub #3\space mul YB XO sub #5\space mul add YO add ){#6}
}

% Modified from pstricks.tex
% Circle with center (#1) through (#2) 
\def\psCircleI{\pst at object{psCircleI}}
\def\psCircleI at i{\@ifnextchar({\psCircleI at iii}{\psCircleI at ii}}
\def\psCircleI at ii#1{%
  \addto at par{arrows=#1}%
  \psCircleI at iii%
}
\def\psCircleI at iii(#1)(#2){{
  \pst at killglue
  \use at par
  \pst at getcoor{#1}\pst at tempa
  \pst at getcoor{#2}\pst at tempb
  \begin at ClosedObj
  \addto at pscode{%
  \pst at tempa
  \pst at tempa
  /YO exch \pst at number\psyunit div def
  /XO exch \pst at number\psxunit div def
  \pst at tempb
  /YB exch \pst at number\psyunit div def
  /XB exch \pst at number\psxunit div def
  /dx XB XO sub def
  /dy YB YO sub def
%  /length
  dy dup mul dx dup mul add sqrt
%  def
  \pst at number\psxunit mul
  0 360 arc
  closepath}%
  \showpointsfalse
  \end at ClosedObj
}\ignorespaces}

% Line from #3 perpendicular to #1#2
% with the end node at the intersection point
\def\psPerpendicularLine{\pst at object{psPerpendicularLine}}
\def\psPerpendicularLine at i{%
  \@ifnextchar({\psPerpendicularLine at iii}{\psPerpendicularLine at ii}%
}
\def\psPerpendicularLine at ii#1{%
  \addto at par{arrows=#1}%
  \psPerpendicularLine at iii%
}
\def\psPerpendicularLine at iii(#1)(#2)(#3)#4{{%
  \pst at killglue
  \use at par
  \psParallelLine[linestyle=none](#1)(#2)(#3){1}{pst at tempa}%
  \psRelLine[linestyle=none,angle=90](#3)(pst at tempa){1}{pst at tempb}%
  \psIntersectionPoint(#3)(pst at tempb)(#1)(#2){#4}%
  \psline(#3)(#4)%
}\ignorespaces}

% Calculates the interesction points #5, #6
% of a line #1#2
% and a circle through #4 with the center #3
\def\psLineCirclePoints(#1)(#2)(#3)(#4)#5#6{%
  \pst at getcoor{#1}\pst at tempa
  \pst at getcoor{#2}\pst at tempb
  \pst at getcoor{#3}\pst at tempc
  \pst at getcoor{#4}\pst at tempd
  \ps at LineCirclePoint(#5){0}{90}%
  \ps at LineCirclePoint(#6){180}{-90}%
}
\def\ps at LineCirclePoint(#1)#2#3{%
  \pnode(!%
      \pst at tempa /YA exch \pst at number\psyunit div def
      /XA exch \pst at number\psxunit div def
      \pst at tempb /YB exch \pst at number\psyunit div def
      /XB exch \pst at number\psxunit div def
      \pst at tempc /YC exch \pst at number\psyunit div def
      /XC exch \pst at number\psxunit div def
      \pst at tempd /YD exch \pst at number\psyunit div def
      /XD exch \pst at number\psxunit div def
      /Radius XD XC sub dup mul YD YC sub dup mul add sqrt def
      /dY1 YB YA sub def
      /dX1 XB XA sub def
      /dY2 YC YA sub def
      /dX2 XC XA sub def
      /Func {
        dup cos Radius mul dY1 mul
        exch sin Radius mul dX1 mul sub
        dX2 dY1 mul
        dY2 dX1 mul sub add
      } def
      /DFunc {
        dup cos Radius mul dX1 mul neg
        exch sin Radius mul dY1 mul neg add
      } def
      #2 DFunc abs #3 DFunc abs ge { #2 } { #3 } ifelse
      30 { dup /T1 exch def
        dup dup Func exch DFunc div
        3.14159 div 180 mul sub
        dup T1 sub abs 1e-5 lt { exit } if
      } repeat
      dup cos Radius mul XC add
      exch sin Radius mul YC add
    ){#1}%
}

% Calculates the interesction points #5, #6
% of a circle through #2 with the center #1
% and a circle through #4 with the center #3
\def\psCircleCirclePoints(#1)(#2)(#3)(#4)#5#6{%
  \pst at getcoor{#1}\pst at tempa
  \pst at getcoor{#2}\pst at tempb
  \pst at getcoor{#3}\pst at tempc
  \pst at getcoor{#4}\pst at tempd
  \ps at CircleCirclePoint(#5){90 neg}%
  \ps at CircleCirclePoint(#6){90}%
}
\def\ps at CircleCirclePoint(#1)#2{%
  \pnode(!%
      \pst at tempa /YA exch \pst at number\psyunit div def
      /XA exch \pst at number\psxunit div def
      \pst at tempb /YB exch \pst at number\psyunit div def
      /XB exch \pst at number\psxunit div def
      \pst at tempc /YC exch \pst at number\psyunit div def
      /XC exch \pst at number\psxunit div def
      \pst at tempd /YD exch \pst at number\psyunit div def
      /XD exch \pst at number\psxunit div def
      /Radius1 XB XA sub dup mul YB YA sub dup mul add sqrt def
      /Radius2 XD XC sub dup mul YD YC sub dup mul add sqrt def
      /Func1 {%  f1(t,u):=r1*cos(t)-r2*cos(u)+xa-xc
        cos Radius2 mul neg
        exch cos Radius1 mul add
        XA XC sub add
      } def
      /Func2 {%  f2(t,u):=r1*sin(t)-r2*sin(u)+ya-yc
        sin Radius2 mul neg
        exch sin Radius1 mul add
        YA YC sub add
      } def
      /DFunc {% df(t,u):=r1*r2*sin(t-u)
        sub sin Radius1 mul Radius2 mul
      } def
      [ YC YA sub XC XA sub atan dup #2 add
        Radius1 Radius2 lt
          { 180 sub exch 180 sub } if ]
      dup /TU exch def
      30 {
        aload
        aload
        aload
        aload
        pop
        /U1 exch def
        /T1 exch def
        Func1 /F1 exch def
        Func2 /F2 exch def
        DFunc /DF exch def
        TU 0
          T1
            F1 U1 cos Radius2 mul mul neg
            F2 U1 sin Radius2 mul mul sub
            DF div
            3.14159 div 180 mul sub
          put
        TU
        aload
        aload
        aload
        aload
        pop
        pop
        /T2 exch def
        Func1 /F1 exch def
        Func2 /F2 exch def
        DFunc /DF exch def
        TU 1
          U1
            F2 T2 sin Radius1 mul mul neg
            F1 T2 cos Radius1 mul mul sub
            DF div
            3.14159 div 180 mul sub
            dup /U2 exch def
          put
        TU
        T2 T1 sub dup mul U2 U1 sub dup mul add sqrt
        1e-5 lt { exit } if
      } repeat
      aload pop pop
      dup cos Radius1 mul XA add
      exch sin Radius1 mul YA add
    ){#1}%
}

\makeatother

\begin{document}

\psset{unit=1cm}
\begin{pspicture}(-3,-3)(5,5)
\scriptsize
\pnode(0,0){O1}
\pnode(0,-3){A}
\pnode(0,2){O2}
\pnode(1.5,1.5){B}

\psdot[dotstyle=*](O1)
\nput{-90}{O1}{$O1$}
\psdot[dotstyle=*](A)
\nput{-90}{A}{$A$}
\psdot[dotstyle=*](O2)
\nput{-90}{O2}{$O2$}
\psdot[dotstyle=*](B)
\nput{-90}{B}{$B$}

\psCircleI(O1)(A)
\psCircleI(O2)(B)

\psCircleCirclePoints(O1)(A)(O2)(B){E}{F}
\psdot[dotstyle=*](E)
\nput{90}{E}{$E$}
\psdot[dotstyle=*](F)
\nput{90}{F}{$F$}

\psline[linestyle=dashed](O2)(A)
\psRelLineI[linestyle=dashed](O2)(A)(B){1}{G}
\psdot[dotstyle=*](G)
\nput{90}{G}{$G$}

\psLineCirclePoints(O2)(B)(O1)(A){H}{P}
\psdot[dotstyle=*](H)
\nput{90}{H}{$H$}

\end{pspicture}

\end{document}