(************************************************************************)
(*   A set of pictures for Marjatta. JuHa, March 2, 1993.               *)
(*   Version 1.1.                                                       *)

(************************************************************************)

<<Tessellate.m

(************************************************************************)

(* Store the definition of DisplayFunction *)
RealBackupDisplayFunction = $DisplayFunction;
BackupDisplayFunction = Identity; 
(* BackupDisplayFunction = RealBackupDisplayFunction; *)

(* Color pictures or not *)
(* colorpict = True; *)
colorpict = False; 

(* Width of lines *)
(*
thickness1 = AbsoluteThickness[0.5];
thickness2 = AbsoluteThickness[1.1];
thickness3 = AbsoluteThickness[1.6];
*)
thickness1 = AbsoluteThickness[0.5];
thickness2 = AbsoluteThickness[1.0];
thickness3 = AbsoluteThickness[1.5];

(************************************************************************)

(* Tessellation of a 12-gon *)

$DisplayFunction = Identity;
(*
grplevel = 7;
tri1 = N[TriFromAngles[Pi/6,Pi/2,Pi/4],16];
tri2 = RotatePoint[N[TriFromAngles[Pi/6,Pi/4,Pi/2],16],Pi/6]; 
trigroup1 = Table[Map[RotatePoint[#,i*Pi/3]&,
		PolygonInvGroup[tri1,grplevel]],{i,0,5}];
trigroup2 = Table[Map[RotatePoint[#,i*Pi/3]&,
		PolygonInvGroup[tri1,grplevel]],{i,0,5}];
graf1 = DrawHypPolygons[Join[trigroup1,trigroup2], 
		Prolog -> {thickness1}, Colored -> colorpict];
*)
poly = RegularPolygon[6,Pi/2];
group = PolygonInvGroup[poly,2];
graf1 = DrawHypPolygons[group, Prolog -> {thickness1},
	Colored -> colorpict, Diagonals -> True, Bisectors -> True];

tt1 = HypInvertPolygon[N[TriFromAngles[Pi/6,Pi/2,Pi/4],16],2];
tt2 = HypInvertPolygon[tt1,3];
tt3 = HypInvertPolygon[tt2,2];
pts = {Last[tt3],First[tt2]};
poly = Flatten[Table[RotatePoint[pts,i*Pi/3],{i,0,5}]];
graf2 = DrawHypPolygons[poly, Prolog -> {thickness2},
	Colored -> colorpict];
 
$DisplayFunction = BackupDisplayFunction;

pict1 = Show[graf1, graf2];
(* Display["!psfix > pict1.ps",pict1]; *)

(************************************************************************)

(* 1st tessellation of a 8-gon *)

$DisplayFunction = Identity; 

poly = N[RegularPolygon[8,Pi/4,Pi/8],16];
graf1 = DrawHypPolygons[poly, Prolog -> {thickness2}, 
	Colored -> colorpict];

pt1 = HypMiddleOfArc[Take[poly,2]];
tri = {0,pt1,RotatePoint[pt1,Pi/4]};
trigroup = N[Table[RotatePoint[tri,i*Pi/4],{i,0,7}]];
graf2 = DrawHypPolygons[trigroup, Prolog -> {thickness1},
	Colored -> colorpict];

pt2 = RotatePoint[pt1,-Pi/4];
pt3 = HypCenterOfPolygon[RotateRight[trigroup[[2]]]];
pt4 = HypInvert[Last[N[TriFromAngles[Pi/8,Pi/3,Pi/2],16]],{pt1,pt2}];
poly8 = {pt2, pt4, pt1, pt3, RotatePoint[pt2,Pi], RotatePoint[pt4,Pi],
	RotatePoint[pt1,Pi], RotatePoint[pt3,Pi]};
graf3 = DrawHypPolygons[poly8, Prolog -> {thickness3},
	Colored -> colorpict];

$DisplayFunction = BackupDisplayFunction;

pict2 = Show[graf3, graf2, graf1];
(* Display["!psfix > pict2.ps",pict2]; *)

(************************************************************************)

(* 2nd tessellation of a 8-gon *)

$DisplayFunction = Identity;

(*
grplevel = 8;
tri1 = N[TriFromAngles[Pi/8,Pi/3,Pi/2],16];
tri2 = RotatePoint[N[TriFromAngles[Pi/8,Pi/2,Pi/3],16],Pi/8]; 
trigroup1 = Table[Map[RotatePoint[#,i*Pi/4]&,
                PolygonInvGroup[tri1,grplevel]],{i,0,7}];
trigroup2 = Table[Map[RotatePoint[#,i*Pi/4]&,
                PolygonInvGroup[tri1,grplevel]],{i,0,7}];
graf1 = DrawHypPolygons[Join[trigroup1,trigroup2],
                Prolog -> {thickness1}, Colored -> colorpict];
*)
poly1 = RegularPolygon[8,2*Pi/3,Pi/8];
group = PolygonInvGroup[poly1,2];
graf1 = DrawHypPolygons[group, Prolog -> {thickness1},
	Diagonals -> True, Bisectors -> True, Colored -> colorpict];

poly2 = RegularPolygon[8,Pi/4,Pi/8];
graf2 = DrawHypPolygons[poly2, Prolog -> {thickness2},
	Colored -> colorpict];
 
$DisplayFunction = BackupDisplayFunction;

pict3 = Show[graf1, graf2];
(* Display["!psfix > pict3.ps",pict3]; *)

(************************************************************************)

(* 3rd tessellation of a 8-gon *)

$DisplayFunction = Identity;

poly1 = RegularPolygon[8,Pi/4,Pi/8];
graf1 = DrawHypPolygons[poly1, Prolog -> {thickness2},
	Colored -> colorpict];

poly2 = RegularPolygon[8,Pi/2,0];
graf2 = DrawHypPolygons[poly2, Prolog -> {thickness1},
	Diagonals -> True, Colored -> colorpict];
 
$DisplayFunction = BackupDisplayFunction;

pict4 = Show[graf2, graf1];
(* Display["!psfix > pict4.ps",pict4]; *)

(************************************************************************)

(* Tessellation of a triangle *)

$DisplayFunction = Identity;

tri = RegularPolygon[3,Pi/4,Pi/3];
graf1 = DrawHypPolygons[tri, Prolog -> {thickness2},
	Diagonals -> False, Colored -> colorpict];
group = PolygonInvGroup[tri,6];
graf2 = DrawHypPolygons[group, Prolog -> {thickness1},
	Diagonals -> False, Colored -> colorpict];
 
$DisplayFunction = BackupDisplayFunction;

pict5 = Show[graf1, graf2];
(* Display["!psfix > pict5.ps",pict5]; *)

(************************************************************************)

(* 1st tessellation of a 10-gon *)

$DisplayFunction = Identity;

poly1 = RegularPolygon[10,2*Pi/5,0];
graf1 = DrawHypPolygons[poly1, Prolog -> {thickness2},
	Diagonals -> True, Colored -> colorpict];

poly2 = RegularPolygon[5,Pi/5,Pi/5];
group = PolygonInvGroup[poly2,4];
graf2 = DrawHypPolygons[group, Prolog -> {thickness1},
	Diagonals -> False, Bisectors -> True, Colored -> colorpict];
 
$DisplayFunction = BackupDisplayFunction;

pict6 = Show[graf2, graf1];
(* Display["!psfix > pict6.ps",pict6]; *)

(************************************************************************)

(* 2nd tessellation of a 10-gon *)

$DisplayFunction = Identity;

poly1 = RegularPolygon[10,2*Pi/5,0];
graf1 = DrawHypPolygons[poly1, Prolog -> {thickness2},
	Diagonals -> False, Colored -> colorpict];

$DisplayFunction = BackupDisplayFunction;

pict7 = Show[graf1];
(* Display["!psfix > pict7.ps",pict7]; *)

(************************************************************************)

(* Tessellation of a 6-gon *)

$DisplayFunction = Identity;

poly = N[RegularPolygon[4,2*Pi/6,Pi/4],16];
tri  =  N[TriFromAngles[Pi/4,Pi/6,Pi/2],16];
pt = HypInvert[0, tri[[{2,3}]]];
poly2 = HypInvertPolygon[poly,4];
pt2 = HypInvert[pt,poly2[[{2,3}]]];
poly3 = HypInvertPolygon[poly2,2];
pt3 = HypInvert[pt2,poly3[[{4,1}]]];
pt4 = Im[pt2] + I*Re[pt2];

vert = {pt2, pt3, pt4};
gon12 = Flatten[Map[RotatePoint[vert,#]&,{0,Pi/2,Pi,3*Pi/2}]];
graf1 = DrawHypPolygons[gon12, Prolog -> {thickness2},
	Diagonals -> False, Colored -> colorpict];

gon6 = Join[{0,pt},vert,{RotatePoint[pt,Pi/2]}];
graf2 = DrawHypPolygons[Map[RotatePoint[gon6,#]&,{0,Pi/2,Pi,3*Pi/2}],
	Prolog -> {thickness1}, Diagonals -> False, 
	Colored -> colorpict];

$DisplayFunction = BackupDisplayFunction;

pict8 = Show[graf2,graf1];
(* Display["!psfix > pict8.ps",pict8]; *)

(************************************************************************)

$DisplayFunction = RealBackupDisplayFunction;

picture = Show[GraphicsArray[{{pict7, pict8}, {pict4, pict6}, {pict2, pict5}, 
	{pict1, pict3}}]]
Display["!psfix > pictc.ps", picture] 

(************************************************************************)


