%!PS-Adobe-1.0
% lego in postscript
% by Andrew Cumming
% Fairly interactive graphics
% 





% goto centre
300 420 translate
% rotate for landscape
90 rotate
% squash y axis
1 0.5 scale
0.5 setlinewidth
% Perspective factor - the less is more
/psp 1000 def

% grey for top surface
/zshade 0.9 def
/yshade 0.7 def
/xshade 0.5 def
% brick size
/bx 20 def
/by 40 def
/bz 20 def
% origin
/x0 0 def
/y0 0 def
/z0 0 def

% Utility function

% Three D to two D transformations

/twoD
% expects x y z on stack, leaves x y 2D on stack
{ 6 dict begin
/z exch def
/y exch def
/x exch def
% calculate perspective factor
/f psp psp x y add z add sub div def
% x coord
y x sub f mul
% y coord
2 z mul x sub y sub f mul
end } def

/tripadd
% adds triple x y z to x1 y1 z2
{ 3 dict begin
/z exch def /y exch def /x exch def
/z exch z add def
/y exch y add def
x add y z
end } def

/quad
% expects a stack transformation and inverse
% expects point of quad and x y diagonal offset
% creates path of quad in z plane
{ 10 dict begin
/tr exch def
/iv exch def
/yo exch def
/xo exch def
tr
/z exch def
/y exch def
/x exch def

newpath
x y z iv
x xo add y z iv
x xo add y yo add z iv
x y yo add z iv
twoD moveto twoD lineto twoD lineto twoD lineto
closepath
end } def

/zquad { {} {} quad } def
/yquad { {3 2 roll} {3 1 roll} quad } def
/xquad { {3 1 roll} {3 2 roll} quad } def

/brick
% expects 3D coords and 3 offsets
% leaves 3D coords updated (move along y axis)
{ 8 dict begin
/zo exch neg def
/yo exch neg def
/xo exch neg def
3 copy
/z exch zo sub def
/y exch yo sub def
/x exch xo sub def
% set up output
exch yo neg add exch	

% set up vertices
x y z xo yo 5 copy
zshade setgray zquad fill 0 setgray zquad stroke
x y z yo zo 5 copy
xshade setgray xquad fill 0 setgray xquad stroke
x y z zo xo 5 copy
yshade setgray yquad fill 0 setgray yquad stroke

end } def

/b { bx by bz brick } def		% full brick
/h { bx by 2 div bz brick } def		% half brick
/q { bx by 4 div bz brick } def		% quarter brick
/m { exch by 2 div add exch } def	% miss half brick
/l { exch pop y0 exch bz add } def	% new line
/w { pop pop bx add y0 z0 } def		% new wall

% ******************Definitions for roof bricks *****************************
/tripPath
% Convert three 3D coords into a triangle path
{ newpath twoD moveto twoD lineto twoD lineto closepath } def
/quadPath
% Convert four 3D coords into a triangle path
{ newpath twoD moveto twoD lineto twoD lineto twoD lineto closepath } def

/down
% down brick
{ 3 copy bx 0 0 tripadd 3 copy 0 0 bz tripadd 3 copy 0 by bz neg tripadd
9 copy tripPath xshade setgray fill
tripPath 0 setgray stroke
3 copy 0 0 bz tripadd 3 copy bx 0 0 tripadd 3 copy 0 by bz neg tripadd
3 copy bx neg 0 0 tripadd
12 copy quadPath zshade yshade add 2 div setgray fill
quadPath 0 setgray stroke
0 by 0 tripadd
} def

/up
% up brick
{3 copy bx 0 0 tripadd 3 copy 0 by 0 tripadd 3 copy 0 0 bz tripadd
9 copy tripPath xshade setgray fill
tripPath 0 setgray stroke
3 copy 3 copy bx 0 0 tripadd 3 copy 0 by bz tripadd
3 copy bx neg 0 0 tripadd
12 copy quadPath zshade yshade add 2 div setgray fill
quadPath 0 setgray stroke
3 copy bx by bz tripadd bz neg bx neg 5 copy
yshade 1 add 2 div setgray yquad fill 0 setgray yquad stroke
0 by 0 tripadd
} def


% ******************Definitions for ball ************************************
/tilt 45 def
/maxgray .15 def
/latitude
{/lat exch def
newpath
0 lat sin r mul lat cos r mul 0 360 arc
lat sin 1 maxgray sub mul maxgray add setgray
fill} def
/ball
{gsave
/r exch def
translate
1 2 scale
gsave
300 rotate
newpath
0 0 r 0 360 arc
closepath
clip
maxgray setgray
fill
1 tilt cos scale
0 2 90 {latitude} for
grestore
newpath
0 0 r 0 360 arc
0 setgray stroke
grestore} def

/s	% sphere
{2 dict begin
% work out radius
3 copy 3 copy
axes pop /z exch def
bx 2 div by 4 div bz 2 div tripadd
twoD z bz 2 div mul
ball
0 by 2 div 0 tripadd
end } def

% ******************Definitions for column **********************************

% Root square sum
/rss
{ dup mul exch dup mul add sqrt } def

% to find the major and minor axes of the elipse which fit the unit square
% at position x y z on stack
% current posn is origin
/axes
{ 8 dict begin
3 copy twoD
/y exch def
/x exch def

3 copy 3 1 roll 1 add 3 2 roll twoD
/y1 exch y sub def
/x1 exch x sub def

exch 1 add exch twoD
/y2 exch y sub def
/x2 exch x sub def

x1 x2 rss
y1 y2 rss
end } def

% flat circle
% draws at x y z a circle radius r in the xy plane
/circle
{ 8 dict begin
gsave
/r exch def
r r 0 tripadd
3 copy
twoD translate
axes scale
newpath
0 0 r 0 360 arc
0 setgray
stroke
grestore
end } def

/getmat
% get the transformation matrix used for drawing a circle at current point
% x y z r
{ 1 dict begin
gsave
/r exch def
r r 0 tripadd
3 copy
twoD translate
axes scale
matrix currentmatrix
grestore
end } def

/slice
% theta delta matl math
{ 4 dict begin
/mh exch def	% hi matrix
/ml exch def	% low matrix
/d exch def
/t exch def
ml setmatrix
newpath
0 0 r t t d add arc
mh setmatrix
0 0 r t d add t arcn
closepath
end } def

% cylinder
/cyl
% draws a column centre x y z height h radius r
{ 6 dict begin
gsave
% constant giving the size of a slice (degrees)
/slicewidth 10 def
/shine 70 def
/r exch def
/h exch def
3 copy r getmat
/ml exch def
0 0 h tripadd r getmat
/mh exch def
% shade column
180 slicewidth 360 {dup shine add cos setgray slicewidth ml mh slice fill} for
% outline front
180 180 ml mh slice 0 setgray stroke
% shade top
mh setmatrix newpath 0 0 r 0 360 arc zshade setgray fill
% outline top
newpath 0 setgray 0 0 r 0 360 arc stroke
grestore
end } def

/c { 3 copy bz by 4 div cyl m } def

% Clear screen
/C {pop pop pop 0 0 0 showpage showpage} def
/.
% Do a lot of pointless processing as ghostview is lazy
{
1 setgray
0 1 500 {pop -419 -299 moveto 0 600 rlineto stroke} for
} def

/o
{ 3 copy /z0 exch store /y0 exch store /x0 exch store } def
% move origin
% .....
% initial coordinates
0 0 0
% xbrick program
-505 -700 -615 o
% You can put your own programs here, for example take the comment
% from the following lines:
% h b b h l
% b b b l
% h b b h l
% b b b