読者です 読者をやめる 読者になる 読者になる

牌語備忘録 -pygo

あくまでもメモです。なるべくオフィシャルの情報を参照してください。

牌語備忘録 -pygo

2.2.4 Example: A Picture LanguageをPythonでやってみた...けどできなかったからPythonで絵を描いてみた(||゚Д゚)

SICP Python

2.2.4 Example: A Picture Language でグラフィック扱うから下準備してみた - 牌語備忘録 - pygoの続き


SICP元のコードもよく理解できなかったから、あの有名なhigepon氏のコードを一部参考というか勝手にお借りして、とりあえずschemeでやってみた。

scheme

途中までSICPからそのまま。それ以降は、拝借したコードと少し手を加えたもの。

;2.2.4  Example: A Picture Language
;The picture language

;Frames
(define (frame-coord-map frame)
  (lambda (v)
    (add-vect
     (origin-frame frame)
     (add-vect (scale-vect (xcor-vect v)
                           (edge1-frame frame))
               (scale-vect (ycor-vect v)
                           (edge2-frame frame))))))

;Painters
(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))


(define (segments->painter segment-list)
  (lambda (frame)
    (for-each
     (lambda (segment)
       (draw-line
        ((frame-coord-map frame) (start-segment segment))
        ((frame-coord-map frame) (end-segment segment))))
     segment-list)))

;Transforming and combining painters
(define (transform-painter painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
         (make-frame new-origin
                     (sub-vect (m corner1) new-origin)
                     (sub-vect (m corner2) new-origin)))))))

(define (flip-vert painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)   ; new origin
                     (make-vect 1.0 1.0)   ; new end of edge1
                     (make-vect 0.0 0.0))) ; new end of edge2

(define (shrink-to-upper-right painter)
  (transform-painter painter
                     (make-vect 0.5 0.5)
                     (make-vect 1.0 0.5)
                     (make-vect 0.5 1.0)))

(define (rotate90 painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 0.0)))

(define (squash-inwards painter)
  (transform-painter painter
                     (make-vect 0.0 0.0)
                     (make-vect 0.65 0.35)
                     (make-vect 0.35 0.65)))

(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.0)
                              (make-vect 0.5 1.0))))
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

;;;Mr.higepon's code.
;;;Frames
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
 (car (cdr frame)))

(define (edge2-frame frame)
  (car (cdr (cdr frame))))

;;;Painters
(define (make-vect x y)
  (cons x y))

(define (xcor-vect v)
  (car v))

(define (ycor-vect v)
  (cdr v))

(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
             (+ (ycor-vect v1) (ycor-vect v2))))

(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
             (- (ycor-vect v1) (ycor-vect v2))))

(define (scale-vect s v)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

(define (rotate270 painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

(define (below painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))
;;; segment
(define (make-segment p1 p2)
  (cons p1 p2))

(define (start-segment s)
  (car s))

(define (end-segment s)
  (cdr s))

;;;main
(define frame
  (make-frame (make-vect 0 0)
              (make-vect 1 0)
              (make-vect 0 1)))

;;Hereafter, some was changed. 
(define (draw-line p1 p2)
  (define (t z)
    (- (* 2 z) 1))
  (gl-vertex (t (car p1)) (t (cdr p1)))
  (gl-vertex (t (car p2)) (t (cdr p2)))
  )

(define segments (list
                  (make-segment (cons 0.0 0.0) (cons 0.2 1.0))
                  (make-segment (cons 0.2 1.0) (cons 0.3 0.8))
                  (make-segment (cons 0.3 0.8) (cons 0.7 0.8))
                  (make-segment (cons 0.7 0.8) (cons 0.8 1.0))
                  (make-segment (cons 0.8 1.0) (cons 1.0 0.0))
                  (make-segment (cons 0.4 0.6) (cons 0.3 0.6))
                  (make-segment (cons 0.3 0.6) (cons 0.3 0.5))
                  (make-segment (cons 0.3 0.5) (cons 0.4 0.5))
                  (make-segment (cons 0.8 0.6) (cons 0.7 0.6))
                  (make-segment (cons 0.7 0.6) (cons 0.7 0.5))
                  (make-segment (cons 0.7 0.5) (cons 0.8 0.5))
                  (make-segment (cons 0.7 0.4) (cons 0.4 0.4))
                  (make-segment (cons 0.4 0.4) (cons 0.4 0.3))
                  ))

(use gl)
(use gl.glut)

(define (main args)
  (glut-init args)
  (glut-init-display-mode GLUT_RGBA)
  (glut-create-window "2.2.4  Example: A Picture Language")
  (glut-display-func display)
  (init)
  (glut-main-loop))

(define (display)
  (define petitdevil
    (segments->painter segments))
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 0.0 0.0 0.0)
  (gl-begin GL_LINES)
  ((square-limit petitdevil 4) frame)
  (gl-end)
  (gl-flush)
  )

(define (init)
  (gl-clear-color 1.0 1.0 1.0 1.0)
  )

結果

かなり時間掛かってpainterが手続き?だということが理解できた(||゚Д゚)。
ただ、Pythonで書くときに手続きを戻り値に渡す方法?がうまく思いつかないなぁ。


そして保留

いろいろやってみたけどPythonでうまくいかなかった(||゚Д゚)。
時間かかりそうなのでとりあえず保留。諦めないけど、たぶん(´・ω・`)


おまけ

なんとなくPythonのタートルグラフィックで絵を描いてみた。

from turtle import*

pict = [[0.0, 0.0], [0.2, 1.0],[0.2, 1.0], [0.3, 0.8],[0.3, 0.8], [0.7, 0.8],[0.7, 0.8], [0.8, 1.0],[0.8, 1.0], [1.0, 0.0],[0.4, 0.6], [0.3, 0.6],[0.3, 0.6], [0.3, 0.5],[0.3, 0.5], [0.4, 0.5],[0.8, 0.6], [0.7, 0.6],[0.7, 0.6], [0.7, 0.5],[0.7, 0.5], [0.8, 0.5],[0.7, 0.4], [0.4, 0.4],[0.4, 0.4], [0.4, 0.3]]

def draw_pict(point1, point2):
    count = 0
    for v in pict:
        if count % 2:
            down()
        else:
            up()
        count += 1
        goto(v[0] * point1, v[1] * point2)

def main(size):
    clear()
    tracer(False)
    color(0, 0.5, 0)
    draw_pict(size, size)
    draw_pict(size * -1, size)
    draw_pict(size, size * -1)
    draw_pict(size * -1, size * -1)

if __name__  == "__main__":
    main(200)

こんなんできました

絵柄的には似てるっぽい?