2009/11/12

PostScript ループ for, loop, repeat, 再帰

7.2-Loops-for.ps7.2-Loops-loop.ps7.2-Loops-Recur.psWS0819

7.2-Loops-for.ps
/Times-Italic findfont 300 scalefont setfont 
/printZip {
    0 0 moveto
    (Zip) show
} def 
/printing{
    .99 -.03 0
    {
        setgray
        printZip
        -1 .5 translate
    } for
} def 
80 500 translate
printing
1 setgray printZip 
0 -400 translate
printing 
showpage

7.2-Loops-loop.ps 
% --- procedures ---------------------------------
/pagewidth {
    8.5 72 mul
} def 
/doCircle {
    xpos ypos radius 0 360 arc stroke
} def 
/increase-x {
    xpos radius add
    /xpos exch def
} def 
/lineofcircles {
    /ypos exch def
    /radius exch def
    /xpos 0 def
    {
        xpos pagewidth le
        {
            doCircle
            increase-x
        }
        {
            exit
        } ifelse
    } loop
} def 
% --- programs ----------------------------------
10 100 lineofcircles
30 100 lineofcircles
90 100 lineofcircles 
/seed-x 30 def
/inc-x 30 def 
5 {
    seed-x 400 lineofcircles
    /seed-x seed-x inc-x add def
} repeat 
10 {
    -10 rotate
    -150 0 translate
    10 800 lineofcircles
} repeat 
showpage
7.2-Loops-Recur.ps
% --- variables ----------------------------------
/LM 72 def % ?
/Times-Roman findfont 50 scalefont setfont
/nstr 9 string def 
% --- procedures ---------------------------------
/factorial {
    dup 1 gt
    {
        dup 1 sub
        factorial mul
    } if
} def 
/newline {
    currentpoint 40 sub
    exch pop
    LM exch
    moveto
} def 
/prt-n {
    nstr cvs show
} def 
/prtFactorial {
    dup prt-n
    (! = ) show
    factorial prt-n
    newline
} def 
% --- main ---------------------------------------
LM 600 moveto
1 1 12 { prtFactorial } for 
LM 100 moveto
10 factorial 7 string cvs show 
showpage
WS0816 WS0817 WS0818
WS0819
画像は順にmaxdepthが1, 3, 7, 12の場合
PostScriptで手軽にクロージャ使えたら良いなー。と思ったが、どうやら少し込み入ったことになりそうだったので高階関数"的"なものの真似事をしてみた。手続きを手続きに渡してるわけだから"的"はいらないか。
クロージャも高階手続きももっと手軽に使えないと意味がないと思うので何か良い方法はないのかと考えてみる。今度。
% --- variables ------------------------
/depth 0 def
/maxdepth 12 def
/arrow-size 300 def 
% --- procedures -----------------------
/down {
    /depth depth 1 add def
} def 
/up {
    /depth depth 1 sub def
} def 
/slide-v {
    /proc exch def
    /proc load
    /depth depth 1 proc def
} def 
/DoLine {
    0 arrow-size rlineto
    currentpoint
    stroke
    translate
    0 0 moveto
} def 
/FractArrow {
    gsave
    .7 .7 scale
    10 setlinewidth
    % down
    { add } slide-v
    DoLine
    depth maxdepth le
    {
        135 rotate
        FractArrow
        -270 rotate
        FractArrow
    } if
    % up
    { sub } slide-v
    grestore
} def 
/def-pos {
    300 400 moveto
} def 
/rotate-90 {
    90 rotate
} def 
% --- main -----------------------------
def-pos 
4 {
    gsave
    FractArrow
    grestore
    rotate-90
} repeat 
stroke 
showpagen
追加:
WS0820WS0821WS0822
% --- variables ------------------------
/depth 0 def
/maxdepth 12 def
/arrow-size 300 def
/scale-point .7 def 
% --- procedures -----------------------
/down {
    /depth depth 1 add def
} def 
/up {
    /depth depth 1 sub def
} def 
/slide-v {
    /proc exch def
    /proc load
    /depth depth 1 proc def
} def 
/DoLine {
    0 arrow-size rlineto
    currentpoint
    stroke
    translate
    0 0 moveto
} def 
/FractArrow {
    gsave
    scale-point dup scale
    10 setlinewidth
    % down
    { add } slide-v
    DoLine
    depth maxdepth le
    {
        135 rotate
        FractArrow
        -270 rotate
        FractArrow
    } if
    % up
    { sub } slide-v
    grestore
} def 
/def-pos {
    300 400 moveto
} def 
/rotate-90 {
    90 rotate
} def 
% --- main -----------------------------
def-pos 
4 {
    gsave
    FractArrow
    grestore
    rotate-90
} repeat 
stroke 
showpagen

PostScript(R) Language Tutorial and Cookbook (APL)
PostScript(R) Language Tutorial and Cookbook (APL)
posted with amazlet at 09.10.07
Adobe Systems Inc.
Addison-Wesley Professional
売り上げランキング: 235737
おすすめ度の平均: 5.0
5 まず最初に読むべき入門書
5 効率の良いPostScript書くなら…
Amazon.co.jp で詳細を見る

0 件のコメント:

コメントを投稿