A New Kind of Science: The NKS Forum

code:

<<Graphics`Shapes`

FlattenPosition[e_?MatrixQ,rc_:Automatic]:=
  Module[{r=rc},
         If[r===Automatic,r=Max[e[[All,2]]]];
         (#[[1]]-1)r+#[[2]]&/@e]

SphereMatrix[m_?MatrixQ]:=
  Module[{s,h,w,pos},
         {h,w}=Dimensions[m,2];
         s=Sphere[1,h,w+2];
         pos=FlattenPosition[Position[m,1]];
         s[[pos]]];

Show[Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                SphereMatrix[Transpose[CellularAutomaton[60,{{1},0},40,{All,All}]]]},
                ViewPoint->{-1.656, 2.170, 2.000},Lighting->False]];

PaddNumber[n_,p_]:=PaddedForm[n,p,NumberPadding->{"0","0"}]

SetDirectory[ToFileName[{$HomeDirectory,"doc","NKS","XmaTranSphere"}]];

With[{s=32},
  Do[Export["SpheresTranspose-"<>ToString[PaddNumber[i,2]]<>".gif",
            GraphicsArray[Partition[Table[Graphics3D[
              SphereMatrix[Transpose[CellularAutomaton[j,{{1},0},40,{All,All}]]],
              {Boxed->False,PlotLabel->j,ViewPoint->{2.6, 1.6, 2.0}}],
{j,s*i,s(i+1)-1}],3,3,1,Graphics3D[]]],ImageSize->1024],{i,0,Quotient[255,s]}]];

Do[Export["XMaTranSphere-"<>ToString[PaddNumber[i,3]]<>".gif",
          Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                     SphereMatrix[Transpose[CellularAutomaton[i,{{1},0},50,{All,All}]]]},
                     {Lighting->False,Boxed->False,ViewPoint->{2.6, 1.6, 2.0}}],
          ImageSize->640],{i,0,255}];

Do[Export["XMaSphere-"<>ToString[PaddNumber[i,3]]<>".gif",
      Graphics3D[{FaceForm[RGBColor[1,0,0],RGBColor[0,1,0]],
                 SphereMatrix[CellularAutomaton[i,{{1},0},50,{All,All}]]},
                 {Lighting->False,Boxed->False,ViewPoint->{2.6, 1.6, 2.0}}],
      ImageSize->640],{i,0,255}];