Created
January 30, 2015 12:18
-
-
Save kinoshita-lab/d39dc905f56874f9fd9b to your computer and use it in GitHub Desktop.
sicp 2.49-d
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;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