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)
こんなんできました
絵柄的には似てるっぽい？
