home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PSCRIPT / ESCHER.PS < prev    next >
Encoding:
Text File  |  1992-06-29  |  11.8 KB  |  322 lines
  1. % Just in case anyone has an idle printer I am posting a close replication of
  2. % "Square-limit" by M.C.Escher.  I have called it "Square-recursion" because it
  3. % builds the image by recursion, following the triangle subdivision used by
  4. % Escher.
  5. % 
  6. % I have used Postscript graphics to the full, using transformations and curves
  7. % freely. However it takes a long time to run as a result.  The version posted
  8. % has a variable "Maxlevel", which defaults to 0, and takes 2 minutes to
  9. % produce a core picture.  Try that first, and check that all is well,  then
  10. % if you wish the full gory detail set Maxlevel to 3, and wait 25 minutes (on
  11. % an Apple laser writer).
  12. % 
  13. % Any tips on improving the run time would be welcome.  Have fun.
  14. % 
  15. % John M Pratt,
  16. % European Computer-industry Research Centre,
  17. % Arabellastrasse 17,
  18. % D 8000 Munich 81,
  19. % West Germany.
  20. % 
  21. % email-   harry%ecrcvax.UUCP@Germany.CSNET
  22. % 
  23. % -----------Cut Here----------------------
  24.  %!PS-Adobe-1.0
  25.  %%Title:Square-recursion
  26.  %%DocumentFonts: (atend)
  27.  %%Creator: John Pratt and M.C.Escher
  28.  %%CreationDate:25 November 1987
  29.  %%Pages: (atend)
  30.  %%EndComments
  31.  
  32.  %%EndProlog
  33.  
  34.  %%Page: 1 1
  35.  /Helvetica-Bold findfont 0.5 scalefont setfont
  36.  /level 0 def                %control variable for recursion
  37.  /maxlevel 0 def             %Limit of recursion, 3 takes 25 min.
  38.  /Down { /level level 1 add def }def
  39.  /Up {/level level 1 sub def} def
  40.  
  41.  /Colour  0 def %base colour variable
  42.  /Parity 0 def         /Swap {/Parity 0.5 Parity sub def} def
  43.  /Odd-colour {/Colour Parity def} def
  44.  /Even-Colour {/Colour 0.5 Parity sub def} def
  45.  /White {/Colour 1 def} def
  46.  /Comp {Colour 1 ne {1 setgray} {0 setgray} ifelse} def
  47.  
  48.  /cm {28.35 mul} def   /Root2 2 sqrt def       /Invr2 0.5 sqrt def
  49.  /HeadMatrix matrix            %create matrix for head triangle
  50.        45 matrix rotate matrix concatmatrix
  51.        Invr2 neg Invr2 matrix scale  matrix concatmatrix
  52.        0 10 matrix translate matrix concatmatrix def
  53.                %cf 0 10 translate Invr2 neg Invr2 scale 45 rotate
  54.  
  55.  /UpheadMatrix HeadMatrix matrix invertmatrix def
  56.                % cf -45 rotate Root2 neg Root2 scale 0 -10 translate
  57.  
  58.  /TailMatrix matrix            %create matrix for tail triangle
  59.        -45 matrix rotate matrix concatmatrix
  60.        Invr2 neg Invr2 matrix scale  matrix concatmatrix
  61.        0 10 matrix translate matrix concatmatrix   def
  62.                %cf {0 10 translate Invr2 neg Invr2 scale -45 rotate}
  63.  
  64.  /UptailMatrix TailMatrix matrix invertmatrix def
  65.                        % cf 45 rotate Root2 neg Root2 scale 0 -10 translate
  66.  
  67.  /Op1 matrix            %matrix for duple opposite
  68.        0 -10 matrix translate matrix concatmatrix
  69.        180 matrix rotate matrix concatmatrix
  70.        0 10 matrix translate matrix concatmatrix def
  71.  
  72.  /Downhead {HeadMatrix concat} def             %apply to CTM
  73.  /Uphead  {UpheadMatrix concat} def            %apply to CTM
  74.  /Downtail {TailMatrix concat}  def            %apply to CTM
  75.  /Uptail {UptailMatrix concat} def             %apply to CTM
  76.  /Op {Op1 concat} def                          %apply to CTM
  77.  
  78.  /DwnR {HeadMatrix transform} def      %applies Head matrix to point
  79.  /UpR {UpheadMatrix transform} def     %applies UpHead matrix to point
  80.  /DwnL {TailMatrix transform} def      %applies Tail matrix to point
  81.  /UpL {UptailMatrix transform} def     %applies UpTail matrix to point
  82.  /Opp {Op1 transform} def              %applies opposite matrix to point
  83.  
  84.  /Qflip {exch neg exch} def            %Flip by X, X/Y point 180
  85.  /Qrot90 {exch neg} def                        %rotate X/Y point   -90
  86.  /Qrotm90 {neg exch } def              %rotate X/Y point 90
  87.  /Qxtran {3 -1 roll add exch} def      %adds top to 3rd, X
  88.  
  89.  /A {10 10} def                /A1 {9 8} def           /A2 {7.5 6.2} def
  90.  /Ah {A -1 Qxtran -0.5 add } def
  91.  /B {6 5.6} def                /B1 {4.8 5} def         /B2 {2.2 4.5} def
  92.  /C {0 5} def                  /C1 {-1.1 5.3} def      /C2 {-4.2 6} def
  93.  /D {B Qrotm90} def    /D1 {A1 Qrotm90} def    /D2 {A2 Qrotm90} def
  94.  /E {A Qrotm90} def    /E1 {A1 DwnL} def       /E2 {A2 DwnL} def
  95.  /Eh {Ah Qflip} def
  96.  /F {B DwnL} def               /F1 {F 2 Qxtran 2 sub} def      /F2 {-2 7} def
  97.  /G {0 7.6} def                /G1 {2 8.2} def         /G2 {3.2 9.5 } def
  98.  /Gt {G UpL} def
  99.  /H {5.1 10} def               /H1 {6.5 10.5} def      /H2 {8 10.5} def
  100.                        /I1 {0 4} def           /I2  {0 2} def
  101.  /J {0 0} def          /J1 {3 0} def           /J2 {3 0} def
  102.  /K {C Qrot90} def
  103.  /L {C DwnR} def               /L1 {C1 DwnR }def       /L2 {4.7 11} def
  104.  /N {0 10.7} def               /N1 {I1 DwnR} def       /N2 {I2 DwnR} def
  105.  /Nt {N UpL} def
  106.  /P {L Qflip} def
  107.                        /Q1 {4.1 12.4} def      /Q2 {2 13.1} def
  108.  
  109.  /a {A1 A2 B} def      /b {B1 B2 C} def
  110.  /c {C1 C2 D} def
  111.  /d {D2 D1 E} def      /e {E1 E2 F} def
  112.  /f {F1 F2 G} def      /fr {F2 UpL F1 UpL F UpL} def
  113.  /g {G1 G2 H} def
  114.  /h {H1 H2 A} def      /hr {H2 H1 H} def
  115.  /i {I1 I2 J } def     /j {J1 J2 K} def
  116.  /k {C1 Qrot90 C2 Qrot90 B} def        % c with 90 rotate about O
  117.  /l {L2 L1 L} def      /lr {L1 L2 H} def       %l reversed
  118.  /n {N1 N2 N } def     /ns {I1 I2 N UpR} def   /nm (J M P) def
  119.  /o {G} def            /ot {Gt} def            % straight line
  120.  /p {I2  Qrot90 I1 Qrot90 C Qrot90} def %ie of tailfish
  121.  /pr {I1 I2 Nt } def
  122.  /q {Q1 Q2 G Opp} def  /s {Comp nm Pup} def
  123.  
  124.  /Fr1 {                        %Fish righthand (convex side)
  125.        A  moveto  a  curveto b curveto  c curveto  d curveto
  126.        } def
  127.  
  128.  /Fr2 {                %Fish righthand for 45 deg angle
  129.        A  moveto  a  curveto b curveto
  130.        Uphead          %always used in head half
  131.                lr curveto   h curveto
  132.        Downhead
  133.        } def
  134.  
  135.  /Fl1 {                        %Fish lefthand (concave side)
  136.        e curveto f curveto   g curveto  h curveto
  137.        } def
  138.  
  139.  /Fl2 {                        %Fish lefthand for duple
  140.        Op              %using opposite fish points
  141.                hr curveto  q curveto
  142.        Op              %cancelling Op
  143.        g curveto  h curveto
  144.        } def
  145.  
  146.  /Fc1 {                %Fishcentre inside
  147.        Ah moveto   C C -0.6 Qxtran Eh curveto
  148.        } def
  149.  
  150.  /Fc2 {                        %Fish centre outside and blunt ends
  151.        Eh -0.05 add lineto
  152.        C -0.25 add -0.6 Qxtran C -0.25 add Ah -0.05 add curveto
  153.        Ah lineto
  154.        } def
  155.  
  156.  /Tailrib1 {newpath -6 9 moveto -5 8 -4 7.3 -2.4 6.9 curveto
  157.        stroke} def
  158.  /Tailrib2 {newpath -5.5 6.7 moveto -4.5 6.3  -3.5 6.2 -2.3 6 curveto
  159.        stroke} def
  160.  /Tailrib3 {newpath -2.2 7.1 moveto -2.4 6.7  -2.4 6.2 -2.2 5.8 curveto
  161.        stroke} def
  162.  /Tailribs  {Tailrib1 Tailrib2 Tailrib3} def
  163.  
  164.  /EyeshapeL {newpath -0.4 0.8 moveto 0.7 1.3 1.5 1.2 2.5 0.8 curveto
  165.        1.9  0   1.1 -0.4   0.1 -0.9 curveto
  166.        0  -0.2  -0.1 0.3  -0.4 0.8 curveto closepath} def
  167.  /EyeL {gsave  5.6 8.9 translate EyeshapeL
  168.        Colour 1 ne {fill}{stroke} ifelse grestore} def
  169.  
  170.  /EyePupL {   gsave 5.8 9 translate  0.4 0.4 scale  EyeshapeL
  171.        fill grestore } def
  172.  
  173.  /EyeshapeR { newpath 0  0.8 moveto 1.4 1.6  1.9 1.6  2.6 1.5 curveto
  174.        2.4 0.8  1.6 0  0.1 -0.8 curveto
  175.        0.1 -0.3 0.1 0.3  0 0.8 curveto closepath } def
  176.  
  177.  /EyeR {gsave 5.9 6.7 translate EyeshapeR
  178.        Colour 1 ne {fill}{stroke} ifelse grestore} def
  179.  
  180.  /EyePupR {   gsave 6.1 6.7 translate  0.4 0.4 scale  EyeshapeR
  181.        fill grestore} def
  182.  
  183.  /Pupcol {Colour 1 ne  {Colour setgray } if  } def
  184.  
  185.  /Pup    {-3 0 moveto show} def
  186.  
  187.  /FishMain {   Comp    %compliment colour
  188.        newpath  Fc1 Fc2  closepath  gsave fill grestore
  189.        Tailribs
  190.        0.01 setlinewidth  EyeR EyeL
  191.        Pupcol EyePupR EyePupL } def
  192.  
  193.  /Fish { Colour setgray newpath         Fr1 Fl1  closepath  gsave fill grestore
  194.        FishMain } def
  195.  
  196.  /Fishd { Colour setgray newpath  Fr1 Fl2  closepath  gsave fill grestore
  197.        FishMain} def
  198.  
  199.  /Fish45r {Colour setgray newpath  Fr2 Fl1  closepath  gsave fill grestore
  200.        FishMain } def
  201.  
  202.  /Fish45d { Colour setgray newpath  Fr2 Fl2  closepath   gsave fill grestore
  203.        FishMain} def
  204.  
  205.  /Ribl {newpath H moveto l curveto  stroke } def
  206.  /Ribk {newpath K moveto k curveto  stroke }def
  207.  /Ribf {newpath Gt moveto fr curveto stroke } def
  208.  /Ribb {newpath B moveto b curveto  stroke } def
  209.  /Ribg {newpath G moveto g curveto stroke} def
  210.  
  211.  /Wingribs %stack SideRib WingRib Translate-offset Translate-inc Y-Scale-inc
  212.        {4 copy 4 copy          %copy parameters given for 3 ribs
  213.        Comp    0.15 setlinewidth
  214.        0 1 2 {gsave                             %stack --Wr To Ti Sy Loopv
  215.                dup dup 0.25 mul 0.75 exch sub   %stack ----Sy Lv Lv Sx
  216.                exch 4 -1 roll mul 0.95 exch sub %stack ---To Ti Lv Sx Sy
  217.                        scale                    %stack --To Ti Lv
  218.                mul add 0 exch  translate        %stack --Wr
  219.          cvx exec                      %execute WingRibxx
  220.                grestore } for          %stack Sr
  221.          cvx exec } def                %execute Sideribxx
  222.  
  223.  /QuadWing { Colour setgray newpath            %wing for quad
  224.        C moveto  i curveto  j curveto   k curveto  b curveto
  225.        closepath  fill
  226.        /Ribb /Ribk 0.5  0  0 Wingribs
  227.         } def
  228.  
  229.  /TriWing1     { Colour setgray newpath        %wing on Hypoteneuse for triple
  230.        G moveto  g curveto  l curveto   n curveto  o lineto
  231.        closepath  fill
  232.        /Ribg /Ribl -0.5 0 0.04 Wingribs  } def
  233.  
  234.  /TriWing2 { Colour setgray newpath            %wing on head side for triple
  235.        C moveto  ns curveto  p curveto  k curveto  b curveto
  236.        closepath  fill
  237.        /Ribb /Ribk 0.5 0.1 0 Wingribs  } def
  238.  
  239.  /TriWing3 { Colour setgray  newpath           %wing on tail side for triple
  240.        C moveto  pr curveto   ot lineto   fr curveto  b curveto
  241.        closepath  fill
  242.        /Ribb /Ribf 0.8 0.6 0.03 Wingribs       }def
  243.  
  244.  /DupleWing {  Colour setgray newpath          %wing for duple
  245.        G moveto  g curveto  q curveto o lineto
  246.        closepath  fill
  247.        /Ribg /Ribl -0.5 0 0.04 Wingribs }def
  248.  
  249.  /Wings0 {QuadWing TriWing1} def
  250.  /Wings1 {TriWing2 TriWing1} def
  251.  /Wings2 {TriWing3 TriWing1} def
  252.  /Wings3 {TriWing2 DupleWing} def
  253.  /Wings4 {TriWing3 DupleWing} def
  254.  /Wings5 {QuadWing DupleWing} def
  255.  
  256.  /Headpair {Downhead
  257.                Odd-colour Wings1 Fish45r       %fish Hh
  258.                  Down  Sextet   Up     % recurse to smaller level
  259.          -90 rotate                            %Uphead Downtail
  260.                 Even-Colour   Wings4 Fishd
  261.           Uptail                       %fish Ht
  262.        } def
  263.  /Tailpair {Downhead
  264.                White Wings3 Fish45d    %fish Th
  265.           -90 rotate                   %Uphead Downtail
  266.                Odd-colour Wings2 Fish   %fish Tt
  267.                  Down  Sextet Up
  268.           Uptail } def
  269.  
  270.  /Sextet {level maxlevel le {
  271.        Downhead
  272.                White  Wings1 Fish45r           %fish H
  273.              Headpair
  274.          -90 rotate                            %Uphead+downtail
  275.                Even-Colour  Wings2 Fish                %fish  T
  276.            Tailpair
  277.          Uptail
  278.       }if} def
  279.  
  280.  /RCorner {level maxlevel le {
  281.  20 0 translate
  282.     Downtail
  283.        Downhead
  284.                 White  Wings5 Fish45d          %fish Th with S wing
  285.        -90 rotate                              %Uphead Downtail
  286.                 Odd-colour  Wings0 Fish                %fish Tt
  287.                Down  Sextet RCorner Up
  288.        Uptail
  289.     Uptail
  290.  -20 0 translate
  291.        }if } def
  292.  
  293.  /LCorner {level maxlevel le {
  294.  -20 0 translate
  295.     Downhead
  296.        Downtail
  297.                Even-Colour Wings5 Fishd        %fish Ht with S wing
  298.        90 rotate                       %Uptail Downhead
  299.                Odd-colour Wings0 Fish
  300.                Down  Sextet  LCorner Up
  301.        Uphead
  302.     Uphead
  303.  20 0 translate
  304.        }if } def
  305.  
  306.  /Centre {Odd-colour  Wings0 Fish} def
  307.  
  308.  gsave
  309.    10 cm 15 cm translate
  310.    0.3 cm 0.3 cm scale 0.05 setlinewidth
  311.    1 setflat 1 setlinecap
  312.    150 45 {0.5 mul add} setscreen
  313.  4 {Centre Sextet RCorner LCorner Swap -90 rotate} repeat s
  314.  grestore
  315.  showpage
  316.  
  317.  %%Trailer
  318.  %%Pages: 1
  319.  %%DocumentFonts: Helvetica-Bold
  320.  
  321.  
  322.