summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ex/2/49.rkt1
-rw-r--r--ex/2/52.rkt80
2 files changed, 81 insertions, 0 deletions
diff --git a/ex/2/49.rkt b/ex/2/49.rkt
index b231318..e6d10f7 100644
--- a/ex/2/49.rkt
+++ b/ex/2/49.rkt
@@ -5,6 +5,7 @@
(provide
frame-coord-map
paint
+ segments->painter
wave->painter
x->painter)
diff --git a/ex/2/52.rkt b/ex/2/52.rkt
new file mode 100644
index 0000000..92fcf08
--- /dev/null
+++ b/ex/2/52.rkt
@@ -0,0 +1,80 @@
+;;;; License: CC0-1.0
+
+#lang racket
+
+(require "46.rkt")
+(require "48.rkt")
+(require "49.rkt")
+
+(define (wavex->painter)
+ (let* ((h-ls (make-vect 0.426 0.000)) ; head - left start
+ (h-le (make-vect 0.349 0.164)) ; head - left end
+ (h-rs (make-vect 0.505 0.000)) ; head - right start
+ (h-re (make-vect 0.577 0.165)) ; head - right end
+ (n-le (make-vect 0.434 0.287)) ; neck - left end
+ (n-re (make-vect 0.499 0.283)) ; neck - right end
+
+ (m-ls (make-vect 0.440 0.230)) ; mouth - left start
+ (m-le (make-vect 0.462 0.260)) ; mouth - left end
+ (m-rs (make-vect 0.475 0.230)) ; mouth - right start
+
+ (sh-le (make-vect 0.302 0.288)) ; shoulder - left end
+ (sh-re (make-vect 0.620 0.290)) ; shoulder - right end
+
+ (lh-ts (make-vect 0.000 0.200)) ; left hand - top start
+ (lh-te (make-vect 0.257 0.400)) ; left hand - top end
+ (lh-bs (make-vect 0.000 0.316)) ; left hand - bottom start
+ (lh-be (make-vect 0.296 0.533)) ; left hand - bottom end
+
+ (uat-ls sh-le) ; upper arm top - left start
+ (uat-le lh-te) ; upper arm top - left end
+ (uab-ls (make-vect 0.398 0.371)) ; upper arm bottom - left end
+ (uab-le lh-be) ; upper arm bottom - left end
+
+ (uat-rs sh-re) ; upper arm top - right start
+ (uat-re (make-vect 1.000 0.550)) ; upper arm top - right end
+ (uab-rs (make-vect 1.000 0.660)) ; upper arm bottom - right start
+ (uab-re (make-vect 0.563 0.376)) ; upper arm bottom - right end
+
+ (wll-os uab-ls) ; waist left leg - outside start
+ (wll-oe (make-vect 0.290 1.000)) ; waist left leg - outside end
+ (wll-is (make-vect 0.490 0.642)) ; waist left leg - inside start
+ (wll-ie (make-vect 0.384 1.000)) ; waist left leg - inside end
+
+ (wrl-os uab-re) ; waist right leg - outside start
+ (wrl-oe (make-vect 0.730 1.000)) ; waist right leg - outside end
+ (wrl-is wll-is) ; waist right leg - inside start
+ (wrl-ie (make-vect 0.650 1.000))) ; waist right leg - inside end
+ (segments->painter
+ (list
+ ;; head
+ (make-segment h-ls h-le)
+ (make-segment h-rs h-re)
+ (make-segment h-le n-le)
+ (make-segment h-re n-re)
+
+ ;; neck
+ (make-segment n-le sh-le)
+ (make-segment n-re sh-re)
+
+ ;; mouth
+ (make-segment m-ls m-le)
+ (make-segment m-le m-rs)
+
+ ;; left hand
+ (make-segment lh-ts lh-te)
+ (make-segment lh-bs lh-be)
+
+ ;; upper arm left
+ (make-segment uat-ls uat-le)
+ (make-segment uab-ls uab-le)
+
+ ;; upper arm right
+ (make-segment uat-rs uat-re)
+ (make-segment uab-rs uab-re)
+
+ ;; waist - legs
+ (make-segment wll-os wll-oe)
+ (make-segment wll-is wll-ie)
+ (make-segment wrl-os wrl-oe)
+ (make-segment wrl-is wrl-ie)))))