%% $Id: pst-hypertiling.pro 1268 2026-05-31 08:30:15Z herbert $
% PostScript prologue for pst-hypertiling.tex.
% Version 0.01, 2026/05/30 
%
%/hyptilDict 50 dict def 				
%hyptilDict begin
%%--- macros de pst-solides3d.pro ---
/isarray {
   type (arraytype) cvn eq
} def
%%%%% ### append ###
%% syntaxe : string1 string2 append --> concatene les 2 chaines ou fusionne 2 tableaux
/append {
3 dict begin
   dup isarray {
      /tab2 exch def
      /tab1 exch def
      [ tab1 aload pop tab2 aload pop ]
   } {
      /str2 exch def
      /str1 exch def
      /result str1 length str2 length add string def
      str1 result copy pop
      result str1 length str2 putinterval
      result
   } ifelse
end
} def
%%------------------------------
/tan {dup sin exch cos div} def
/SymZ {
    12 dict begin
    /y exch def
    /x exch def
    /d exch def
    /c exch def
    /a c dup mul d dup mul add 1 add def % module de 1+|a|^2
%%--- coefficients de la fonction homographique ---
%%--- denominateur commun ----
    /D 2 c x mul d y mul add mul a sub dup mul
       2 c y mul d x mul sub mul dup mul
       add
       def
       a x mul 2 c mul sub
        c x mul d y mul add 2 mul a sub
        mul
        a y mul 2 d mul sub
        2 c y mul d x mul sub mul
        mul
        add
        D div
       a y mul 2 d mul sub
        c x mul d y mul add 2 mul a sub
        mul
        a x mul 2 c mul sub
        2 c y mul d x mul sub mul
        mul
        sub
       D div
    end
    } def
%
/RotHyp {
    12 dict begin
    /y exch def
    /x exch def
    /d exch def
    /c exch def
    /theta exch def
    /S theta 2 div sin def % sin(theta/2)
    /C theta 2 div cos def % cos(theta/2)
    /a {c dup mul d dup mul add} bind def % module de a^2
%%--- denominateur commun ----
    /D 2 d mul S mul x mul 2 c mul S mul y mul sub C add a C mul sub dup mul
       2 c mul S mul x mul 2 d mul S mul y mul add S sub a S mul sub dup mul add def
      C a C mul sub x mul S a S mul add y mul sub 2 d mul S mul add
        2 d mul S mul x mul 2 c mul S mul y mul sub C add a C mul sub
        mul
        S a S mul add x mul C a C mul sub y mul add 2 c mul S mul sub
        2 c mul S mul x mul 2 d mul S mul y mul add S sub a S mul sub
        mul
        add
       D div
%%--- coefficients de la fonction homographique ---
       S a S mul add x mul C a C mul sub y mul add 2 c mul S mul sub
        2 d mul S mul x mul 2 c mul S mul y mul sub C add a C mul sub
        mul
        C a C mul sub x mul S a S mul add y mul sub 2 d mul S mul add
        2 c mul S mul x mul 2 d mul S mul y mul add S sub a S mul sub
        mul
        sub
        D div
    end
    } def
%
%% x y xC yC r -> x' y'
/ReflectAB {
    6 dict begin
        /r exch def
        /yC exch def
        /xC exch def
        /y exch def
        /x exch def
        /Coeff r dup mul x xC sub dup mul y yC sub dup mul add div def
        xC Coeff x xC sub mul add
        yC Coeff y yC sub mul add
    end
    } def
%% xA yA xB yB -> xC yC r
/HlineAB {
     7 dict begin
     /yB exch def
     /xB exch def
     /yA exch def
     /xA exch def
% permet de conserver les points sur le disque en cas d'erreur
    xA dup mul yA dup mul add sqrt 1 gt {/xA xA xA dup mul yA dup mul add sqrt div def
                                         /yA yA xA dup mul yA dup mul add sqrt div def} if
    xB dup mul yB dup mul add sqrt 1 gt {/xB xB xB dup mul yB dup mul add sqrt div def
                                         /yB yB xB dup mul yB dup mul add sqrt div def} if
%% -----------------------------------------------------------
    /den xA yB mul yA xB mul sub def % denominateur
    /s1 1 xA dup mul add yA dup mul add 2 div def
    /s2 1 xB dup mul add yB dup mul add 2 div def
     s1 yB mul s2 yA mul sub den div  % xC
     xA s2 mul xB s1 mul sub den div  % yC
     xC dup mul yC dup mul add 1 sub sqrt  % r
     end
    } def
% end
%%%%%%%
%% symetrie / au milieu
/trSyMiddle {2 dict begin
	/y exch def
	/x exch def
    /i exch def
    r0 i cos mul r0 i sin mul x y SymZ
    end
} def
/SymMiddle {
    k_
    P i1 get
    P i1 1 add get
      trSyMiddle
      } def
%%
/Reflect {
    P i1 get
    P i1 1 add get
    r1 k_ cos mul 180 alpha add k_ add cos r_ mul add % xA
    r1 k_ sin mul 180 alpha add k_ add sin r_ mul add % yA
    r1 k_ anglePolygone add cos mul 180 alpha add k_ add anglePolygone add cos r_ mul add % xB
    r1 k_ anglePolygone add sin mul 180 alpha add k_ add anglePolygone add sin r_ mul add % yB
    HlineAB 
    ReflectAB
} def
%
/PolygonBase {
 0 1 n_ 1 sub {/i exch anglePolygone mul def
   /xC r1 i cos mul def
   /yC r1 i sin mul def
   /alpha1 180 alpha add i add def
   /alpha2 180 alpha sub i add def
   /dA alpha2 alpha1 sub dl div def % dl points sur l'arc
    alpha1 dA alpha2 {/iB exch def
      xC iB cos r_ mul add
      yC iB sin r_ mul add
      } for
   } for
 } def
 %
/POLYGON {[PolygonBase]} def
/Milieux {[ % coordonnées des milieux du polygone de base
 0 1 n_ {/k_ exch anglePolygone mul def
    r0 k_ cos mul
    r0 k_ sin mul
    } for
   ]} def
% ni n_ POLYGON DRAWPOLYGONES -> calculs et dessins
/DRAWPOLYGONES {
7 dict begin
/POLYGON exch def
/n_ exch def
/n exch def
/anglePolygone 360 n_ div def
/n1 POLYGON length 2 div cvi def
/POLYGONES [POLYGON] def
n {
 [
 0 1 n_ 1 sub {/k_ exch anglePolygone mul def
0 1 POLYGONES length 1 sub {/iP exch def
	/P POLYGONES  iP get def
	/n1 P length 2 div cvi def
 [ % transformation
/i1 0 def
n1 {Type
  /i1 i1 2 add def
  }repeat
  ]
    } for
   }for	
]
/POLYGONES exch def
} repeat
/polygones POLYGONES def
0 1 polygones length 1 sub {/iP exch def % chaque polygone
	/P polygones iP get def
	/n1 P length def
newpath
 P 0 get cm
 P 1 get cm
  moveto
0 2 n1 2 sub {
    /compteur exch def
    P compteur get cm
    P compteur 1 add get cm
    lineto } for
closepath
    stroke
    } for
end
} def
%%%%%%%%%
%% les motifs
%% -- 2 motifs ---
/MotifTriangleA{[
   0 1 n_ 1 sub {/k_ exch anglePolygone mul def
[
    0 dl_ 1 {/i exch def % de O -> M milieu : dl points
     r0 k_ cos mul i mul % xM
     r0 k_ sin mul i mul % yM
     } for
%% sur l'arc
   /xC r1 k_ cos mul def
   /yC r1 k_ sin mul def
   /alpha0 180 k_ add def
   /alpha2 180 alpha sub k_ add def
   /dA alpha2 alpha0 sub dl div def % dl points sur l'arc
    alpha0  dA alpha2 {/iB exch def
      xC iB cos r_ mul add
      yC iB sin r_ mul add
      } for
% retour du sommet sur O
  1 dl_ neg 0 {/i_ exch def   % dl points
      xC alpha2 cos r_ mul add i_ mul
      yC alpha2 sin r_ mul add i_ mul
      } for
  ]
      } for
      ]
       }def
%
/MotifTriangleB  {[
   0 1 n_ 1 sub {/k_ exch anglePolygone mul def
[
    0 dl_ 1 {/i_ exch def % de O -> M milieu : dl points
     r0 k_ cos mul i_ mul % xM
     r0 k_ sin mul i_ mul % yM
     } for
%% sur l'arc
   /xC r1 k_ cos mul def
   /yC r1 k_ sin mul def
   /alpha0 180 k_ add def
   /alpha2 180 alpha add k_ add def
   /dA alpha2 alpha0 sub dl div def % dl points sur l'arc
    alpha0  dA alpha2 {/iB exch def
      xC iB cos r_ mul add
      yC iB sin r_ mul add
      } for
% retour du sommet sur O
  1 dl_ neg 0 {/i exch def   % dl points
      xC alpha2 cos r_ mul add i mul
      yC alpha2 sin r_ mul add i mul
      } for
  ]
      } for
      ]}
       def
%ni colorMotif MotifTriangle DrawMotifs -> calculs et dessins
/DrawMotifs {
/MotifTriangle exch def
/colorMotif exch def
/n exch def
colorMotif
n  {
 [
 0 1 n_ 1 sub {/k_ exch anglePolygone mul def
0 1 MotifTriangle length 1 sub {/iP exch def
	/P MotifTriangle  iP get def
	/n1 P length 2 div cvi def
 [ % transformation
/i1 0 def
n1 {Type
  /i1 i1 2 add def
  }repeat
  ]
    } for
   }for	
]
/MOTIFTRIANGLE exch def
/MotifTriangle MotifTriangle MOTIFTRIANGLE append def
} repeat
/MOTIFTRIANGLES MotifTriangle def
%
0 1 MOTIFTRIANGLES length 1 sub {/iP exch def % chaque "triangle"
	/P MOTIFTRIANGLES iP get def
	/n1 P length def
newpath
 P 0 get cm
 P 1 get cm
  moveto
0 2 n1 2 sub {
    /i exch def
    P i get cm
    P i 1 add get cm
    lineto } for
closepath
    fill
    } for
    } def
%%
%%%-----le polygone de base----%%%
% POLYGON
%
/DrawPolygonBase {
/P exch def
newpath
    P 0 get cm
    P 1 get cm
     moveto
0 2 P length 2 sub {/i exch def
    P i get cm
    P i 1 add get cm
    lineto
} for
closepath
 polygonbasewidth
 polygonbasecolor
  stroke
} def
%end
