2009/10/26

9LISP - 003 までの宿題

9lisp

(なんで背景黒くなっちゃうの?)

 

9LISPは毎回宿題が出るので取り合えずかいつまんでやってみます。(今のところ私が適当に見繕って出してるわけですが・・・)

 

;; 次のコードの評価を考えてみる
(((lambda (x)(lambda (x)(+ x 1))) 2) 4)

 

評価順序とスコープについて考えさせられます。目が慣れないと面食らいそうです。評価すると5が返ります。

インデントを付けてみます。

(((lambda (x)
    ;; x = 2
    (lambda (x)
      ;; x = 4
      (+ x 1)))
  2)
4)
; -> 5

 

次のlet式と等価と言ってよさそうです。

(let ((x 2))
  (let ((x 4))
    (+ x 1)))
; -> 5

 

これも上記と等価。

(let* ((x 2)
       (x 4))
  (+ x 1))

 

let式は初期値式が先に全て評価された後、変数名に束縛されるため下記のコードはエラーとなります。つまりbの位置からaは見えない。

(let ((a 10)
      (b (+ a 10)))
  (+ a b))
; -> error

 

letrec

初期値式が評価される時に同一レベルの束縛されていない変数名(値不定)も見えている。

(letrec ((a 10)
         (b (+ a 10)))
  (+ a b))
; -> 30

 

無名関数でスコープを作ったり真偽値を定義したり条件分岐してみたり、無名関数で再帰してみたりということについてはラムダ計算について調べるとおもしろそうです。

 

 

組み込みの特殊形式ifと同じ動作をするnew-if手続きを定義してみる

ifがなぜ特殊形式であるか考えてみる(SICPより)

(define new-if
  (lambda (pred then-exp else-exp)
    (cond
     (pred then-exp)
     (else else-exp))))

(new-if #t 1 2)

; -> 1
(new-if #f 1 2)

; -> 2
(new-if #t (print 10)(print 20))

; -> 10
20
#<undef>

(new-if #t (print 10)(print 20)) を見るとわかる通り、引数が両方とも評価されています。組み込みのifはpredicateによってちゃんとどちらか一方が評価されます。このnew-ifで再帰を書くと大変なことになりますね。

 

こうしちゃえばどうかな・・・。

((new-if #t (lambda ()(print 10))(lambda ()(print 20))))

 

 

引数がatomであるか判定するatom?手続きを定義してみる(The Little Schemerより)

(define atom?
  (lambda (x)
    (and (not (pair? x)) ;; 対でない
         (not (null? x))))) ;; かつ空リストでもない

これでも良いのか?

(define atom?
  (lambda (x)
    (not (list? x))))

あーダメか、ベクタとか。でもそれだと上のもダメか・・・。どうしたらいいんだ。取り合えずこれで。

 

引数のリストの要素がすべてatomであるか判定するlat?手続きを定義してみる(The Little Schemerより)

(define lat?
  (lambda (l)
    (cond
     ((null? l) #t)
     ((atom? (car l))
      (lat? (cdr l)))
     (else #f))))

 

引数で指定されたatomが引数のリスト内に存在するか判定するmember?手続きを定義してみる(The Little Schemerより)

(define member?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     ((eq? a (car lat)) #t)
     (else (member? a (cdr lat))))))

またはこんなの。

(define member?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     (else (or (eq? a (car lat))
               (member? a (cdr lat)))))))

 

FizzBuzz

(use srfi-1)
(define fizzbuzz
  (lambda (x)
    (map (lambda (n)
           (cond
            ((zero? (modulo n 15)) "FizzBuzz")
            ((zero? (modulo n 5)) "Buzz")
            ((zero? (modulo n 3)) "Fizz")
            (else n)))
         (iota x 1))))
(print (fizzbuzz 100))

これはプログラミングGaucheで見かけたコードが印象に残ってる。

 

こんなのもありかな。

(((lambda (f)
    (f f))
  (lambda (f)
    (lambda (n)
      (if (<= n 100)
          (begin
            (print (cond
                    ((zero? (modulo n 15)) "FizzBuzz")
                    ((zero? (modulo n 5)) "Buzz")
                    ((zero? (modulo n 3)) "Fizz")
                    (else n)))
            ((f f)(+ n 1))))))) 1)

 

階乗

(define fact
  (lambda (n)
    (if (zero? n)
        1
        (* n (fact (- n 1))))))
(fact 5)

またはこんなのもありかな。

(use srfi-1)
(define fact
  (lambda (n)
    (apply * (iota n 1))))
(fact 5)

他にもfoldとか・・・。

(use srfi-1)
(define fact
  (lambda (n)
    (fold * 1 (iota n 1))))
(fact 10)

継続渡しスタイルだとこう?

(define fact/cps
  (lambda (n cont)
    (if (zero? n)
        (cont 1)
        (fact/cps (- n 1)(lambda (x)
                           (cont (* x n)))))))
(fact/cps 5 (lambda (x) x))

 

フィボナッチ数

(define fib
  (lambda (n)
    (if (or (zero? n)(= 1 n))
        n
        (+ (fib (- n 1))(fib (- n 2))))))
(fib 10)
; -> 55

 

コラッツの問題

(define collatz
  (lambda (n)
    (cons n
          (cond
           ((< n 0) #f)
           ((= n 1) '())
           ((even? n)(collatz (/ n 2)))
           ((odd? n)(collatz (+ (* n 3) 1)))
           (else #f)))))
(collatz 10)

 

アッカーマン関数

(define Ackerman
  (lambda (m n)
    (cond
     ((zero? m)
      (+ n 1))
     ((zero? n)
      (Ackerman (- m 1) 1))
     (else (Ackerman (- m 1)(Ackerman m (- n 1)))))))
(Ackerman 2 3)

引数を大きくすると大変です。

 

階乗 - 末尾再帰

(define tail-call-fact
  (lambda (n)
    (letrec ((iter (lambda (m r)
                     (if (zero? m)
                         r
                         (iter (- m 1)(* r m))))))
      (iter n 1))))
(tail-call-fact 5)

 

フィボナッチ数を末尾再帰で書く、というところでギブ。おやすみなさい。

 

 

Schemeによる記号処理入門

Schemeによる記号処理入門

posted with amazlet at 09.05.10

猪股 俊光 益崎 真治
森北出版
売り上げランキング: 305671

Amazon.co.jp で詳細を見る

プログラミングGauche
プログラミングGauche
posted with amazlet at 09.10.26
Kahuaプロジェクト
オライリージャパン
売り上げランキング: 111091
おすすめ度の平均: 5.0
5 Gauche以外のSchemeの入門書としても最適
5 日本が米国に先行している稀な事例

The Little Schemer

The Little Schemer

posted with amazlet at 09.03.30

Daniel P. Friedman Matthias Felleisen
Mit Pr
売り上げランキング: 16078

おすすめ度の平均: 5.0

5 小さなScheme処理系で学ぶ数学基礎理論
5 Schemeが好きになります
5 英語であるのが苦痛にならない楽しさ
5 面白いスタイル

Amazon.co.jp で詳細を見る

計算機プログラムの構造と解釈

計算機プログラムの構造と解釈

posted with amazlet at 09.03.17

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 123513

おすすめ度の平均: 3.0

1 訳が酷い
4 紙と鉛筆と計算機と
1 内容最高。翻訳最低。
5 食わず嫌いでした。
5 プログラマにとって必読の本です

Amazon.co.jp で詳細を見る

2009/10/20

[Gauche] file.util

こんなに良い読み物があるじゃないか。といまさらリファレンスの存在を知るなどする。プログラミング言語を勉強するのに仕様とリファレンスに目も通さないで良いのは小学生までだよねー。ま、気長に。

 

これはと思ったものをメモがてら。

(use file.util)

 

directory-list

(directory-list "d://Test")
; -> ("." ".." "Development" "Temp" "Test")


(directory-list "d://Test" :add-path? #t)
; -> ("d:\\\\Test\\." "d:\\\\Test\\.." "d:\\\\Test\\Development" "d:\\\\Test\\Temp" "d:\\\\Test\\Test")


(directory-list "d://Test" :add-path? #t :children? #t)
; -> ("d:\\\\Test\\Development" "d:\\\\Test\\Temp" "d:\\\\Test\\Test")


(directory-list "d://Test//development//scheme" :children? #t
                :filter (lambda (e)
                          (eq? (file-type e) 'directory)))
; -> ("arc3")

 

directory-fold

(use srfi-13) ;; string-suffix?


; lister -> directory-lister
(directory-fold "d://test"
                (lambda (entry result)
                  (if (string-suffix? ".scm" entry)
                      (cons entry result)
                      result))
                '())
; -> (ファイル名が".scm"で終わるファイルのリスト)

これすごく便利そう。すげーな。これあれば何でもいけるじゃないですか。

 

;; create-directory*
(make-directory* "d://test//test2//test3//test4")
; -> #t

 

;; delete-directory
(remove-directory* "d://test//test2")
; -> #t

 

(sys-dirname "d://Test")
; -> "d:\\"


(sys-basename "d://Test//development")
; -> "development"


(file-type "d://Test//development")
; -> directory


(file-exists? "d://Test//development//scheme")
; -> #t

2009/10/19

継続渡しスタイルCPS

WS0815

1年くらいSchemeやってて継続(渡し、呼び出し)についても何度か読んだり書いたりしてるはずなのに未だに「どんなんだっけ?」となってしまう私です。

 

なんでも継続」とか読んで少しだけ書いてみた。

 

普通の階乗

;; factorial
(define fact
  (lambda (n)
    (if (zero? n)
        1
        (* n (fact (- n 1))))))

 

継続渡し階乗(Continuation Passing Style -> CPS)

(define fact/cps
  (lambda (n cont)
    (if (zero? n)
        (cont 1)
        (fact/cps (- n 1)(lambda (x)
                           (cont (* n x)))))))

 

やっぱりイメージが沸かないので展開してみた

(fact/cps 5 (lambda (x) x))


(fact/cps (- 5 1)
          (lambda (x)((lambda (x) x)(* 5 x))))


(fact/cps (- (- 5 1) 1)
          (lambda (x)((lambda (x)((lambda (x) x)(* 5 x))) (* 4 x))))

(fact/cps (- (- (- 5 1) 1) 1)
          (lambda (x)((lambda (x)((lambda (x)((lambda (x) x)(* 5 x))) (* 4 x))) (* 3 x))))

(fact/cps (- (- (- (- 5 1) 1) 1) 1)
          (lambda (x)((lambda (x)((lambda (x)((lambda (x)((lambda (x) x)(* 5 x))) (* 4 x))) (* 3 x))) (* 2 x))))

(fact/cps (- (- (- (- (- 5 1) 1) 1) 1) 1)
          (lambda (x)((lambda (x)((lambda (x)((lambda (x)((lambda (x)((lambda (x) x)(* 5 x))) (* 4 x))) (* 3 x))) (* 2 x))) (* 1 x))))

ということですか。わかりました。わかりません。毎度理解できたつもりですが、数日すると忘れるんだろうな。ということはつまりわかってないのな。

実行時のキャプチャーとか言いますよね、わかります。わかりません。セーブポイントみたいなもんだということですね?現在の環境ごとクロージャにぶち込んでほいほい渡していって必要になってから使うし使わなくても良いし、と。

 

超てきとうとは書いてありますがわかりややすかったです。「なんでも継続」の最初の方もわかりやすかった。

The Little Schemer のrember&coのところをもっかいやってみよう。というか丸ごと読み直そう。んでThe Seasoned Schemerもちゃんと読もう。

 

なんかピンとこないんですよね・・・。

 

あ、ついでにJavaScriptとC#も。改めて書く必要もなく同じコードなんですけどね。なんとなく。C#は気分でgoto使ってみた。

 

JS

function factCps (n, cont)
{
  return n === 0
    ? cont(1)
    : factCps (n - 1, function(x){ return cont(n * x);});
};

factCps(5, function(x){ return x;});

 

C#

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

using System.Diagnostics;

namespace SampleCallPassingStyle
{
    public class Program
    {
        public static void Main(string[] args)
        {
            Trace.Listeners.Add(new ConsoleTraceListener());
            Trace.WriteLine("Continuation Passing Style Factorial Start");

            restart:

            try
            {
                FactCps(decimal.Parse(Console.ReadLine()), 0, i => { Console.WriteLine(i); return i; });
                goto restart;
            }
            catch (Exception ex)
            {
                Console.WriteLine(ex.Message);
                goto restart;
            }
        }

        public static decimal FactCps(decimal n, decimal nest, Func<decimal, decimal> cps)
        {
            return n == 0
                ? cps(1)
                : FactCps(n - 1, ++nest, i => { Console.WriteLine("i = {0}, n = {1}, cont({0} * {1}), nest = {2}", i, n, nest); return cps(i * n); });

            //return n == 0
            //    ? cps(1)
            //    : FactCps(n - 1, ++nest, i => cps(i * n));
        }
    }
}

The Little Schemer

The Little Schemer

posted with amazlet at 09.03.30

Daniel P. Friedman Matthias Felleisen
Mit Pr
売り上げランキング: 16078

おすすめ度の平均: 5.0

5 小さなScheme処理系で学ぶ数学基礎理論
5 Schemeが好きになります
5 英語であるのが苦痛にならない楽しさ
5 面白いスタイル

Amazon.co.jp で詳細を見る

The Seasoned Schemer

The Seasoned Schemer

posted with amazlet at 09.03.30

Daniel P. Friedman Matthias Felleisen
Mit Pr
売り上げランキング: 18883

おすすめ度の平均: 5.0

5 Little Schemer とセットで

Amazon.co.jp で詳細を見る

EmacsでSchemeで入力補完 scheme-complete.el


これは便利。

;; complete
(when (require 'auto-complete nil t)
  (global-auto-complete-mode 1)
  (defun ac-next-or-next-line (arg)
    (interactive "p")
    (if (/= (length ac-candidates) 1)
        (ac-next)
      (ac-abort)
      (next-line arg)))
  (defun ac-previous-or-previous-line (arg)
    (interactive "p")
    (if (/= (length ac-candidates) 1)
        (ac-previous)
      (ac-abort)
      (previous-line arg)))
  (define-key ac-complete-mode-map "\C-n" 'ac-next)
  (define-key ac-complete-mode-map "\C-p" 'ac-previous)
  (custom-set-faces
   '(ac-candidate-face ((t (:background "dark orange" :foreground "white"))))
   '(ac-selection-face ((t (:background "blue" :foreground "white"))))))

;; eldoc
(require 'eldoc-extension)
(add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
(add-hook 'lisp-inteeraction-mode-hook 'turn-on-eldoc-mode)
(setq eldoc-idle-delay 0.2)
(setq eldoc-minor-mode-string "")
;; scheme-mode-hook
(defvar ac-source-scheme
  '((candidates
     . (lambda ()
         (require 'scheme-complete)
         (all-completions ac-target (car (scheme-current-env))))))
  "Source for scheme keywords.")
;; Auto-complete-mode config
(add-hook 'scheme-mode-hook
          '(lambda ()
             (make-local-variable 'ac-sources)
             (setq ac-sources (append ac-sources '(ac-source-scheme)))))
(autoload 'scheme-smart-complete "scheme-complete" nil t)
(eval-after-load 'scheme
  '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
(autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
(add-hook 'scheme-mode-hook
          (lambda ()
            (make-local-variable 'eldoc-documentation-function)
            (setq eldoc-documentation-function 'scheme-get-current-symbol-info)
            (eldoc-mode t)
            (setq lisp-indent-function 'scheme-smart-indent-function)))

入門 GNU Emacs 第3版

2009/10/17

[メモ] SICP:図形言語 参考資料




自分でも書いてみました

    quack.elのシンタックスハイライトの色を少し変えてみた

    WS0813

     

    foregroundとかbackgroundとかで検索するとquack-pltish-defn-faceとかquack-threesemi-semi-faceとか見つかるのでRGB color name in emacsを参考に色を指定する。

     

    WS0814

    [メモ] SICP, Gauche, Haskell, PDF, 描画, PostScript

    [SICP]

    SICPにリトライ中。ただいま図形言語。

     

    [Gauche]

    読んだことなかったのでメモ。Kahuaで作られたもののまとめとかないかな。

    [Haskell]

    Haskellは興味なくもないけど当分縁がないかな。日本語の情報源が少ないらしいのでメモ。

    [PDF]

    和田先生の文章が読みたくて。

    [PostScript]

    PostScriptにもはまり中。

     

    こういうのはソーシャルブックマークでやれよって話ですかね?

    [メモ] Emacs, Meadow

    [Emacs]

    • lisp-interaction-mode
      • Emacs Lisp 書きたいときはM-x lisp-interaction-mode
      • 通常に戻りたければM-x text-mode
    • eval-region
      • 今はLisp書いてるわけじゃないけど早急にEmacs Lispを実行したい! -> Emacs Lispのコードを書いて選択してM-x eval-region
    •   FontSize
      • shit + left mouse button
        • M-x から指定できないかな?
    •   Dired
      • M-x dired-other-frame
        • 別ウィンドでdiredを開く
      • C-x d
        • c:/*.txt などのフィルタを使用できる
      • RET, e, f
        • 確定、ファイルを開く
      • ^
        • 上の階層に移動
      • D
        • 削除
      • C
        • コピー
      • R
        • ファイル名変更
      • +
        • フォルダ作成
      • s
        • ソート
      • g
        • 更新
      • d x
        • 削除
      • m
        • マーキング
      • u
        • マークを外す
      • k
        • マークの付いたファイルを削除
      • B
        • バイトコンパイル
      • z
        • gz圧縮
      • !
        • shell関数実行
      • i
        • サブフォルダ展開

    [メモ]Nemerle, Scheme, Continuation, Factor

    [Nemerle]

    マクロに興味沸いた。仕事で C# だし IronScheme の方が気になるし .NET 系言語はこれ以上さわる気になれないけど気になる。

    [Factor]

    Factor に乗り換えるプログラマーは、Factor のより高位なプログラミング力を手に入れるために、ローカル変数を放棄しなくてはなりません。
    PostScript にはまっているので気になります。

    [Scheme]


      CPS - continuation passing style - 継続渡しスタイル

    継続もマクロもまともに書けません。これじゃダメですね。勉強しよー。

    プログラミングGauche

    2009/10/13

    PostScript入門(2)

    PostScriptを手書きするという荒行の記録(?)。気合や根性や才能じゃない(はずだ)、こういうのはトレーニング(のはず)だ。 ちょうどSICPにリトライ中なので図形言語のところではSchemeでPostScriptのコードを吐きたいな。
    6.2-GraphicState
    ↑ぐるぐるブン回すくらいまではできるようになった。
    ただ写経するだけではおもしろくないなーと思ったのでほんの少しずつ手を加えてみた。参考資料は当記事最下に記載。
    改行の位置とかそういうPostScriptコーディングの文化がとういったものかまだよくわからない。
    stackの状態が良くわからなくなったらGhostScriptで確認してる。stackコマンドでスタックの状態が見れる。

    四角

    3.1-DrawingSquareBox
    newpath           
        270 360 moveto            
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        -72 0 rlineto            
        4 setlinewidth            
    stroke 
        370 360 moveto           
        0 172 rlineto            
        172 0 rlineto            
        0 -172 rlineto            
        -172 0 rlineto            
        32 setlinewidth            
    stroke 
        270 560 moveto           
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        -72 0 rlineto            
        4 setlinewidth            
        closepath            
    stroke 
        370 600 moveto           
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        -72 0 rlineto            
        32 setlinewidth            
        closepath            
    stroke 
    showpage

    座標を確認

    3.2-FilledShapes
    % test moveto           
    newpath            
        /Times-Roman findfont 15 scalefont setfont            
        100 0 moveto            
        ((100,0)) show            
        0 100 moveto            
        ((0,100)) show            
        100 100 moveto            
        ((100,100)) show
    
    座標がどうなってるのかわからなかったのでお試し。
    x軸 y軸 moveto
    というようなことでよさそうですね。

    色の違う四角形を描画

    3.2-FilledShapes
    % step by step Draw Box           
    newpath            
        100 100 moveto            
        0 72 rlineto            
        closepath            
        fill            
    newpath            
        100 200 moveto            
        0 72 rlineto            
        72 0 rlineto            
        closepath            
        fill            
    newpath            
        100 300 moveto            
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        closepath            
        fill            
    newpath            
        100 400 moveto            
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        closepath            
        .5 setgray            
        fill            
    newpath            
        100 500 moveto            
        0 72 rlineto            
        72 0 rlineto            
        0 -72 rlineto            
        closepath            
        .9 setgray            
        fill

    四角形を描画するプロシージャを定義してみる

    3.2-FilledShapes
    % draw Boxies with procedure           
    /box            
    {            
        72 0 rlineto            
        0 72 rlineto            
        -72 0 rlineto            
        closepath            
    } def 
    newpath           
        352 324 moveto box            
        0 setgray fill            
    newpath            
        370 360 moveto box            
        .4 setgray fill            
    newpath            
        388 396 moveto box            
        .8 setgray fill

    なんか三角形が書けそうだったので

    3.2-FilledShapes
    /delta           
    {            
        0 72 rlineto            
        72 0 rlineto            
        closepath            
    } def            
    newpath            
        352 424 moveto delta            
        0 setgray fill            
    newpath            
        370 460 moveto delta            
        .4 setgray fill            
    newpath            
        388 496 moveto delta            
        .8 setgray fill            
        388 496 moveto            
        0 setgray            
        /Times-Roman findfont 15 scalefont setfont            
        (delta) show 
    /delta2           
    {            
        72 0 rlineto            
        0 72 rlineto            
        closepath            
    } def 
    newpath           
        252 424 moveto delta2            
        0 setgray fill            
    newpath            
        270 460 moveto delta2            
        .4 setgray fill            
    newpath            
        288 496 moveto delta2            
        .8 setgray fill 
        288 496 moveto           
        0 setgray            
        /Times-Roman findfont 15 scalefont setfont            
        (delta 2) show            
    showpage

    もひとつプロシージャ

    4.3-UsingProceduresAndVariables
    newpath 
    100 100 newpath moveto           
    0 300 rlineto            
    stroke 
    newpath 
    /inch           
    {            
        72 mul            
    } def 
    /box           
    {            
        newpath            
        moveto            
        1 inch 0 rlineto            
        0 1 inch rlineto            
        -1 inch 0 rlineto            
        closepath            
    } def 
    /fillbox           
    {            
        setgray fill            
    } def 
    3.5 inch 4.5 inch box           
    0 fillbox            
    3.75 inch 5 inch box            
    .4 fillbox            
    4 inch 5.5 inch box            
    .8 fillbox 
    showpage

    文字列の描画

    5.1-DrawString-2
    % vertical position           
    /vpos 720 def            
    % drawing string            
    /word (Typefaces) def 
    /choosefont           
    {            
        findfont 15 scalefont setfont            
    } def 
    /newline           
    {            
        % decrease vpos            
        % side effect            
        /vpos vpos 15 sub def            
        % goto that line            
        72 vpos moveto            
    } def 
    /printword           
    {            
        choosefont            
        % show "typefaces"            
        word show            
        % go to next line            
        newline            
    } def 
    72 vpos moveto           
    /Times-Roman printword            
    /Times-Bold printword            
    /Times-Italic printword            
    /Times-BoldItalic printword            
    newline 
    /Helvetica printword           
    /Helvetica-Bold printword            
    /Helvetica-Oblique printword            
    /Helvetica-BoldOblique printword            
    newline 
    /Courier printword           
    /Courier-Bold printword            
    /Courier-Oblique printword            
    /Courier-BoldOblique printword            
    newline 
    /Symbol printword           
    showpage
    5.1-DrawString

    /Times-Roman findfont 15 scalefont setfont           
    72 200 moveto            
    (typography) show 
    /showGorilla           
    {            
        moveto            
        (Gorilla) show            
    } def 
    /Times-Roman findfont 6 scalefont setfont           
    72 300 showGorilla 
    /Times-Roman findfont 10 scalefont setfont           
    72 275 showGorilla 
    /Times-Roman findfont 15 scalefont setfont           
    72 250 showGorilla 
    /Times-Roman findfont 20 scalefont setfont           
    72 225 showGorilla 
    /scaleTimes           
    {            
        /Times-Roman findfont            
        exch scalefont            
        setfont            
    } def 
    6 scaleTimes           
    172 300 showGorilla            
    10 scaleTimes            
    172 275 showGorilla            
    15 scaleTimes            
    172 250 showGorilla            
    25 scaleTimes            
    172 225 showGorilla 
    /draw           
    {            
        172 exch showGorilla            
    } def 
    6 scaleTimes           
    400 draw            
    10 scaleTimes            
    375 draw            
    15 scaleTimes            
    350 draw            
    25 scaleTimes            
    325 draw 
    showpage

    文字列と図形

    5.2-GraphicsAndText
    /choosefont           
    {            
        exch findfont exch scalefont            
    } def 
    /MainFont           
    {            
        /Helvetica-Bold 15 choosefont            
    } def 
    /SloganFont           
    {            
        /Helvetica-Oblique 7 choosefont            
    } def 
    /OwnerFont           
    {            
        /Helvetica 10 choosefont            
    } def 
    /rightshow           
    {            
        dup stringwidth pop            
        120 exch sub            
        0 rmoveto            
        show            
    } def 
    /CardOutline           
    {            
        newpath            
        90 90 moveto            
        0 144 rlineto            
        252 0 rlineto            
        0 -144 rlineto            
        closepath            
        .5 setlinewidth            
        stroke            
    } def 
    /doBorder           
    {            
        99 99 moveto            
        0 126 rlineto            
        234 0 rlineto            
        0 -126 rlineto            
        closepath            
        2 setlinewidth            
        stroke            
    } def 
    /Diamond           
    {            
        newpath            
        207 216 moveto            
        36 -54 rlineto            
        -36 -54 rlineto            
        -36 54 rlineto            
        closepath            
        .8 setgray fill            
    } def 
    /doText           
    {            
        0 setgray            
        90 180 moveto            
        MainFont setfont            
        (Diamond Cafe) rightshow            
        90 168 moveto            
        SloganFont setfont            
        ("The Club of Lonely Hearts") rightshow            
        216 126 moveto            
        OwnerFont setfont            
        (Sam Spade) show            
        216 111 moveto            
        (Owner) show            
    } def 
    CardOutline           
    doBorder            
    Diamond            
    doText 
    newpath           
    10 10 moveto            
    (string1) show            
    (string2) rightshow            
    (string3) rightshow            
    (string4) rightshow 
    showpage

    回転

    6.1-CoordinateSystems
    /choosefont           
    {            
        exch findfont exch scalefont setfont            
    } def 
    /Times-Roman 30 choosefont 
    /square           
    {            
        newpath            
        0 0 moveto            
        90 0 lineto            
        90 90 lineto            
        0 90 lineto            
        closepath            
        fill            
        6 92 moveto            
        (A Box) show            
    } def 
    /slide           
    {            
        300 150 translate            
        60 rotate            
    } def 
    square 
    slide           
    .5 setgray            
    1.5 1.5 scale            
    square 
    slide           
    .7 setgray            
    .75 1.25 scale            
    square 
    showpage

    6.2-GraphicState
    /starside{           
        72 0 lineto            
        currentpoint translate            
        -144 rotate            
    } def 
    /star{           
        moveto            
        currentpoint translate            
        %4 {starside} repeat            
        %closepath            
        5 {starside} repeat            
        gsave            
        .5 setgray            
        fill            
        grestore            
        stroke            
    } def 
    200 200 star 
    /cycling{           
        15 {            
            30 30 star            
            30 rotate            
        } repeat            
    } def 
    /drawing{           
        5 {            
            30 -30 translate            
            cycling            
        } repeat            
    } def 
    drawing 
    showpage


    とりあえず今日はここまで。英語読むのもしんどいし。読み進めてるのはこちらの青本。
    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 で詳細を見る