Skip to content

Instantly share code, notes, and snippets.

@kinoshita-lab
Created January 30, 2015 12:18
Show Gist options
  • Save kinoshita-lab/d39dc905f56874f9fd9b to your computer and use it in GitHub Desktop.
Save kinoshita-lab/d39dc905f56874f9fd9b to your computer and use it in GitHub Desktop.
sicp 2.49-d
;d. waveペインタ
(define (wave-painter frame)
(define vect1 (edge1 frame))
(define vect2 (edge2 frame))
(define z (make-vect 0 0))
(define (make-draw-point-vector vect1 vect2 magnitude-vect1 magnitude-vect2)
(add-vect (scale-vect vect1 magnitude-vect1)
(scale-vect vect2 magnitude-vect2)))
(let ((p1 (make-draw-point-vector z vect2 0 0.33)) ; 右足の先
(p2 (make-draw-point-vector vect1 vect2 0.5 0.35)) ; 右足の付け根
(p3 (make-draw-point-vector vect1 vect2 0.6 0.3)) ; 右脇
(p4 (make-draw-point-vector vect1 vect2 0.45 0.25)) ; 右肘
(p5 (make-draw-point-vector vect1 z 0.75 0)) ; 右手の先-1
(p6 (make-draw-point-vector vect1 z 0.8 0)) ; 右手の先-2
(p7 (make-draw-point-vector vect1 vect2 0.6 0.25)) ; 右ひじ内側
(p8 (make-draw-point-vector vect1 vect2 0.7 0.3)) ; 右肩
(p9 (make-draw-point-vector vect1 vect2 0.7 0.4)) ; 右首
(p10 (make-draw-point-vector vect1 vect2 0.8 0.35)) ; 右耳
(p11 (make-draw-point-vector vect1 vect2 1.0 0.45)) ; 右頭てっぺん
(p12 (make-draw-point-vector vect1 vect2 1.0 0.55)) ; 左頭てっぺん
(p13 (make-draw-point-vector vect1 vect2 0.8 0.65)) ; 左耳
(p14 (make-draw-point-vector vect1 vect2 0.7 0.6)) ; 左首
(p15 (make-draw-point-vector vect1 vect2 0.7 0.7)) ; 左肩
(p16 (make-draw-point-vector vect1 z 0.4 0)) ;; 左手の先-1
(p17 (make-draw-point-vector vect1 z 0.2 0)) ;; 左手の先-2
(p18 (make-draw-point-vector vect1 vect2 0.5 0.6)); 左わき
(p19 (make-draw-point-vector z vect2 0 0.65)) ; 左足の先
(p20 (make-draw-point-vector z vect2 0 0.6)) ; 股-1
(p21 (make-draw-point-vector vect1 vect2 0.2 0.5)) ; 股-2
(p22 (make-draw-point-vector z vect2 0 0.3))) ; 股-3
(segments->painter
(list (list p1 p2) ; 線その1
(list p2 p3)
(list p3 p4)
(list p4 p5)
(list p6 p7) ; 線その2
(list p7 p8)
(list p8 p9)
(list p9 p10)
(list p10 p11)
(list p12 p13) ; 線その3
(list p13 p14)
(list p14 p15)
(list p15 p16)
(list p16 p17)
(list p17 p18)
(list p18 p19)
(list p20 p21) ;線その4
(list p21 p22)))))
(wave-painter f1)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment