harry@ecrcvax.UUCP (John Pratt) (02/09/88)
Just in case anyone has an idle printer I am posting a close replication of
"Square-limit" by M.C.Escher. I have called it "Square-recursion" because it
builds the image by recursion, following the triangle subdivision used by
Escher.
I have used Postscript graphics to the full, using transformations and curves
freely. However it takes a long time to run as a result. The version posted
has a variable "Maxlevel", which defaults to 0, and takes 2 minutes to
produce a core picture. Try that first, and check that all is well, then
if you wish the full gory detail set Maxlevel to 3, and wait 25 minutes (on
an Apple laser writer).
Any tips on improving the run time would be welcome. Have fun.
John M Pratt,
European Computer-industry Research Centre,
Arabellastrasse 17,
D 8000 Munich 81,
West Germany.
email- harry%ecrcvax.UUCP@Germany.CSNET
-----------Cut Here----------------------
%!PS-Adobe-1.0
%%Title:Square-recursion
%%DocumentFonts: (atend)
%%Creator: John Pratt and M.C.Escher
%%CreationDate:25 November 1987
%%Pages: (atend)
%%EndComments
%%EndProlog
%%Page: 1 1
/Helvetica-Bold findfont 0.5 scalefont setfont
/level 0 def %control variable for recursion
/maxlevel 0 def %Limit of recursion, 3 takes 25 min.
/Down { /level level 1 add def }def
/Up {/level level 1 sub def} def
/Colour 0 def %base colour variable
/Parity 0 def /Swap {/Parity 0.5 Parity sub def} def
/Odd-colour {/Colour Parity def} def
/Even-Colour {/Colour 0.5 Parity sub def} def
/White {/Colour 1 def} def
/Comp {Colour 1 ne {1 setgray} {0 setgray} ifelse} def
/cm {28.35 mul} def /Root2 2 sqrt def /Invr2 0.5 sqrt def
/HeadMatrix matrix %create matrix for head triangle
45 matrix rotate matrix concatmatrix
Invr2 neg Invr2 matrix scale matrix concatmatrix
0 10 matrix translate matrix concatmatrix def
%cf 0 10 translate Invr2 neg Invr2 scale 45 rotate
/UpheadMatrix HeadMatrix matrix invertmatrix def
% cf -45 rotate Root2 neg Root2 scale 0 -10 translate
/TailMatrix matrix %create matrix for tail triangle
-45 matrix rotate matrix concatmatrix
Invr2 neg Invr2 matrix scale matrix concatmatrix
0 10 matrix translate matrix concatmatrix def
%cf {0 10 translate Invr2 neg Invr2 scale -45 rotate}
/UptailMatrix TailMatrix matrix invertmatrix def
% cf 45 rotate Root2 neg Root2 scale 0 -10 translate
/Op1 matrix %matrix for duple opposite
0 -10 matrix translate matrix concatmatrix
180 matrix rotate matrix concatmatrix
0 10 matrix translate matrix concatmatrix def
/Downhead {HeadMatrix concat} def %apply to CTM
/Uphead {UpheadMatrix concat} def %apply to CTM
/Downtail {TailMatrix concat} def %apply to CTM
/Uptail {UptailMatrix concat} def %apply to CTM
/Op {Op1 concat} def %apply to CTM
/DwnR {HeadMatrix transform} def %applies Head matrix to point
/UpR {UpheadMatrix transform} def %applies UpHead matrix to point
/DwnL {TailMatrix transform} def %applies Tail matrix to point
/UpL {UptailMatrix transform} def %applies UpTail matrix to point
/Opp {Op1 transform} def %applies opposite matrix to point
/Qflip {exch neg exch} def %Flip by X, X/Y point 180
/Qrot90 {exch neg} def %rotate X/Y point -90
/Qrotm90 {neg exch } def %rotate X/Y point 90
/Qxtran {3 -1 roll add exch} def %adds top to 3rd, X
/A {10 10} def /A1 {9 8} def /A2 {7.5 6.2} def
/Ah {A -1 Qxtran -0.5 add } def
/B {6 5.6} def /B1 {4.8 5} def /B2 {2.2 4.5} def
/C {0 5} def /C1 {-1.1 5.3} def /C2 {-4.2 6} def
/D {B Qrotm90} def /D1 {A1 Qrotm90} def /D2 {A2 Qrotm90} def
/E {A Qrotm90} def /E1 {A1 DwnL} def /E2 {A2 DwnL} def
/Eh {Ah Qflip} def
/F {B DwnL} def /F1 {F 2 Qxtran 2 sub} def /F2 {-2 7} def
/G {0 7.6} def /G1 {2 8.2} def /G2 {3.2 9.5 } def
/Gt {G UpL} def
/H {5.1 10} def /H1 {6.5 10.5} def /H2 {8 10.5} def
/I1 {0 4} def /I2 {0 2} def
/J {0 0} def /J1 {3 0} def /J2 {3 0} def
/K {C Qrot90} def
/L {C DwnR} def /L1 {C1 DwnR }def /L2 {4.7 11} def
/N {0 10.7} def /N1 {I1 DwnR} def /N2 {I2 DwnR} def
/Nt {N UpL} def
/P {L Qflip} def
/Q1 {4.1 12.4} def /Q2 {2 13.1} def
/a {A1 A2 B} def /b {B1 B2 C} def
/c {C1 C2 D} def
/d {D2 D1 E} def /e {E1 E2 F} def
/f {F1 F2 G} def /fr {F2 UpL F1 UpL F UpL} def
/g {G1 G2 H} def
/h {H1 H2 A} def /hr {H2 H1 H} def
/i {I1 I2 J } def /j {J1 J2 K} def
/k {C1 Qrot90 C2 Qrot90 B} def % c with 90 rotate about O
/l {L2 L1 L} def /lr {L1 L2 H} def %l reversed
/n {N1 N2 N } def /ns {I1 I2 N UpR} def /nm (J M P) def
/o {G} def /ot {Gt} def % straight line
/p {I2 Qrot90 I1 Qrot90 C Qrot90} def %ie of tailfish
/pr {I1 I2 Nt } def
/q {Q1 Q2 G Opp} def /s {Comp nm Pup} def
/Fr1 { %Fish righthand (convex side)
A moveto a curveto b curveto c curveto d curveto
} def
/Fr2 { %Fish righthand for 45 deg angle
A moveto a curveto b curveto
Uphead %always used in head half
lr curveto h curveto
Downhead
} def
/Fl1 { %Fish lefthand (concave side)
e curveto f curveto g curveto h curveto
} def
/Fl2 { %Fish lefthand for duple
Op %using opposite fish points
hr curveto q curveto
Op %cancelling Op
g curveto h curveto
} def
/Fc1 { %Fishcentre inside
Ah moveto C C -0.6 Qxtran Eh curveto
} def
/Fc2 { %Fish centre outside and blunt ends
Eh -0.05 add lineto
C -0.25 add -0.6 Qxtran C -0.25 add Ah -0.05 add curveto
Ah lineto
} def
/Tailrib1 {newpath -6 9 moveto -5 8 -4 7.3 -2.4 6.9 curveto
stroke} def
/Tailrib2 {newpath -5.5 6.7 moveto -4.5 6.3 -3.5 6.2 -2.3 6 curveto
stroke} def
/Tailrib3 {newpath -2.2 7.1 moveto -2.4 6.7 -2.4 6.2 -2.2 5.8 curveto
stroke} def
/Tailribs {Tailrib1 Tailrib2 Tailrib3} def
/EyeshapeL {newpath -0.4 0.8 moveto 0.7 1.3 1.5 1.2 2.5 0.8 curveto
1.9 0 1.1 -0.4 0.1 -0.9 curveto
0 -0.2 -0.1 0.3 -0.4 0.8 curveto closepath} def
/EyeL {gsave 5.6 8.9 translate EyeshapeL
Colour 1 ne {fill}{stroke} ifelse grestore} def
/EyePupL { gsave 5.8 9 translate 0.4 0.4 scale EyeshapeL
fill grestore } def
/EyeshapeR { newpath 0 0.8 moveto 1.4 1.6 1.9 1.6 2.6 1.5 curveto
2.4 0.8 1.6 0 0.1 -0.8 curveto
0.1 -0.3 0.1 0.3 0 0.8 curveto closepath } def
/EyeR {gsave 5.9 6.7 translate EyeshapeR
Colour 1 ne {fill}{stroke} ifelse grestore} def
/EyePupR { gsave 6.1 6.7 translate 0.4 0.4 scale EyeshapeR
fill grestore} def
/Pupcol {Colour 1 ne {Colour setgray } if } def
/Pup {-3 0 moveto show} def
/FishMain { Comp %compliment colour
newpath Fc1 Fc2 closepath gsave fill grestore
Tailribs
0.01 setlinewidth EyeR EyeL
Pupcol EyePupR EyePupL } def
/Fish { Colour setgray newpath Fr1 Fl1 closepath gsave fill grestore
FishMain } def
/Fishd { Colour setgray newpath Fr1 Fl2 closepath gsave fill grestore
FishMain} def
/Fish45r {Colour setgray newpath Fr2 Fl1 closepath gsave fill grestore
FishMain } def
/Fish45d { Colour setgray newpath Fr2 Fl2 closepath gsave fill grestore
FishMain} def
/Ribl {newpath H moveto l curveto stroke } def
/Ribk {newpath K moveto k curveto stroke }def
/Ribf {newpath Gt moveto fr curveto stroke } def
/Ribb {newpath B moveto b curveto stroke } def
/Ribg {newpath G moveto g curveto stroke} def
/Wingribs %stack SideRib WingRib Translate-offset Translate-inc Y-Scale-inc
{4 copy 4 copy %copy parameters given for 3 ribs
Comp 0.15 setlinewidth
0 1 2 {gsave %stack --Wr To Ti Sy Loopv
dup dup 0.25 mul 0.75 exch sub %stack ----Sy Lv Lv Sx
exch 4 -1 roll mul 0.95 exch sub %stack ---To Ti Lv Sx Sy
scale %stack --To Ti Lv
mul add 0 exch translate %stack --Wr
cvx exec %execute WingRibxx
grestore } for %stack Sr
cvx exec } def %execute Sideribxx
/QuadWing { Colour setgray newpath %wing for quad
C moveto i curveto j curveto k curveto b curveto
closepath fill
/Ribb /Ribk 0.5 0 0 Wingribs
} def
/TriWing1 { Colour setgray newpath %wing on Hypoteneuse for triple
G moveto g curveto l curveto n curveto o lineto
closepath fill
/Ribg /Ribl -0.5 0 0.04 Wingribs } def
/TriWing2 { Colour setgray newpath %wing on head side for triple
C moveto ns curveto p curveto k curveto b curveto
closepath fill
/Ribb /Ribk 0.5 0.1 0 Wingribs } def
/TriWing3 { Colour setgray newpath %wing on tail side for triple
C moveto pr curveto ot lineto fr curveto b curveto
closepath fill
/Ribb /Ribf 0.8 0.6 0.03 Wingribs }def
/DupleWing { Colour setgray newpath %wing for duple
G moveto g curveto q curveto o lineto
closepath fill
/Ribg /Ribl -0.5 0 0.04 Wingribs }def
/Wings0 {QuadWing TriWing1} def
/Wings1 {TriWing2 TriWing1} def
/Wings2 {TriWing3 TriWing1} def
/Wings3 {TriWing2 DupleWing} def
/Wings4 {TriWing3 DupleWing} def
/Wings5 {QuadWing DupleWing} def
/Headpair {Downhead
Odd-colour Wings1 Fish45r %fish Hh
Down Sextet Up % recurse to smaller level
-90 rotate %Uphead Downtail
Even-Colour Wings4 Fishd
Uptail %fish Ht
} def
/Tailpair {Downhead
White Wings3 Fish45d %fish Th
-90 rotate %Uphead Downtail
Odd-colour Wings2 Fish %fish Tt
Down Sextet Up
Uptail } def
/Sextet {level maxlevel le {
Downhead
White Wings1 Fish45r %fish H
Headpair
-90 rotate %Uphead+downtail
Even-Colour Wings2 Fish %fish T
Tailpair
Uptail
}if} def
/RCorner {level maxlevel le {
20 0 translate
Downtail
Downhead
White Wings5 Fish45d %fish Th with S wing
-90 rotate %Uphead Downtail
Odd-colour Wings0 Fish %fish Tt
Down Sextet RCorner Up
Uptail
Uptail
-20 0 translate
}if } def
/LCorner {level maxlevel le {
-20 0 translate
Downhead
Downtail
Even-Colour Wings5 Fishd %fish Ht with S wing
90 rotate %Uptail Downhead
Odd-colour Wings0 Fish
Down Sextet LCorner Up
Uphead
Uphead
20 0 translate
}if } def
/Centre {Odd-colour Wings0 Fish} def
gsave
10 cm 15 cm translate
0.3 cm 0.3 cm scale 0.05 setlinewidth
1 setflat 1 setlinecap
150 45 {0.5 mul add} setscreen
4 {Centre Sextet RCorner LCorner Swap -90 rotate} repeat s
grestore
showpage
%%Trailer
%%Pages: 1
%%DocumentFonts: Helvetica-Bold