(*
    (c)2008 Alex Kontorovich
*)

(* Parameters *)
sizemax=300;  (* Largest curvature to draw *)
b0={blank,28,24,21}; (* Three curvatures determine the fourth -- careful with this, it's not stable *)
labels=True; (* Whether to label the circle by its curvature *)
fscale=7 504; (* Size of the text inside a circle *)

(* Code *)
scale=1;
Smat={{{-1,2,2,2},{0,1,0,0},{0,0,1,0},{0,0,0,1}},
{{1,0,0,0},{2,-1,2,2},{0,0,1,0},{0,0,0,1}},
{{1,0,0,0},{0,1,0,0},{2,2,-1,2},{0,0,0,1}},
{{1,0,0,0},{0,1,0,0},{0,0,1,0},{2,2,2,-1}}};
CirThru[a1_,b1_,a2_,b2_,a3_,b3_]:=Solve[{
(a1-x0)^2+(b1-y0)^2==(r)^2,(a2-x0)^2+(b2-y0)^2==(r)^2,(a3-x0)^2+(b3-y0)^2==(r)^2},{x0,y0,r}];des[b1_,b2_,b3_]:=Solve[ (b1 +b2  +b3 +b4 )^2== 2(b1^2 +b2^2 +b3^2 +b4^2 ), b4];touch[a1_,b1_,r1_,a2_,b2_,r2_]:=Solve[{(x-a1)^2+(y-b1)^2==(r1)^2,(x-a2)^2+(y-b2)^2==(r2)^2},{x,y}];
circPlot[a_,b_,r_]:= Circle[{a,b},r];
morecircs[from_,level_]:=(*If[level<levelmax,*)
Module[{j},For[j=1,j≤4,j++,If[
from≠j,
b=Smat[[j]].b;
w=Smat[[j]].w;
If[b[[j]]<sizemax,
cNew=circPlot[scale Re[((w[[j]])/(b[[j]]))],scale Im[((w[[j]])/(b[[j]]))],(scale/(Abs[b[[j]]]))];
p=Text[Style[b[[j]],Abs[fscale/b[[j]]]],{scale Re[((w[[j]])/(b[[j]]))],scale Im[((w[[j]])/(b[[j]]))]}];
AppendTo[pic,cNew];
If[labels,AppendTo[pic,p]];
morecircs[j,level+1];
];
b=Smat[[j]].b;
w=Smat[[j]].w;
]
]
];

(* Initializations *)
b0[[1]]=b4/.des[b0[[2]],b0[[3]],b0[[4]]][[1]];
w0={blank,0,b0[[3]]I (1/b0[[2]]+1/b0[[3]]),blank};
w0[[4]]=b0[[4]](x+I y) /.touch[0,0,1/b0[[2]]+1/b0[[4]],0,1/b0[[2]]+1/b0[[3]],1/b0[[3]]+1/b0[[4]]][[1]];
w0[[1]]=b4/.des[w0[[2]],w0[[3]],w0[[4]]][[2]];
cs=ps={blank,blank,blank,blank};
For[j=1,j≤4,j++,
cs[[j]]=circPlot[scale/b0[[j]]Re[w0[[j]]],scale/b0[[j]]Im[w0[[j]]],scale/Abs[b0[[j]]]];
ps[[j]]=Text[Style[Abs[b0[[j]]],Floor[fscale/Abs[b0[[j]]]]],{scale Re[((w0[[j]])/(b0[[j]]))],scale Im[((w0[[j]])/(b0[[j]]))]}];
];
b=b0;
w=w0;
pic0={cs[[1]],cs[[2]],cs[[3]],cs[[4]]};
If[labels,AppendTo[pic0,{ps[[2]],ps[[3]],ps[[4]]}]];


(* Run the program *)
pic=pic0;
b=b0;
w=w0;
morecircs[0,1];
pic1=Show[Graphics[pic]]