[unix-history] / usr / othersrc / public / ghostscript-2.4.1 / escher.ps

%!
% If you're concerned that the cpu in your PostScript printer will atrophy
% from disuse, here is another Escher-like contribution to to keep it busy
% for a while.  It uses PostScript color commands, but will still work on
% a monochrome printer (but isn't very pretty in black & white).
% 
% The butterflies are arranged in a hexagonal grid (wallpaper group p6),
% and the moveto, lineto, curveto commands used to render the tesselation
% are redefined so as to impose a nonlinear transform that shrinks the
% infinite plane to an ellipse.  This is a sleazy way to mimic Escher's
% "circle limit" sorts of things. 
%
% The butterfly permimeter was made by imposing all the symmetry constraints
% on a path, and then that path was filled in using Adobe Illustrator
%
% The routines Xform and next_color are easy to change if you want to hack
% with them. The code was written to sacrifice efficiency for readability.
%
% Bob Wallis
%
% UUCP {sun,pyramid,cae780,apple}!weitek!wallis

%statusdict begin waittimeout 6000 lt	% if you have a slow printer, you
%   {0 60 6000 setdefaulttimeouts}	% might need to uncomment this
%if end

/nlayers 1 def		% 1 takes about 10 minutes on a LW+; 2 takes 4x longer
/warp 1 def		% 1 -> ellipsoidal distortion; 0 -> flat Euclidean
/inch {72 mul} def 

/x4 152 def /y4 205.6 def		% 6 fold rotation center of bfly
/x12 387.20 def /y12 403.84 def		% 3 fold center of bfly

/dx x4 x12 sub def			% [dx,dy] = distance between the
/dy y4 y12 sub def			% two fixed points above

/Dm dx dup mul  dy dup mul 		% magnitude of basis vectors of
    add sqrt 3 sqrt mul 		% parallelogram lattice
def					% = |dx,dy| * sqrt(3)

/Da dy dx atan 30 add def
/D1x Dm Da cos mul def			% [D1x, D1y] = basis vector vector #1
/D1y Dm Da sin mul def			% = [Dm,0] exp(j30)

/Da dy dx atan 30 sub def
/D2x Dm Da cos mul def			% [D2x, D2y] = basis vector vector #2
/D2y Dm Da sin mul def			% = [Dm,0] exp(-j30)
 
/m { moveto} def
/L {lineto} def
/S {stroke} def
/c {curveto} def
/f {closepath fill} def
/F {closepath fill} def
/g { setgray} def

/FillStroke {				% fill interior & stroke black border
	closepath gsave fill grestore 0 setgray stroke
} def

%
% Description of 1 butterfly
%
/body {
	314.96 280.19 m
	383.4 261.71 445.11 243.23 513.52 224.68 c
	463.68 256.59 490.26 328.83 446.99 360.76 c
	423.71 347.32 397.08 339.7 367.07 337.9 c
	388.93 358.28 414.14 372.84 442.73 381.58 c
	426.68 398.18 394.07 389.7 387.2 403.84 c
	371.52 404.96 362.56 372.48 340.16 366.88 c
	346.88 396.01 346.88 425.12 340.16 454.24 c
	326.72 427.35 320 400.48 320 373.6 c
	270.71 352.1 221.44 411.23 168.88 384.02 c
	189.04 388.03 202.48 380.4 212.57 366.95 c
	216.72 350.85 209.23 341.46 190.1 338.79 c
	177.34 343.57 167.94 354.17 161.9 370.59 c
	176.06 305.52 132.02 274.05 152 205.6 c
	201.29 257.12 250.56 234.72 299.84 279.52 c
	288.64 266.08 284.16 252.64 286.4 239.2 c
	298.27 223.97 310.15 222.18 322.02 233.82 c
	328.62 249.28 328.51 264.74 314.96 280.19 c
	FillStroke
} def

/eyes {
	294.8125 238.3246 m
	296.9115 238.3246 298.6132 242.7964 298.6132 248.3125 c
	298.6132 253.8286 296.9115 258.3004 294.8125 258.3004 c
	292.7135 258.3004 291.0118 253.8286 291.0118 248.3125 c
	291.0118 242.7964 292.7135 238.3246 294.8125 238.3246 c
	closepath gsave 1 g fill grestore 0 g S
	
	319.5 241.1782 m
	321.7455 241.1782 323.5659 245.4917 323.5659 250.8125 c
	323.5659 256.1333 321.7455 260.4468 319.5 260.4468 c
	317.2545 260.4468 315.4341 256.1333 315.4341 250.8125 c
	315.4341 245.4917 317.2545 241.1782 319.5 241.1782 c
	closepath gsave 1 g fill grestore 0 g S
	0 g
	296.875 242.0939 m
	297.4608 242.0939 297.9356 243.479 297.9356 245.1875 c
	297.9356 246.896 297.4608 248.2811 296.875 248.2811 c
	296.2892 248.2811 295.8143 246.896 295.8143 245.1875 c
	295.8143 243.479 296.2892 242.0939 296.875 242.0939 c
	f
	0 g
	318.5 243.7707 m
	319.281 243.7707 319.9142 245.0766 319.9142 246.6875 c
	319.9142 248.2984 319.281 249.6043 318.5 249.6043 c
	317.719 249.6043 317.0858 248.2984 317.0858 246.6875 c
	317.0858 245.0766 317.719 243.7707 318.5 243.7707 c
	f
} def	

/stripes {
	292 289 m
	252 294 241 295 213 279 c
	185 263 175 252 159 222 c
	S
	285 313 m
	239 326 226 325 206 315 c
	186 305 164 278 161 267 c
	S
	298 353 m
	262 342 251 339 237 355 c
	223 371 213 380 201 383 c
	S
	330 288 m
	384 293 385 292 418 280 c
	451 268 452 264 473 247 c
	S
	342 306 m
	381 311 386 317 410 311 c
	434 305 460 287 474 262 c
	S
	345 321 m
	352 357 359 367 379 377 c
	399 387 409 385 426 382 c
	S
	327.75 367.75 m
	336.5 392.25 333.682 403.348 335.25 415.5 c
	S
	320 364.75 m
	322 361.75 323.5 360.5 326.25 360 c
	329 359.5 332 360.5 334 362.75 c
	S
	316.25 356.5 m
	318.75 353.25 320 353 323.25 352.25 c
	326.5 351.5 329 352 331.5 353.25 c
	S
	312.5 349 m
	316.75 345.5 318.25 344.5 321.25 343.75 c
	324.25 343 327 344 329.75 346 c
	S
	310.75 340.75 m
	314.25 336.5 316.25 335.25 320 335.25 c
	323.75 335.25 327 336.5 329.25 338 c
	S
	308.5 332 m
	311.75 328.5 312.5 327.25 317 327 c
	321.5 326.75 325.75 328.25 327.75 329.75 c
	S
	305 322 m
	309.5 317.75 310.75 317 315 316.5 c
	319.25 316 322.25 318 324.75 320 c
	S
	302.25 311 m
	307 307.5 307.75 306.25 312.75 306 c
	317.75 305.75 320 307.25 323.75 309.5 c
	S
	301.25 298.25 m
	304.5 292.75 305.25 292 308.25 292 c
	311.25 292 313.75 293.75 315.75 295.75 c
	S
} def
/nostrils {
	0 g
	304.062 227.775 m
	304.599 227.775 305.034 228.883 305.034 230.25 c
	305.034 231.616 304.599 232.724 304.062 232.724 c
	303.525 232.724 303.09 231.616 303.09 230.25 c
	303.09 228.883 303.525 227.775 304.062 227.775 c
	f
	304.062 230.25 m
	F
	309.562 228.275 m
	310.099 228.275 310.534 229.383 310.534 230.75 c
	310.534 232.116 310.099 233.224 309.562 233.224 c
	309.025 233.224 308.59 232.116 308.59 230.75 c
	308.59 229.383 309.025 228.275 309.562 228.275 c
	f
} def
/thorax
{
	327.5 300 m
	316.5 283 315.5 275.5 308 277.5 c
	294 311.5 299 313.5 304 334 c
	309 354.5 315.5 362 322.5 372 c
	329.5 382 327.5 376.5 331 376 c
	334.5 375.5 339.1367 379.1109 339 369 c
	338.5 332 333.4999 324.5 330.5 311.5 c
	0 g S
} def
/spots {
	next_color
	192 242.201 m
	202.1535 242.201 210.3848 251.0655 210.3848 262 c
	210.3848 272.9345 202.1535 281.799 192 281.799 c
	181.8465 281.799 173.6152 272.9345 173.6152 262 c
	173.6152 251.0655 181.8465 242.201 192 242.201 c
	FillStroke
	next_color
	447.5 250.2365 m
	459.6061 250.2365 469.4203 257.5181 469.4203 266.5 c
	469.4203 275.4819 459.6061 282.7635 447.5 282.7635 c
	435.3939 282.7635 425.5797 275.4819 425.5797 266.5 c
	425.5797 257.5181 435.3939 250.2365 447.5 250.2365 c
	FillStroke
	next_color
	401 369.1005 m
	409.5914 369.1005 416.5563 373.5327 416.5563 379 c
	416.5563 384.4673 409.5914 388.8995 401 388.8995 c
	392.4086 388.8995 385.4436 384.4673 385.4436 379 c
	385.4436 373.5327 392.4086 369.1005 401 369.1005 c
	FillStroke
	next_color
	249 348.2721 m
	261.4966 348.2721 271.6274 353.9707 271.6274 361 c
	271.6274 368.0293 261.4966 373.7279 249 373.7279 c
	236.5034 373.7279 226.3726 368.0293 226.3726 361 c
	226.3726 353.9707 236.5034 348.2721 249 348.2721 c
	FillStroke
} def				

/ncolor 6 def
/cidx 0 def

/next_color {
	cidx ncolor div		% hue
	.75			% saturation (change these if you like)
	.8			% lightness
	sethsbcolor
	/cidx cidx 1 add ncolor mod def
} def

/cidx 0 def

/max_r2 	 	% radius^2 for center of outermost ring of butterflies
 Dm nlayers mul 1.05 mul dup mul 
def

/max_radius max_r2 sqrt def
/max_radius_inv 1 max_radius div def
/Dm_inv 1 Dm div def

%
% Ellipsoidal distortion, maps "nlayers" concentric rings of cells into
% an ellipse centered on page

% D  			length of 1 basis vector separating hexagonal cells
% z0			center of 6-fold rotation = origin of shrink xform
% z' = (z - z0)/D 				new coord system
% |z'| = sqrt(x^2 + [(8.5/11)*y]^2)		aspect ratio of paper
% z" = z' * a/M(|z'|)	shrink by "a/M(|z|)" 	as fcn of radius

% At the max radius, we want the shrunk ellipse to be "W" units wide so it
% just fits our output format - solve for scale factor "a"

% zmax = n+0.5  		for n layers of cells
% zmax * [a/M(zmax)] = W	1/2 width of output on paper
% a = M(zmax)*W/zmax		solve for "a"

%/M{dup mul 1 add sqrt}bind def	% M(u) = sqrt(1+|u|^2) = one possible shrink
/M { 1.5 add } bind def		% M(u) = (1.5+|u|)     = another possible one
/W 3.8 inch def 		% 1/2 width of ellipse
/zmax 0.5 nlayers add def	% radius at last layer of hexagons
/a zmax M W mul zmax div def	% a = M(zmax)*W/zmax

/Xform {						% [x0,y0] = ctr ellipse
	Matrix transform
	/y exch def
	/x exch def
	/z x dup mul y .773 mul dup mul add sqrt def	% ellipse radius
	/Scale a z M div def				% z=a/M(|z|)
	x Scale mul x0 add 				% magnify back up
	y Scale mul y0 add 				% [x0+x*s, y0+y*s]
} def


/Helvetica findfont 8 scalefont setfont 
4.25 inch 0.5 inch moveto 
(RHW) stringwidth pop -0.5 mul 0 rmoveto
(RHW) show				% autograph

warp 1 eq {				% redefine commands to use Xform
	/moveto { Xform //moveto} def
	/lineto { Xform //lineto} def
	/curveto { 
		Xform 6 -2 roll
		Xform 6 -2 roll
		Xform 6 -2 roll
		//curveto 
	} def
}if


/bfly {				% paint 1 butterfly
	next_color body
	1 setgray eyes
	stripes
	0 setgray nostrils
	0.5 setgray thorax next_color
	spots
}  def

/x0 x4 def		% center
/y0 y4 def

/T1matrix 			% xlate to center of image
  x0 neg  y0 neg  matrix translate 
def

/Smatrix 			% scale so that 1 basis vector = 1.0
  Dm_inv dup matrix scale 
def

/HexCell {			% 6 butterflys rotated about center of
	/cidx 0 def		% 6 fold symmetry
	/color 0 def
	/T2matrix dx dy matrix translate def
	0 60 300 {
		/angle exch def
		/Rmatrix angle matrix rotate def
		/Matrix 	% translate, rotate, scale - used by Xform
		  T1matrix Rmatrix matrix concatmatrix
		  T2matrix matrix concatmatrix 
		  Smatrix matrix concatmatrix 
		def
		gsave 
		warp 0 eq 	% then may use usual PostScript machinery
		{		% else using Xform
			x0 y0 translate angle rotate 
			.5 dup scale
			dx x0 sub dy y0 sub translate
		} if		
		bfly 
		next_color
		grestore
	} for
} def


%320 x4 sub 240 y4 sub translate 
4.25 inch x4 sub 5.5 inch y4 sub translate


0 setlinewidth
/N 2 def
N neg 1 N {
	/i exch def					% translate to
	N neg 1 N {					% i*D1 + j*D2
		/j exch def				% and draw HexCell
		gsave
		/dx i D1x mul j D2x mul add def		% translate HexCell by
		/dy i D1y mul j D2y mul add def		% [dx,dy]
		/r2 dx dup mul dy dup mul add def	% r^2 = |dx,dy|^2
		r2 max_r2 lt				% inside radius?
		{ 					% yes
		1 r2 max_r2 div sub sqrt 2 div 
		setlinewidth				% make skinnier lines
		HexCell					% 6 butterflies
		}
		if
		grestore
	} for
} for

showpage
Commit	Line	Data
a205ed30 WJ	1	%!
	2	% If you're concerned that the cpu in your PostScript printer will atrophy
	3	% from disuse, here is another Escher-like contribution to to keep it busy
	4	% for a while. It uses PostScript color commands, but will still work on
	5	% a monochrome printer (but isn't very pretty in black & white).
	6	%
	7	% The butterflies are arranged in a hexagonal grid (wallpaper group p6),
	8	% and the moveto, lineto, curveto commands used to render the tesselation
	9	% are redefined so as to impose a nonlinear transform that shrinks the
	10	% infinite plane to an ellipse. This is a sleazy way to mimic Escher's
	11	% "circle limit" sorts of things.
	12	%
	13	% The butterfly permimeter was made by imposing all the symmetry constraints
	14	% on a path, and then that path was filled in using Adobe Illustrator
	15	%
	16	% The routines Xform and next_color are easy to change if you want to hack
	17	% with them. The code was written to sacrifice efficiency for readability.
	18	%
	19	% Bob Wallis
	20	%
	21	% UUCP {sun,pyramid,cae780,apple}!weitek!wallis
	22
	23	%statusdict begin waittimeout 6000 lt % if you have a slow printer, you
	24	% {0 60 6000 setdefaulttimeouts} % might need to uncomment this
	25	%if end
	26
	27	/nlayers 1 def % 1 takes about 10 minutes on a LW+; 2 takes 4x longer
	28	/warp 1 def % 1 -> ellipsoidal distortion; 0 -> flat Euclidean
	29	/inch {72 mul} def
	30
	31	/x4 152 def /y4 205.6 def % 6 fold rotation center of bfly
	32	/x12 387.20 def /y12 403.84 def % 3 fold center of bfly
	33
	34	/dx x4 x12 sub def % [dx,dy] = distance between the
	35	/dy y4 y12 sub def % two fixed points above
	36
	37	/Dm dx dup mul dy dup mul % magnitude of basis vectors of
	38	add sqrt 3 sqrt mul % parallelogram lattice
	39	def % = \|dx,dy\| * sqrt(3)
	40
	41	/Da dy dx atan 30 add def
	42	/D1x Dm Da cos mul def % [D1x, D1y] = basis vector vector #1
	43	/D1y Dm Da sin mul def % = [Dm,0] exp(j30)
	44
	45	/Da dy dx atan 30 sub def
	46	/D2x Dm Da cos mul def % [D2x, D2y] = basis vector vector #2
	47	/D2y Dm Da sin mul def % = [Dm,0] exp(-j30)
	48
	49	/m { moveto} def
	50	/L {lineto} def
	51	/S {stroke} def
	52	/c {curveto} def
	53	/f {closepath fill} def
	54	/F {closepath fill} def
	55	/g { setgray} def
	56
	57	/FillStroke { % fill interior & stroke black border
	58	closepath gsave fill grestore 0 setgray stroke
	59	} def
	60
	61	%
	62	% Description of 1 butterfly
	63	%
	64	/body {
65	314.96 280.19 m
66	383.4 261.71 445.11 243.23 513.52 224.68 c
67	463.68 256.59 490.26 328.83 446.99 360.76 c
68	423.71 347.32 397.08 339.7 367.07 337.9 c
69	388.93 358.28 414.14 372.84 442.73 381.58 c
70	426.68 398.18 394.07 389.7 387.2 403.84 c
71	371.52 404.96 362.56 372.48 340.16 366.88 c
72	346.88 396.01 346.88 425.12 340.16 454.24 c
73	326.72 427.35 320 400.48 320 373.6 c
74	270.71 352.1 221.44 411.23 168.88 384.02 c
75	189.04 388.03 202.48 380.4 212.57 366.95 c
76	216.72 350.85 209.23 341.46 190.1 338.79 c
77	177.34 343.57 167.94 354.17 161.9 370.59 c
78	176.06 305.52 132.02 274.05 152 205.6 c
79	201.29 257.12 250.56 234.72 299.84 279.52 c
80	288.64 266.08 284.16 252.64 286.4 239.2 c
81	298.27 223.97 310.15 222.18 322.02 233.82 c
82	328.62 249.28 328.51 264.74 314.96 280.19 c
83	FillStroke
84	} def
85
86	/eyes {
87	294.8125 238.3246 m
88	296.9115 238.3246 298.6132 242.7964 298.6132 248.3125 c
89	298.6132 253.8286 296.9115 258.3004 294.8125 258.3004 c
90	292.7135 258.3004 291.0118 253.8286 291.0118 248.3125 c
91	291.0118 242.7964 292.7135 238.3246 294.8125 238.3246 c
92	closepath gsave 1 g fill grestore 0 g S
93
94	319.5 241.1782 m
95	321.7455 241.1782 323.5659 245.4917 323.5659 250.8125 c
96	323.5659 256.1333 321.7455 260.4468 319.5 260.4468 c
97	317.2545 260.4468 315.4341 256.1333 315.4341 250.8125 c
98	315.4341 245.4917 317.2545 241.1782 319.5 241.1782 c
99	closepath gsave 1 g fill grestore 0 g S
100	0 g
101	296.875 242.0939 m
102	297.4608 242.0939 297.9356 243.479 297.9356 245.1875 c
103	297.9356 246.896 297.4608 248.2811 296.875 248.2811 c
104	296.2892 248.2811 295.8143 246.896 295.8143 245.1875 c
105	295.8143 243.479 296.2892 242.0939 296.875 242.0939 c
106	f
107	0 g
108	318.5 243.7707 m
109	319.281 243.7707 319.9142 245.0766 319.9142 246.6875 c
110	319.9142 248.2984 319.281 249.6043 318.5 249.6043 c
111	317.719 249.6043 317.0858 248.2984 317.0858 246.6875 c
112	317.0858 245.0766 317.719 243.7707 318.5 243.7707 c
113	f
114	} def
115
116	/stripes {
117	292 289 m
118	252 294 241 295 213 279 c
119	185 263 175 252 159 222 c
120	S
121	285 313 m
122	239 326 226 325 206 315 c
123	186 305 164 278 161 267 c
124	S
125	298 353 m
126	262 342 251 339 237 355 c
127	223 371 213 380 201 383 c
128	S
129	330 288 m
130	384 293 385 292 418 280 c
131	451 268 452 264 473 247 c
132	S
133	342 306 m
134	381 311 386 317 410 311 c
135	434 305 460 287 474 262 c
136	S
137	345 321 m
138	352 357 359 367 379 377 c
139	399 387 409 385 426 382 c
140	S
141	327.75 367.75 m
142	336.5 392.25 333.682 403.348 335.25 415.5 c
143	S
144	320 364.75 m
145	322 361.75 323.5 360.5 326.25 360 c
146	329 359.5 332 360.5 334 362.75 c
147	S
148	316.25 356.5 m
149	318.75 353.25 320 353 323.25 352.25 c
150	326.5 351.5 329 352 331.5 353.25 c
151	S
152	312.5 349 m
153	316.75 345.5 318.25 344.5 321.25 343.75 c
154	324.25 343 327 344 329.75 346 c
155	S
156	310.75 340.75 m
157	314.25 336.5 316.25 335.25 320 335.25 c
158	323.75 335.25 327 336.5 329.25 338 c
159	S
160	308.5 332 m
161	311.75 328.5 312.5 327.25 317 327 c
162	321.5 326.75 325.75 328.25 327.75 329.75 c
163	S
164	305 322 m
165	309.5 317.75 310.75 317 315 316.5 c
166	319.25 316 322.25 318 324.75 320 c
167	S
168	302.25 311 m
169	307 307.5 307.75 306.25 312.75 306 c
170	317.75 305.75 320 307.25 323.75 309.5 c
171	S
172	301.25 298.25 m
173	304.5 292.75 305.25 292 308.25 292 c
174	311.25 292 313.75 293.75 315.75 295.75 c
175	S
176	} def
177	/nostrils {
178	0 g
179	304.062 227.775 m
180	304.599 227.775 305.034 228.883 305.034 230.25 c
181	305.034 231.616 304.599 232.724 304.062 232.724 c
182	303.525 232.724 303.09 231.616 303.09 230.25 c
183	303.09 228.883 303.525 227.775 304.062 227.775 c
184	f
185	304.062 230.25 m
186	F
187	309.562 228.275 m
188	310.099 228.275 310.534 229.383 310.534 230.75 c
189	310.534 232.116 310.099 233.224 309.562 233.224 c
190	309.025 233.224 308.59 232.116 308.59 230.75 c
191	308.59 229.383 309.025 228.275 309.562 228.275 c
192	f
193	} def
194	/thorax
195	{
196	327.5 300 m
197	316.5 283 315.5 275.5 308 277.5 c
198	294 311.5 299 313.5 304 334 c
199	309 354.5 315.5 362 322.5 372 c
200	329.5 382 327.5 376.5 331 376 c
201	334.5 375.5 339.1367 379.1109 339 369 c
202	338.5 332 333.4999 324.5 330.5 311.5 c
203	0 g S
204	} def
205	/spots {
206	next_color
207	192 242.201 m
208	202.1535 242.201 210.3848 251.0655 210.3848 262 c
209	210.3848 272.9345 202.1535 281.799 192 281.799 c
210	181.8465 281.799 173.6152 272.9345 173.6152 262 c
211	173.6152 251.0655 181.8465 242.201 192 242.201 c
212	FillStroke
213	next_color
214	447.5 250.2365 m
215	459.6061 250.2365 469.4203 257.5181 469.4203 266.5 c
216	469.4203 275.4819 459.6061 282.7635 447.5 282.7635 c
217	435.3939 282.7635 425.5797 275.4819 425.5797 266.5 c
218	425.5797 257.5181 435.3939 250.2365 447.5 250.2365 c
219	FillStroke
220	next_color
221	401 369.1005 m
222	409.5914 369.1005 416.5563 373.5327 416.5563 379 c
223	416.5563 384.4673 409.5914 388.8995 401 388.8995 c
224	392.4086 388.8995 385.4436 384.4673 385.4436 379 c
225	385.4436 373.5327 392.4086 369.1005 401 369.1005 c
226	FillStroke
227	next_color
228	249 348.2721 m
229	261.4966 348.2721 271.6274 353.9707 271.6274 361 c
230	271.6274 368.0293 261.4966 373.7279 249 373.7279 c
231	236.5034 373.7279 226.3726 368.0293 226.3726 361 c
232	226.3726 353.9707 236.5034 348.2721 249 348.2721 c
233	FillStroke
234	} def
235
236	/ncolor 6 def
237	/cidx 0 def
238
239	/next_color {
240	cidx ncolor div % hue
241	.75 % saturation (change these if you like)
242	.8 % lightness
243	sethsbcolor
244	/cidx cidx 1 add ncolor mod def
245	} def
246
247	/cidx 0 def
248
249	/max_r2 % radius^2 for center of outermost ring of butterflies
250	Dm nlayers mul 1.05 mul dup mul
251	def
252
253	/max_radius max_r2 sqrt def
254	/max_radius_inv 1 max_radius div def
255	/Dm_inv 1 Dm div def
256
257	%
258	% Ellipsoidal distortion, maps "nlayers" concentric rings of cells into
259	% an ellipse centered on page
260
261	% D length of 1 basis vector separating hexagonal cells
262	% z0 center of 6-fold rotation = origin of shrink xform
263	% z' = (z - z0)/D new coord system
264	% \|z'\| = sqrt(x^2 + [(8.5/11)*y]^2) aspect ratio of paper
265	% z" = z' * a/M(\|z'\|) shrink by "a/M(\|z\|)" as fcn of radius
266
267	% At the max radius, we want the shrunk ellipse to be "W" units wide so it
268	% just fits our output format - solve for scale factor "a"
269
270	% zmax = n+0.5 for n layers of cells
271	% zmax * [a/M(zmax)] = W 1/2 width of output on paper
272	% a = M(zmax)*W/zmax solve for "a"
273
274	%/M{dup mul 1 add sqrt}bind def % M(u) = sqrt(1+\|u\|^2) = one possible shrink
275	/M { 1.5 add } bind def % M(u) = (1.5+\|u\|) = another possible one
276	/W 3.8 inch def % 1/2 width of ellipse
277	/zmax 0.5 nlayers add def % radius at last layer of hexagons
278	/a zmax M W mul zmax div def % a = M(zmax)*W/zmax
279
280	/Xform { % [x0,y0] = ctr ellipse
281	Matrix transform
282	/y exch def
283	/x exch def
284	/z x dup mul y .773 mul dup mul add sqrt def % ellipse radius
285	/Scale a z M div def % z=a/M(\|z\|)
286	x Scale mul x0 add % magnify back up
287	y Scale mul y0 add % [x0+xs, y0+ys]
288	} def
289
290
291	/Helvetica findfont 8 scalefont setfont
292	4.25 inch 0.5 inch moveto
293	(RHW) stringwidth pop -0.5 mul 0 rmoveto
294	(RHW) show % autograph
295
296	warp 1 eq { % redefine commands to use Xform
297	/moveto { Xform //moveto} def
298	/lineto { Xform //lineto} def
299	/curveto {
300	Xform 6 -2 roll
301	Xform 6 -2 roll
302	Xform 6 -2 roll
303	//curveto
304	} def
305	}if
306
307
308	/bfly { % paint 1 butterfly
309	next_color body
310	1 setgray eyes
311	stripes
312	0 setgray nostrils
313	0.5 setgray thorax next_color
314	spots
315	} def
316
317	/x0 x4 def % center
318	/y0 y4 def
319
320	/T1matrix % xlate to center of image
321	x0 neg y0 neg matrix translate
322	def
323
324	/Smatrix % scale so that 1 basis vector = 1.0
325	Dm_inv dup matrix scale
326	def
327
328	/HexCell { % 6 butterflys rotated about center of
329	/cidx 0 def % 6 fold symmetry
330	/color 0 def
331	/T2matrix dx dy matrix translate def
332	0 60 300 {
333	/angle exch def
334	/Rmatrix angle matrix rotate def
335	/Matrix % translate, rotate, scale - used by Xform
336	T1matrix Rmatrix matrix concatmatrix
337	T2matrix matrix concatmatrix
338	Smatrix matrix concatmatrix
339	def
340	gsave
341	warp 0 eq % then may use usual PostScript machinery
342	{ % else using Xform
343	x0 y0 translate angle rotate
344	.5 dup scale
345	dx x0 sub dy y0 sub translate
346	} if
347	bfly
348	next_color
349	grestore
350	} for
351	} def
352
353
354	%320 x4 sub 240 y4 sub translate
355	4.25 inch x4 sub 5.5 inch y4 sub translate
356
357
358	0 setlinewidth
359	/N 2 def
360	N neg 1 N {
361	/i exch def % translate to
362	N neg 1 N { % iD1 + jD2
363	/j exch def % and draw HexCell
364	gsave
365	/dx i D1x mul j D2x mul add def % translate HexCell by
366	/dy i D1y mul j D2y mul add def % [dx,dy]
367	/r2 dx dup mul dy dup mul add def % r^2 = \|dx,dy\|^2
368	r2 max_r2 lt % inside radius?
369	{ % yes
370	1 r2 max_r2 div sub sqrt 2 div
371	setlinewidth % make skinnier lines
372	HexCell % 6 butterflies
373	}
374	if
375	grestore
376	} for
377	} for
378
379	showpage