Adventures in Computation

Christopher Carlson, Wolfram Research

Physics

Physics[{p:{x_,y_},v:{vx_,vy_}}]:=
If[y≥-1,
{p-v,v+{0,0.004}},
{{x,-1},{1,-.93} v}]

Bounce[]:=Framed[DynamicModule[{contents={}},EventHandler[Graphics[{PointSize[0.1],Point[Dynamic[First/@(contents=Physics/@contents)]]},PlotRange->1],"MouseDown":>(AppendTo[contents,{MousePosition["Graphics"],{0,0}}])]],FrameMargins->0];

Bounce[]

Physics

Physics[{p:{x_,y_},v:{vx_,vy_}}]:=
If[y≥-1,
{p-v,v+{0,0.004}},
EmitSound[Sound[SoundNote[]]];{{x,-1},{1,-.93} v}]

Bounce[]



Soundscape

EmitSound[Sound[SoundNote[#,.1,"Percussion"]&/@Range[-32,35]]]

Soundscape

Manipulate[
EmitSound[Sound[SoundNote[instrument,.1,"Percussion"]]],
{instrument,-32,35,1,Appearance->"Labeled"}
]

Physics

Physics[{p:{x_,y_},v:{vx_,vy_}}]:=
If[y≥-1,
{p-v,v+{0,0.004}},
EmitSound[Sound[SoundNote[-10,.1,"Percussion"],SoundVolume->(20  vy)]];{{x,-1},{1,-.93} v}];

Bounce[]

Music?

Physics[{p:{x_,y_},v:{vx_,vy_}}]:=
If[y≥-1,
{p-v,v+{0,0.004}},
EmitSound[Sound[SoundNote[IntegerPart[32 x + 20],.1,79],SoundVolume->20vy]];{{x,-1},{1,-.93} v}];

Bounce[]

Expand

Expand[(((x+1))^3)]

Insanity

Bounce[]

Architecture Biennale, Venice (Gramazio + Kohler, 2008)

ROB (Gramazio + Kohler)

BrickPlot

Plot3D[Sin[(7 (x/128-.5))^2+(7 (y/128-.25))^2],{x,0,128},{y,0,64},BoxRatios->Automatic]

BrickPlot[Sin[(7 (x/128-.5))^2+(7 (y/128-.25))^2],{x,0,128},{y,0,64},BoxRatios->Automatic]

BrickPlot

BrickPlot[With[{r=(7 (x/128-.5))^2+(7 (y/128-.5))^2},1/(r/20.+.05)Cos[r]],{x,0,128},{y,0,128}]

BrickPlot

BrickPlot[100E^-(Sqrt[(x/128-.5)^2+(y/128-.5)^2]),{x,0,128},{y,0,128}]

BrickPlot

BrickPlot[With[{r=(x/64-1)^2+(y/64-1)^2},If[r≤1,24 (r-1),0]],{x,0.,128},{y,0.,128}]

BrickPlot

BrickPlot[With[{r=(7 (x/128-.5))^2+(7 (y/128-.5))^2},1/(r/20.+.01)Cos[r]],{x,0.,128},{y,0.,128}]

Writing on the Wall

textImage = Rasterize[Style["mirage",FontFamily->"Times"],ImageSize->196]

Writing on the Wall

blurredTextImage = ImageCrop[ColorConvert[Blur[textImage],"GrayScale"],{256,128},Padding->1]

Writing on the Wall

imageFunction=ListInterpolation[Transpose[ImageData[blurredTextImage]],{{0,256}+{-5,5},{0,128}+{-2.5,2.5}}];

Plot3D[ -3 imageFunction[x,y],{x,0,256},{y,0,128},BoxRatios->Automatic,PlotRange->All,MaxRecursion->4]

Writing on the Wall

mirageWall=BrickPlot[ -imageFunction[x,y],{x,0,256},{y,0,128},BrickSpacing->1,BrickStyle->EdgeForm[None]]

Writing on the Wall

Lofting

Loft[contours_]:=Module[
{nc = Length[contours],n=Length[First[contours]]},
GraphicsComplex[Join@@contours,
Polygon[Flatten[Table[Table[
1+{j+Mod[i,n], j+Mod[i+1,n], 
j+ n+Mod[i+1,n],j+ n+Mod[i,n]},
{i,0,n-1}],{j, 0, n(nc-2), n}],1]]
]]

Manipulate[
Module[{pts=Table[Table[
{Cos[b]Cos[a+tw b],Cos[b]Sin[a+tw b],h Sin[b]},{a,N[π]/np,2π,π/np}],{b,0.,π/2,π/2/(nc-1)}]},
If[loft,
Graphics3D[Loft[pts],Boxed->False,ImageSize->500{1,1}],
Graphics3D[{PointSize[.01],Point[Flatten[pts,1]],FaceForm[None],EdgeForm[Gray],Polygon /@ pts},Boxed->False,ImageSize->500{1,1}]]],
{{nc,14,"contours"},2,24,1},
{{np,11,"points"},3,24,1},
{{h,1,"height"},-3,3},
{{tw,1.6,"twist"},-3,3},
{{loft,False,"loft"},{True,False}},
ControlPlacement->Left
]

Exploring Lofting

Swiss Re Building, London (Norman Foster, 2004)

Geometry

Geometry

Point Grid

profileFunction = BSplineFunction[{{.12,0},{.16,.36},{.11,0.80},{.03,1},{0,1}},SplineDegree->2];

meshedProfile=ParametricPlot[profileFunction[t],{t,0,1},MeshFunctions->(#2&),Mesh->2 44-1,MeshStyle->{Red,PointSize[.05]},AspectRatio->Automatic,Ticks->None,AxesStyle->AbsoluteThickness[.5]]

profilePoints = Sort[Join[
{profileFunction[0]},
Cases[meshedProfile//Normal, Point[p_]:>p,∞],
{profileFunction[1]}
],(#1[[2]]≤#2[[2]])&];

gherkinContours = Table[
Table[With[{r=profilePoints[[i,1]]},{r Cos[a],r Sin[a],(i-1)/Length[profilePoints]}],{a,0,2π-0.001,2π/(2 4 18)}],{i,1,Length[profilePoints]}];

Graphics3D[Point /@ gherkinContours,Method->{"RotationControl"->"Globe"}]

Architectural Elements

With[{contours = Table[Table[{Cos[a],Sin[a],z/4},
{a,π/18,2π,π/18}],{z,0,12}]},
Manipulate[
Graphics3D[
Build[contours,{
Line[{0,1}],Line[{1,0}],
Tube[{1,ty},.02,2],
Blue,Polygon[{{0,0},{-1,1},{0,2},{1,1}},{{4,0},{-1,1}}],
Orange,Polygon[{{2,0},{1,1},{2,2},{3,1}},{{4,0},{-1,1}}]
}],Boxed->False,Lighting->"Neutral"],
{{ty,1,"tube angle"},-3,3,1}
]
]

The Gherkin, Modeled

(Row[          ⟶  , ])

Color Variations

Color Variations

Row[Table[
HiRes[gherkinModel/.{GrayLevel[0.2]:>If[RandomReal[]<.5,Swatch,Swatch],GrayLevel[0.1]->Swatch},2],{3}]]

Color Variations

Row[Table[
HiRes[gherkinModel/.{GrayLevel[0.2]:>If[RandomReal[]<.5,Swatch,Swatch],GrayLevel[0.1]->Swatch},2],{3}]]

Geometric Variations

Manipulate[
gherkinModel/.{GraphicsComplex[pts_,objs_]:>
GraphicsComplex[
With[{r=1+a Sin[f (ArcTan[#[[1]],#[[2]]+.001]+
tw #[[3]]+ph)]},{r,r,1}#]& /@ pts, 
objs]},
{{a,0,"amplitude"},0,1},
{{f,2,"frequency"},2,18,1},
{{tw,0,"twist"},-4π,4π},
{{ph,0,"phase"},0,2π},
ControlPlacement->Left
]

Flattened Gherkin

Ribbed Gherkin

Lumpy Gherkin

Spiral Gherkin

Tangoing Gherkin

Wrinkled Gherkin

Hearst Tower, New York (Norman Foster, 2006)

Hearst Tower, Modeled

Hearst Tower, Bent

Hearst Tower, Twisted

National Library, Anastan, Kazakhstan (BIG Architects, 2009)

Cheating

Not Cheating

Orbital Outpost of the Guggenheim

Figures

figures = prepFigure /@ {,,,,,,,,};

Graphics3D[{
EdgeForm[None],Gray,
Table[Translate[figures[[i + 3j+  1]],{i,0,j}],{i,0,2},{j,0,2}],
Line[Table[{{x,0,-.5},{x,0,2.5}},{x,-.5,2.5,.125}]],
Line[Table[{{-.5,0,z},{2.5,0,z}},{z,-.5,2.5,.125}]]
},Boxed->False]

Artwork

mandrillImage = ExampleData[{"TestImage","Mandrill"}]

ImageEffect[ImageTake[mandrillImage,{129,256},{64,256}],"Solarization"]

ImageTake[mandrillImage,{1,128},{32,224}]

ImageRotate[ImageTake[mandrillImage,{225,416},{225,352}]]

Möbius Gallery, Exterior

Möbius Gallery, Interior

Fly-Through Planning

Möbius Gallery Fly-Through

Setup

SetOptions[InputNotebook[],WindowSize->{1024,768}]

SetOptions[InputNotebook[],NotebookEventActions->{"LeftArrowKeyDown":>FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPagePrevious"]],"RightArrowKeyDown":>FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPageNext"]],"UpArrowKeyDown":>FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPageUp"]],"DownArrowKeyDown":>FrontEndExecute[FrontEnd`FrontEndToken[FrontEnd`InputNotebook[],"ScrollPageDown"]]}];

EmitSound[Sound[SoundNote[-10,.1,"Percussion"],SoundVolume->0]]

Implementation

Dilate

Dilate[p_,f_]:=
Module[{c=(Plus @@ p)/Length[p]},
(c + f (#-c))& /@ p
]

Loft

Loft[contours_]:=Module[
{nc = Length[contours],n=Length[First[contours]]},
GraphicsComplex[Join@@contours,
Polygon[Flatten[Table[Table[
1+{j+Mod[i,n], j+Mod[i+1,n], 
j+ n+Mod[i+1,n],j+ n+Mod[i,n]},
{i,0,n-1}],{j, 0, n(nc-2), n}],1]]
]]

Build

ClearAll[Build];
Build[contours_, buildSpec_:{Polygon[{{0,0},{1,0},{1,1},{0,1}}]}]:=
Module[{d=Reverse[Take[Dimensions[contours],2]]},
GraphicsComplex[
Join @@ contours,
buildSpec/.{
Polygon[x_]:>BuildPolygons[x,d],
Polygon[x_,b_]:>BuildPolygons[x,d,b],
Line[x_]:>BuildLines[x, d],
Line[x_,b_]:>BuildLines[x, d,b],
Tube[x_,r_]:>BuildTubes[x,r, d],
Tube[x_,r_,b_]:>BuildTubes[x, r, d,b]
}
]];

ClearAll[BuildLines];
BuildLines[x_,d_,b_:Automatic]:=BuildLinearStructure[Line,x,0, d,b]

ClearAll[BuildTubes];
BuildTubes[x_,r_, d_,b_:Automatic]:=BuildLinearStructure[Tube,x,r, d,b]

ClearAll[BuildLinearStructure];
BuildLinearStructure[type_, lineIn_,r_,{np_, nc_}, spacing_:Automatic]:=
Module[{
i, (* GraphicsComplex index function *)
line,vec,nSegs,nLines,sp ,indices
},

line= If[MatchQ[lineIn,{_Integer,_Integer}],{{0,0},lineIn},lineIn];

vec = line[[2]]-line[[1]];
If[vec[[2]]<0,vec = -vec];

If[vec[[2]]==0, (* special case: horizontal lines *)
sp= If[spacing===Automatic,{0,1},{0,spacing}];
nSegs = Floor[Abs[np/vec[[1]]]];
nLines = Floor[(nc-1-line[[1,2]])/sp[[2]]],

(* Else lines vertically oriented*)
sp = If[spacing===Automatic,{1,0},{spacing,0}];
nSegs = Floor[Abs[(nc-1-line[[1,2]])/vec[[2]]]];
nLines = Floor[np/sp[[1]]]
];

(* Returns index into coordinates given point, contour. *)
i[{p_,c_}]:=1+Mod[p,np] + np c;

indices=Table[Table[i[l sp + s vec+line[[1]]],{s,0,nSegs}],{l,0,nLines}];

Switch[type,
Line,Line[indices],
Tube,{EdgeForm[None],Cylinder[Drop[Transpose[{#,RotateLeft[#]}],-1],r]& /@indices ,Sphere[Flatten[indices,1],r]}
]
]

ClearAll[BuildPolygons];
BuildPolygons[polygon_,{np_, nc_}, spacingIn_:Automatic]:=
Module[{
i, (* GraphicsComplex index function *)
dp, (* point increment within a contour *)
dc, (* contour increment *)
dpc, (* point increment shift per contour *)
ico,icn,
s1p,s1c,s2p,s2c(* spacing vectors and components *)
},

{{s1p,s1c},{s2p,s2c}}= If[spacingIn===Automatic,{polygon[[2]]-polygon[[1]],polygon[[-1]]-polygon[[1]]}, spacingIn];

(* Calculate p and c increments *)
If[s1c<0, {s1p,s1c}=-{s1p,s1c}];
If[s2c<0, {s2p,s2c}=-{s2p,s2c}];
dp=With[{lcm = LCM[s1c,s2c]},If[lcm===0, Abs[If[s1c==0,s1p,s2p]],Abs[s1p(lcm/s1c) - s2p(lcm/s2c)]]];
{dpc,dc} ={{s1p,s1c},{s2p,s2c}}[[Which[s1c==0, 2, s2c==0,1,Abs[s1c]<Abs[s2c],1,True,2]]];

(* Find index offset relative to original polygon position of first vertical position *)
ico = -Floor[Min[Last /@ polygon]/dc];

(* Find number of vertical repetitions *)
icn = Floor[(nc-1 - (Max[Last /@ polygon]+ico dc))/dc]+1;

(* Returns index into coordinates given point, contour. *)
i[{p_,c_}]:=1+Mod[p,np] + np c;

Polygon[Flatten[Table[i[{p+ic dpc,ic dc}+#]& /@ polygon,{ic,ico,ico+icn-1},{p,0,np-1,dp}],1]]

]

HiRes

ClearAll[HiRes]

HiRes[x_,n_:3]:=Rasterize[Style[Rasterize[Style[x,Magnification->n]],Magnification->1/n]]

Gherkin Model

Completed Gherkin Model

Floor Slicing

profileFunction = BSplineFunction[{{.12,0},{.16,.36},{.11,0.80},{.03,1},{0,1}},SplineDegree->2];

profilePoints = Sort[Join[
{profileFunction[0]},
Cases[meshedProfile//Normal, Point[p_]:>p,∞],
{profileFunction[1]}
],(#1[[2]]≤#2[[2]])&];

gherkinContours = Table[
Table[With[{r=profilePoints[[i,1]]},{r Cos[a],r Sin[a],(i-1)/Length[profilePoints]}],{a,0,2π-0.001,2π/(2 4 18)}],{i,1,Length[profilePoints]}];

Manipulate[
ParametricPlot[profileFunction[t],{t,0,1},MeshFunctions->(#2&),Mesh->2 44-1,MeshStyle->{Red,PointSize[.05]},AspectRatio->Automatic,Ticks->None,Epilog->{Green,PointSize[.05],Point[profileFunction[x]]},PlotRange->{Automatic,{.9,1}}],
{x,.8,1}
]

tCap = .888;

meshedProfile = Show[
ParametricPlot[profileFunction[t],{t,0,1},MeshFunctions->(#2&),Mesh->2 44-1,MeshStyle->{Red,PointSize[.05]},AspectRatio->Automatic,Ticks->None],
ParametricPlot[profileFunction[t],{t,tCap,1},MeshFunctions->(#1&),Mesh->5,MeshStyle->{Green,PointSize[.05]},AspectRatio->Automatic,Ticks->None]
]

profilePoints = Sort[Join[
{profileFunction[0]},
Cases[meshedProfile//Normal, Point[p_]:>p,∞],
{profileFunction[1]}
],(#1[[2]]≤#2[[2]])&];

gherkinContours = 
With[{bodyContours = N@Table[Table[With[{r=profilePoints[[i,1]]},{r Cos[a],r Sin[a],profilePoints[[i,2]]}],{a,0,2π-0.001,2π/(2 4 18)}],{i,1,Length[profilePoints]}]},
Join[
bodyContours,
{Dilate[bodyContours[[73]],1.07],
Dilate[bodyContours[[74]],1.07]}
]
];

GherkinLighting[]={{"Directional",Hue[0.`,0.342`,1.`],ImageScaled[{-1,0.6,1}]},{"Ambient",Hue[0.55`,0.51`,0.516`]}}

GherkinView []:= Sequence @@ {(*ViewAngle->0.3281499169138977,*)
  (*ViewCenter->{{0.5, 0.5, 0.5}, {0.4028985020863396, 0.5132787417077784}},*)
  ViewPoint->{-2.5972323621384685`, 2.1686019486222388`, 0.039365536863571374`},
  ViewVertical->{0., 0., 1.}}

gherkinModel = With[{
ab=0.1,ah=0,as=0,cg=0.2`,db=1,dggb=0.05`,dggh=0.5`,dggs=0.5`,dg=0.1`,dh=0.082`,ds=0.21`,lggb=0.3`,lggh=0.5`,lggs=0.5`,lg=0.2`,spec=300,x=-1,y=0.38`,z=1
},
With[{
frameRadius=0.002,
transitionFrameRadius = 0.0015,
ringRadius = 0.002,
capFrameRadius=0.001,
paneAppearance = Directive[Specularity[White,spec],EdgeForm[GrayLevel[0.11`]],GrayLevel[0.11`]],
lightGlassColor = Directive[GrayLevel[lg],Glow[Hue[lggh,lggs,lggb]]],
darkGlassColor = Directive[GrayLevel[dg],Glow[Hue[dggh,dggs,dggb]]],
capGlassColor=Directive[GrayLevel[dg],Glow[Hue[dggh,dggs,dggb]]],
ringColor = GrayLevel[.75]
},
Graphics3D[{
(* Bottom row of triangular panes *)
Build[Take[gherkinContours,{1,2}],{
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i,0})&/@{{0,0},{1,1},{2,0}},{{24,0},{-1,1}}]},{i,0,11}]
}],
(* Body *)
Build[Take[gherkinContours,69],{
Tube[1{-1,1},frameRadius,8],
Tube[1 {1,1},frameRadius,8],
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i,0})&/@{{0,0},{-1,1},{0,2},{1,1}},{{24,0},{-1,1}}]},{i,0,11}],
Line[{1,0},2]
}],
(* Top row of triangular panes before transition to cap *)
Build[Take[gherkinContours,{68,69}],{
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i+5,0})&/@{{0,0},{-1,1},{1,1}},{{24,0},{-1,1}}]},{i,0,11}]
}],
(* Transition *)
Build[Take[gherkinContours,{69,73}],{
paneAppearance,

lightGlassColor,
Table[Polygon[(#+{i+12,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+14,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+15,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+16,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

Table[Polygon[(#+{i+20,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+22,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+23,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+24,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

darkGlassColor,
Table[Polygon[(#+{i+4,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+6,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+7,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+8,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

capGlassColor,EdgeForm[None],
Polygon[(#+{4,0})& /@ (2{{0,0},{-1,1},{1,1}}),{{8,0},{0,10}}],
Polygon[(#+{2,2})& /@ (2{{0,0},{-1,1},{1,1}}),{{4,0},{0,10}}],
Polygon[(#+{2,2})& /@ (2{{0,0},{1,1},{2,0}}),{{4,0},{0,10}}],

White,Tube[{{4,0},{5,1}},transitionFrameRadius,8],Tube[{{4,0},{3,1}},transitionFrameRadius,8]
}],
(* Cap *)
Build[Take[gherkinContours,{73,89}],{
Tube[1{-1,1},capFrameRadius,8],
Tube[1 {1,1},capFrameRadius,8],
paneAppearance,EdgeForm[None],capGlassColor,
Polygon[2{{0,0},{1,1},{2,0}},{{4,0},{2,2}}],
Polygon[2{{2,0},{1,1},{3,1}},{{4,0},{2,2}}]
}],
(* Top of cap *)
EdgeForm[None],
Build[Take[gherkinContours,{89,94}]],
(* Rings *)
ringColor,
Build[Take[gherkinContours,{95,96}],
Tube[{1,0},ringRadius]]
},Boxed->False,Method->{"RotationControl"->"Globe"},Lighting->{{"Directional",Hue[dh,ds,db],ImageScaled[{x,y,z}]},{"Ambient",Hue[ah,as,ab]}},ViewPoint->{1.7431743888641775`,-2.876303552667954`,0.3717807457597563`},ImageSize->230]]];

Gherkin Lighting Rig

Manipulate[
With[{
frameRadius=0.003,
transitionFrameRadius = 0.002,
capFrameRadius=0.001,
paneAppearance = Dynamic[Directive[Specularity[White,spec],EdgeForm[GrayLevel[.1]],GrayLevel[.1]]],
lightGlassColor = Dynamic[Directive[GrayLevel[lg],Glow[Hue[lggh,lggs,lggb]]]],
darkGlassColor = Dynamic[Directive[GrayLevel[dg],Glow[Hue[dggh,dggs,dggb]]]],
capGlassColor=Dynamic[Directive[GrayLevel[dg],Glow[Hue[dggh,dggs,dggb]]]]
},
Graphics3D[{
(* Bottom row of triangular panes *)
Build[Take[gherkinContours,{1,2}],{
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i,0})&/@{{0,0},{1,1},{2,0}},{{24,0},{-1,1}}]},{i,0,11}]
}],
(* Body *)
Build[Take[gherkinContours,69],{
Tube[1{-1,1},frameRadius,8],
Tube[1 {1,1},frameRadius,8],
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i,0})&/@{{0,0},{-1,1},{0,2},{1,1}},{{24,0},{-1,1}}]},{i,0,11}],
Line[{1,0},2]
}],
(* Top row of triangular panes before transition to cap *)
Build[Take[gherkinContours,{68,69}],{
paneAppearance,
Table[
{If[i≤3,darkGlassColor,lightGlassColor],
Polygon[(#+{2i+5,0})&/@{{0,0},{-1,1},{1,1}},{{24,0},{-1,1}}]},{i,0,11}]
}],
(* Transition *)
Build[Take[gherkinContours,{69,73}],{
paneAppearance,

lightGlassColor,
Table[Polygon[(#+{i+12,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+14,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+15,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+16,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

Table[Polygon[(#+{i+20,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+22,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+23,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+24,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

darkGlassColor,
Table[Polygon[(#+{i+4,0})& /@ {{0,0},{1,1},{2,0}},{{24,0},{0,100}}],{i,0,6,2}],
Table[Polygon[(#+{i+6,0})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,4,2}],Table[Polygon[(#+{i+7,1})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,2,2}],
Table[Polygon[(#+{i+8,2})& /@ {{0,0},{-1,1},{0,2},{1,1}},{{24,0},{0,100}}],{i,0,0,2}],

capGlassColor,EdgeForm[None],
Polygon[(#+{4,0})& /@ (2{{0,0},{-1,1},{1,1}}),{{8,0},{0,10}}],
Polygon[(#+{2,2})& /@ (2{{0,0},{-1,1},{1,1}}),{{4,0},{0,10}}],
Polygon[(#+{2,2})& /@ (2{{0,0},{1,1},{2,0}}),{{4,0},{0,10}}],

White,Tube[{{4,0},{5,1}},transitionFrameRadius,8],Tube[{{4,0},{3,1}},transitionFrameRadius,8]
}],
(* Cap *)
Build[Take[gherkinContours,{73,89}],{
Tube[1{-1,1},capFrameRadius,8],
Tube[1 {1,1},capFrameRadius,8],
paneAppearance,EdgeForm[None],capGlassColor,
Polygon[2{{0,0},{1,1},{2,0}},{{4,0},{2,2}}],
Polygon[2{{2,0},{1,1},{3,1}},{{4,0},{2,2}}]
}],
(* Top of cap *)
EdgeForm[None],
Build[Take[gherkinContours,{89,94}]]
},Boxed->False,Method->{"RotationControl"->"Globe"},ViewPoint->{1.7431743888641775`,-2.876303552667954,0.3717807457597563},Lighting->Dynamic[
{{"Directional",Hue[dh,ds,db],ImageScaled[{x,y,z}]},{"Ambient",Hue[ah,as,ab]}}
],ImageSize->300]],
{{dh,0.082,"directional hue"},0,1},
{{ds,0.2,"directional sat"},0,1},
{{db,1,"directional bri"},0,1},
{{ah,.686,"ambient hue"},0,1},
{{as,0.454,"ambient sat"},0,1},
{{ab,0,"ambient bri"},0,1},
{{x,-1},-1,1},
{{y,.38},-1,1},
{{z,1},-1,1},
{{cg,0.2,"cap gray"},0,1},
Delimiter,
{{lg,0.2,"light gray"},0,1},
{{lggh,0.5,"light glow hue"},0,1},
{{lggs,0.5,"light glow sat"},0,1},
{{lggb,0.3,"light glow bri"},0,1},
Delimiter,
{{dg,0.21,"dark gray"},0,1},
{{dggh,.5,"dark glow hue"},0,1},
{{dggs,.5,"dark glow sat"},0,1},
{{dggb,.05,"dark glow bri"},0,1},
Delimiter,
{{spec,300,"specularity"},0,1000},
ControlPlacement->Right
]

BrickPlot

BrickPlot[functionExpr_, {xx_,xxMin_,xxMax_}, {yy_, yyMin_, yyMax_}, opts___]:=
Module[{bl, bw, bh, bs,nc,nb,bStyle,
surfaceFunction,slopeFunction},
{bl,bw,bh} = BrickSize /.{opts}/. {BrickSize->{8,4,2}};
bs = BrickSpacing/.{opts}/.{BrickSpacing->1};
bStyle = BrickStyle /. {opts}/.{BrickStyle->{}};
If[Head[bStyle]===List, bStyle=Directive@@bStyle];
nb= Floor[(xxMax-xxMin)/(bl + bs-.5)];
nc = Floor[(yyMax-yyMin)/bh];
surfaceFunction = Function[{xx,yy},functionExpr];
slopeFunction= Derivative[1,0][surfaceFunction];
Graphics3D[{Swatch,EdgeForm[{Black,Thickness[.0015]}],bStyle,
Table[With[{
x=bl/2 + (b-1)(bl+bs) + If[EvenQ[c],0,(bl+bs)/2],
y=0,
z=c bh + bh/2
},Translate[Rotate[Cuboid[-{bl,bw,bh}/2.,{bl,bw,bh}/2.],-ArcTan[slopeFunction[x,z]],{0,0,1}],{x,y-surfaceFunction[x,z],z}]],{c,0,nc-1},{b,0,nb-1}]
},
Boxed->False,Lighting->"Neutral",
Select[{opts},((#[[1]]=!=BrickSize) && (#[[1]]=!=BrickSpacing)&& (#[[1]]=!=BrickStyle))&]
]
]

Manipulate[
ControlActive[
Plot3D[Sin[(7 (x/p-.5))^2+(7 (y/128-.25))^2],{x,0,128},{y,0,64},
Boxed->False,Axes->None,BoxRatios->Automatic,PerformanceGoal->"Quality",Mesh->None],
BrickPlot[Sin[(7 (x/p-.5))^2+(7 (y/128-.25))^2],{x,0,128},{y,0,64}]
],
{{p,128},1,256}
]

Extrude

Extrude[pts_,vec_]:=
Module[{n=Length[pts]},
GraphicsComplex[
Join[pts, (#+vec)& /@ pts],
Polygon[Join[
Table[{i,1+Mod[i,n],n+1+Mod[i,n],n+i},{i,1,n}],
{Reverse[Range[n]],n+Range[n]}
]]
]]

prepFigure

prepFigure[fig_]:=Module[{pts=(Append[#,0])& /@ (Cases[fig,BezierCurve[x_,opts___]:>GeometricFunctions`BezierCurve[First[x],Sequence@@Select[{opts},(#[[1]]===SplineDegree)&]],∞,1][[1,1]]),
xMin,xMax,yMin,yMax,zMin,zMax,scale},
pts = Table[pts[[i]],{i,1,Length[pts],25}];
{{xMin,xMax},{yMin,yMax},{zMin,zMax}} = {Min[#],Max[#]}& /@ Transpose[pts];
scale = Max[(#[[2]]-#[[1]])& /@ {{xMin,xMax},{yMin,yMax},{zMin,zMax}}];
pts = ((#-{xMin,yMin,zMin})/scale)& /@ pts;
Extrude[pts,{0,0,.03}]
];

positionFigure

ClearAll[positionFigure];
positionFigure[figure_, {w_,l_,r_}, size_:1,rot_:0,hPos_:0,lPos_:0]:=
Module[{fw,fh,fd},
{fw,fh,fd} = (Max[#]-Min[#])& /@ Transpose[figure[[1]]];

Rotate[Translate[Rotate[Translate[
Rotate[Scale[Rotate[Translate[figure,-{fw,0,fd}/2],rot,{0,1,0}],size w/2,{0,0,0}],π/2,{0,0,1}],
{.85(w/2),hPos l/2,0}],2π lPos,{0,0,1}],{r,0,0}],4π lPos,{0,1,0}]
]

galleryModel

galleryModel=With[{contours = Module[{w=1,l=.75,pts,p1,p2,nf=160},
pts=Join[
Table[{-w/2 + i w/4, -l/2,0},{i,0,3}],
Table[{w/2,-l/2 + i l/3,0},{i,0,2}],
Table[{w/2 - i w/4, l/2,0},{i,0,3}],
Table[{-w/2,l/2 - i l/3,0},{i,0,2}]
]//N;
p1=Flatten[Transpose[{pts,pts}],1];
p2=With[{pts2 = (pts + RotateLeft[pts])/2.},RotateRight[Flatten[Transpose[{pts2,pts2}],1]]];

Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@With[{f=4-Abs[4-Mod[d,8]]},p1 + (p2-p1)(f/4)],{d,0,nf}]
],

floorPts1 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{-w/2,-l/2,0},{-w/2,l/2,0}}),{d,0,nf}]
],

floorPts2 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{w/2,-l/2,0},{w/2,l/2,0}}),{d,0,nf}]
]},
Graphics3D[{
{EdgeForm[None],(*Swatch,*)GrayLevel[1],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts1,RotateLeft[Reverse/@floorPts1]}],-1]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts2,RotateLeft[Reverse/@floorPts2]}],-1]]
},
Build[contours,{
{Swatch,Specularity[White,50],Opacity[.25],EdgeForm[None],Polygon[{{0,0},{0,1},{1,1},{1,0}}]},
{EdgeForm[None],Tube[{0,1},.01],Tube[{1,0},.01,4]}
}],
Table[{GrayLevel[RandomReal[]],PointSize[RandomReal[{0,.007}]],Point[With[{a=RandomReal[{0,2π}],b=RandomReal[{0,π}],d=5},d{ Sin[b]Cos[a],Cos[b],Sin[b]Sin[a]}]]},{2000}]
},Boxed->False,PlotRange->All,Lighting->{{"Directional",RGBColor[1,1,1],ImageScaled[{-1,1,1}]}},ImageSize->400,ViewAngle->46°,
ViewVector->{3{1,1,1},{0,0,0}},ViewVertical->{-0.3240527721923405,2.820223505984313,-0.07008831244768246},Background->Black]]

simplifiedGalleryModel

simplifiedGalleryModel=With[{contours = Module[{w=1,l=.75,pts,p1,p2,nf=160},
pts=Join[
Table[{-w/2 + i w/4, -l/2,0},{i,0,3}],
Table[{w/2,-l/2 + i l/3,0},{i,0,2}],
Table[{w/2 - i w/4, l/2,0},{i,0,3}],
Table[{-w/2,l/2 - i l/3,0},{i,0,2}]
]//N;
p1=Flatten[Transpose[{pts,pts}],1];
p2=With[{pts2 = (pts + RotateLeft[pts])/2.},RotateRight[Flatten[Transpose[{pts2,pts2}],1]]];

Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@With[{f=4-Abs[4-Mod[d,8]]},p1 + (p2-p1)(f/4)],{d,0,nf}]
],

floorPts1 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{-w/2,-l/2,0},{-w/2,l/2,0}}),{d,0,nf}]
],

floorPts2 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{w/2,-l/2,0},{w/2,l/2,0}}),{d,0,nf}]
]},
Graphics3D[{
{EdgeForm[None],(*Swatch,*)GrayLevel[1],Glow[GrayLevel[.2]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts1,RotateLeft[Reverse/@floorPts1]}],-1]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts2,RotateLeft[Reverse/@floorPts2]}],-1]]
},
Build[contours,{
(*{Swatch,Specularity[White,50],Opacity[.25],EdgeForm[None],Polygon[{{0,0},{0,1},{1,1},{1,0}}]},*)
{EdgeForm[None],Tube[{0,1},.01],Tube[{1,0},.01,4]}
(*{White,Line[{0,1}],Line[{1,0},4]}*)
}]
},Boxed->False,PlotRange->All,Lighting->{{"Directional",RGBColor[1,1,1],ImageScaled[{-1,1,1}]}},ImageSize->400,ViewAngle->46°,
ViewVector->{3{1,1,1},{0,0,0}},ViewVertical->{-0.3240527721923405,2.820223505984313,-0.07008831244768246},Background->Black]]

Artwork

mandrillImage = ExampleData[{"TestImage","Mandrill"}];

artwork1 =Module[{index,nr=128,nc=128},
index[{r_,c_}] := nc(c-1)+r;
GraphicsComplex[
TranslationTransform[{0,.7,0}]/@Flatten[Table[{r/128,c/128,0},{r,1,128},{c,1,128}],1],
Polygon[Flatten[Table[{index[{r,c}],index[{r+1,c}],index[{r+1,c+1}],index[{r,c+1}]},{r,1,128-1},{c,1,128-1}],1]],
VertexColors -> Flatten[ImageTake[mandrillImage,{1,128},128+{1,128}][[1]],1]/256.
]
];

artwork2=
Module[{index,nr=128,nc=128},
index[{r_,c_}] := nc(c-1)+r;
GraphicsComplex[
TranslationTransform[{0,.7,0}]/@Flatten[Table[{r/128,c/128,0},{r,1,128},{c,1,128}],1],
Polygon[Flatten[Table[{index[{r,c}],index[{r+1,c}],index[{r+1,c+1}],index[{r,c+1}]},{r,1,128-1},{c,1,128-1}],1]],
VertexColors -> Flatten[ImageRotate[ImageEffect[ImageTake[mandrillImage,128+{1,128},128+{1,128}],"Solarization"]][[1]],1]/256.
]
];

artwork3=
Module[{index,nr=128,nc=128},
index[{r_,c_}] := nc(c-1)+r;
GraphicsComplex[
TranslationTransform[{0,.7,0}]/@Flatten[Table[{r/128,c/128,0},{r,1,128},{c,1,128}],1],
Polygon[Flatten[Table[{index[{r,c}],index[{r+1,c}],index[{r+1,c+1}],index[{r,c+1}]},{r,1,128-1},{c,1,128-1}],1]],
VertexColors -> Flatten[ImageRotate[ImageTake[mandrillImage,256+32+{1,128},128+64+32+{1,128}]][[1]],1]/256.
]
];

CenterFigure

CenterFigure[fig_]:=
Pane[fig,Alignment->Center,ImageSize->{833,643}]

Figures

Falls Image

fallsImage = ;

FeatherEdge[image_, d_]:=
Module[{imageData = ImageData[image], nr, nc},
{nr,nc} = Take[Dimensions[imageData],2];
Image[Table[
Module[{pixel=imageData[[r,c]],rd,cd},
rd = If[r < nr/2,r,nr+1-r]//N;
cd = If[c < nc/2,c,nc+1-c]//N;
Append[pixel,Min[1,Min[rd,cd]/d]]
],{r,1,nr},{c,1,nc}],ColorSpace->RGBColor]
];
FeatherEdge[fallsImage, 10]

LCKS Banner

Lofting Examples

HiRes[Grid[Partition[(With[{contours = Table[Table[{Cos[b]Cos[a+#4 b],Cos[b]Sin[a+#4 b],#3 Sin[b]},{a,0,2π,2π/#2}],{b,0,π/2,π/2/(#1-1)}]//N},
Graphics3D[Loft[contours],Boxed->False,ViewPoint->{-1,1,1},ImageSize->133]
]&@@#)&/@{
{2,3,1,0},{2,24,1,0},{24,3,1,0},
{12,24,1,0},{6,24,1,1},{24,48,1,1},
{3,24,1,0},{3,24,1,2},{3,6,1,2},
{6,48,5,1},{24,3,5,2},{24,24,5,2}
},3],Spacings->{0,{0,0,0,-1}}]]

Lofted Gherkin

HiRes[With[{contours = Table[Table[{Cos[b]Cos[a+#4 b],Cos[b]Sin[a+#4 b],#3 Sin[b]},{a,0,2π,2π/#2}],{b,0,π/2,π/2/(#1-1)}]//N},
Graphics3D[Loft[contours],Boxed->False,ViewPoint->{-1,1,1},ImageSize->370]
]&@@{24,24,5,2}
]

Astana National Library

//CenterFigure

//CenterFigure

Gherkin Variations

CellPrint[CenterFigure[#]]&/@{HiRes@Module[{a=0.134`,f=3,ph=0,tw=-2.5132741228718345`},gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]}],
HiRes@Module[{a=0.28200000000000003`,f=2,ph=0,tw=8.595397500221672`},Show[gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]},ImageSize->263]],
HiRes@Module[{a=0.056`,f=11,ph=0,tw=-9.198583289710914`},gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]}],
HiRes@Module[{a=0.028`,f=18,ph=0,tw=3.6191147369354413`},gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]}],
HiRes@Module[{a=0.62`,f=2,ph=0,tw=3.6191147369354413`},Show[gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]},ImageSize->301,Method->{"RotationControl"->"Globe"},ViewPoint->{3.12941816044619,-1.2242478742216718`,0.3974407119725954},ViewVertical->{0.,0.,1.}]],
HiRes@Module[{a=0.23`,f=2,ph=0,tw=0},gherkinModel/.{GraphicsComplex[pts$_,objs$_]:>GraphicsComplex[(With[{r=1+a Sin[f (ArcTan[#1[[1]],#1[[2]]+0.001`]+tw #1[[3]]+ph)]},{r,r,1} #1]&)/@pts$,objs$]}]};

Simplified Gallery Graphic

simplifiedGalleryModel=With[{contours = Module[{w=1,l=.75,pts,p1,p2,nf=160},
pts=Join[
Table[{-w/2 + i w/4, -l/2,0},{i,0,3}],
Table[{w/2,-l/2 + i l/3,0},{i,0,2}],
Table[{w/2 - i w/4, l/2,0},{i,0,3}],
Table[{-w/2,l/2 - i l/3,0},{i,0,2}]
]//N;
p1=Flatten[Transpose[{pts,pts}],1];
p2=With[{pts2 = (pts + RotateLeft[pts])/2.},RotateRight[Flatten[Transpose[{pts2,pts2}],1]]];

Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@With[{f=4-Abs[4-Mod[d,8]]},p1 + (p2-p1)(f/4)],{d,0,nf}]
],

floorPts1 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{-w/2,-l/2,0},{-w/2,l/2,0}}),{d,0,nf}]
],

floorPts2 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{w/2,-l/2,0},{w/2,l/2,0}}),{d,0,nf}]
]},
Graphics3D[{
{EdgeForm[None],(*Swatch,*)GrayLevel[1],Glow[GrayLevel[.2]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts1,RotateLeft[Reverse/@floorPts1]}],-1]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts2,RotateLeft[Reverse/@floorPts2]}],-1]]
},
Build[contours,{
(*{Swatch,Specularity[White,50],Opacity[.25],EdgeForm[None],Polygon[{{0,0},{0,1},{1,1},{1,0}}]},*)
{EdgeForm[None],Tube[{0,1},.01],Tube[{1,0},.01,4]}
(*{White,Line[{0,1}],Line[{1,0},4]}*)
}]
},Boxed->False,PlotRange->All,Lighting->{{"Directional",RGBColor[1,1,1],ImageScaled[{-1,1,1}]}},ImageSize->400,ViewAngle->46°,
ViewVector->{3{1,1,1},{0,0,0}},ViewVertical->{-0.3240527721923405,2.820223505984313,-0.07008831244768246},Background->Black]];

CellPrint[CenterFigure[Show[simplifiedGalleryModel,ImageSize->600]]]

Gallery Model With Starfield

galleryModel=With[{contours = Module[{w=1,l=.75,pts,p1,p2,nf=160},
pts=Join[
Table[{-w/2 + i w/4, -l/2,0},{i,0,3}],
Table[{w/2,-l/2 + i l/3,0},{i,0,2}],
Table[{w/2 - i w/4, l/2,0},{i,0,3}],
Table[{-w/2,l/2 - i l/3,0},{i,0,2}]
]//N;
p1=Flatten[Transpose[{pts,pts}],1];
p2=With[{pts2 = (pts + RotateLeft[pts])/2.},RotateRight[Flatten[Transpose[{pts2,pts2}],1]]];

Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@With[{f=4-Abs[4-Mod[d,8]]},p1 + (p2-p1)(f/4)],{d,0,nf}]
],

floorPts1 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{-w/2,-l/2,0},{-w/2,l/2,0}}),{d,0,nf}]
],

floorPts2 = Module[{w=1,l=.75,pts,p1,p2,nf=160},
Table[Composition[
RotationTransform[(d/nf)2π,{0,1,0}],TranslationTransform[{1.25,0,0}],
RotationTransform[(d/nf)π,{0,0,1}]
]/@(.9{{w/2,-l/2,0},{w/2,l/2,0}}),{d,0,nf}]
]},
Graphics3D[{
{EdgeForm[None],(*Swatch,*)GrayLevel[1],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts1,RotateLeft[Reverse/@floorPts1]}],-1]],
Polygon[Drop[Flatten[#,1]& /@ Transpose[{floorPts2,RotateLeft[Reverse/@floorPts2]}],-1]]
},
Build[contours,{
{Swatch,Specularity[White,50],Opacity[.25],EdgeForm[None],Polygon[{{0,0},{0,1},{1,1},{1,0}}]},
{EdgeForm[None],Tube[{0,1},.01],Tube[{1,0},.01,4]}
}],
Table[{GrayLevel[RandomReal[]],PointSize[RandomReal[{0,.007}]],Point[With[{a=RandomReal[{0,2π}],b=RandomReal[{0,π}],d=5},d{ Sin[b]Cos[a],Cos[b],Sin[b]Sin[a]}]]},{2000}]
},Boxed->False,PlotRange->All,Lighting->{{"Directional",RGBColor[1,1,1],ImageScaled[{-1,1,1}]}},ImageSize->400,ViewAngle->46°,
ViewVector->{3{1,1,1},{0,0,0}},ViewVertical->{-0.3240527721923405,2.820223505984313,-0.07008831244768246},Background->Black]];

CellPrint[CenterFigure[Show[galleryModel,ImageSize->600]]]

Gallery Interior View

Evaluate initialization cells in BuildingBlogFigures.nb.  
Evaluate the initialization cells in this notebook.  
Then evaluate the following:

mandrillImage = ExampleData[{"TestImage","Mandrill"}];

artwork1 = GraphicsComplex[{{0,.7,0},{1,.7,0},{1,1.7,0},{0,1.7,0}},
{Texture[ImageTake[mandrillImage,{1,128},128+{1,128}]],Polygon[{1,2,3,4},VertexTextureCoordinates->2{{0,0},{.5,0},{.5,.5},{0,.5}}]}
];

artwork2 = GraphicsComplex[{{0,.7,0},{1,.7,0},{1,1.7,0},{0,1.7,0}},
{Texture[ImageRotate[ImageEffect[ImageTake[mandrillImage,128+{1,128},128+{1,128}],"Solarization"]]],Polygon[{1,2,3,4},VertexTextureCoordinates->2{{0,0},{.5,0},{.5,.5},{0,.5}}]}
];

artwork3 = GraphicsComplex[{{0,.7,0},{1,.7,0},{1,1.7,0},{0,1.7,0}},
{Texture[ImageRotate[ImageTake[mandrillImage,256+32+{1,128},128+64+32+{1,128}]]],Polygon[{1,2,3,4},VertexTextureCoordinates->2{{0,0},{.5,0},{.5,.5},{0,.5}}]}
];

CellPrint[CenterFigure[#]]& @Module[{
figures = GraphicsComplex[#[[1]],Polygon[#[[2,1,-1]]]]& /@ {womanFigure3,womanFigure4,womanFigure5,manFigure1,manFigure2,manFigure3,childFigure1},
sizes = {0.7`,0.71`,1,0.97`,1,1,0.41`},
rots = {0,0,0,0.7037167544041136`,0,0,0},
hPoss = {-0.47`,0,0,0.49`,0,0,-0.35},
lPoss = {0.35`,0.89`,0,0.4`,0,0,0.893`}
},
Module[{at=2.4`,a=1.13`,bt=-0.04318530717958602`,b=-0.1131853071795863`,d=1.58`,hPos=0.43500000000000005`,i=4,lPos=0.4`,rot=0.6660176425610361`,size=1.`,va=1.72`,vv=-1.1`},With[{model$=Insert[galleryModel,{EdgeForm[GrayLevel[.2]],GrayLevel[.3],Lighting->"Neutral",{
Table[positionFigure[figures[[i]],{1,0.75`,1.25`},sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]],{i,1,7}],
EdgeForm[None],
positionFigure[artwork2,{1,0.75`,1.25`},.7,π/2,.9,.88],
positionFigure[artwork1,{1,0.75`,1.25`},.7,π/2,.9,.82],
positionFigure[artwork3,{1,0.75`,1.25`},.7,π/2,.9,.76]
}},{1,-1}]},If[i===i,{sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]}={size,rot,hPos,lPos},{size,rot,hPos,lPos}={sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]}];With[{v1$=d {Cos[b] Cos[a],Sin[b],Cos[b] Sin[a]},v2$=0.5` {Cos[bt] Cos[a+at],Sin[bt],Cos[bt] Sin[a+at]}},Show[model$,ViewVector->Dynamic[{v1$,v1$+v2$}],ViewAngle->va,ViewVertical->RotationTransform[-(a/2)-vv,v2$-v1$][{0,1,0}],ImageSize->600]]]]
]

Gallery Exterior View

CellPrint[CenterFigure[#]]& @Module[{
figures = GraphicsComplex[#[[1]],Polygon[#[[2,1,-1]]]]& /@ {womanFigure3,womanFigure4,womanFigure5,manFigure1,manFigure2,manFigure3,childFigure1},
sizes = {0.7`,0.71`,1,0.97`,1,1,0.41`},
rots = {0,0,0,0.7037167544041136`,0,0,0},
hPoss = {-0.47`,0,0,0.49`,0,0,-0.3`},
lPoss = {0.35`,0.89`,0,0.4`,0,0,0.893`}
},
Module[{at=2.4`,a=1.13`,bt=-0.04318530717958602`,b=-0.1131853071795863`,d=1.58`,hPos=0.43500000000000005`,i=4,lPos=0.4`,rot=0.6660176425610361`,size=1.`,va=1.72`,vv=-1.1`},With[{model$=Insert[galleryModel,{EdgeForm[None],GrayLevel[0],Lighting->"Neutral",{
Table[positionFigure[figures[[i]],{1,0.75`,1.25`},sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]],{i,1,7}],
EdgeForm[None],
positionFigure[artwork2,{1,0.75`,1.25`},.7,π/2,.9,.88],
positionFigure[artwork1,{1,0.75`,1.25`},.7,π/2,.9,.82],
positionFigure[artwork3,{1,0.75`,1.25`},.7,π/2,.9,.76]
}},{1,-1}]},If[i===i,{sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]}={size,rot,hPos,lPos},{size,rot,hPos,lPos}={sizes[[i]],rots[[i]],hPoss[[i]],lPoss[[i]]}];i=i;With[{v1$=d {Cos[b] Cos[a],Sin[b],Cos[b] Sin[a]},v2$=0.5` {Cos[bt] Cos[a+at],Sin[bt],Cos[bt] Sin[a+at]}},Show[model$,ViewAngle->NCache[46 Degree,0.8028514559173916],ViewPoint->{0.30596220000888524`,0.3331383957290092,0.20964556937812015`},ViewVector->{{3.1913666128082774`,3.4701901423662074`,2.184706313813521},{0.,0.,0.}},ViewVertical->{-0.18010028016903065`,0.976980758246,-0.11486769882422651`},ImageSize->600]]]]
]

Fly-Through Manipulate

CellPrint[CenterFigure[#]]& @ Manipulate[
Module[{
vv= -RotationTransform[-a °,{0,1,0}][RotationTransform[-a °/2,{0,0,1}][{1,0,0}]],
vd=RotationTransform[-a °,{0,1,0}][{0,0,1}],
pos=r{Cos[a °],0,Sin[a °]}},
vd = RotationTransform[-sa °,vv][vd];
Row[{
Show[Insert[simplifiedGalleryModel,{
{Red,Sphere[pos,.05]},
{Green,Arrow[{pos,pos+vd}]},
{Blue,Arrow[{pos,pos+vv}]}
},
{1,-1}],ImageSize->360],
Show[simplifiedGalleryModel,
ViewVector->{pos,pos+vd},
ViewVertical->vv,
ViewAngle->va °,ImageSize->360
]}]],
{{a,0,"angular position"},0,2 360,Appearance->"Labeled"},
{{r,1.25,"radial position"},0,2,Appearance->"Labeled"},
{{sa,0,"view direction"},-180,180},
{{va,98,"view angle"},0,180,Appearance->"Labeled"}
]