summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsiddharth <s@ricketyspace.net>2022-05-15 12:09:16 -0400
committersiddharth <s@ricketyspace.net>2022-05-15 12:09:16 -0400
commit4c25f34bf8890733b87e46eb8879c08aecd1c0b7 (patch)
tree4c13079a00d60fae75bcd92b690aedbd7ca989bc
parent1b344a4cf4481dc41b5dab81d9cbb2e44aca43ee (diff)
ex: 2.49: implement outline, x, and diamond painters
Using `segment->painter`.
-rw-r--r--ex/2/47.rkt5
-rw-r--r--ex/2/49.rkt85
2 files changed, 89 insertions, 1 deletions
diff --git a/ex/2/47.rkt b/ex/2/47.rkt
index 1d2abd3..ee6e7b1 100644
--- a/ex/2/47.rkt
+++ b/ex/2/47.rkt
@@ -3,7 +3,10 @@
#lang racket
(provide make-frame
- make-frame-alt)
+ make-frame-alt
+ origin-frame
+ edge1-frame
+ edge2-frame)
(require "46.rkt")
diff --git a/ex/2/49.rkt b/ex/2/49.rkt
new file mode 100644
index 0000000..f98364e
--- /dev/null
+++ b/ex/2/49.rkt
@@ -0,0 +1,85 @@
+;;;; License: CC0-1.0
+
+#lang racket
+
+(require racket/draw)
+(require racket/snip)
+
+(require "46.rkt")
+(require "47.rkt")
+(require "48.rkt")
+
+(define dc #f) ; drawing context. gets initialized by paint function.
+
+
+(define (draw-line v1 v2)
+ (let ((x1 (xcor-vect v1))
+ (y1 (ycor-vect v1))
+ (x2 (xcor-vect v2))
+ (y2 (ycor-vect v2)))
+ (send dc draw-line x1 y1 x2 y2)))
+
+
+(define (paint painter)
+ (let ((frame (make-frame (make-vect 250 250)
+ (make-vect 500 0)
+ (make-vect 0 500)))
+ (target (make-bitmap 1000 1000)))
+ (set! dc (new bitmap-dc% (bitmap target)))
+ (painter frame)
+ (make-object image-snip% target)))
+
+
+(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))))))
+
+
+(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)))
+
+
+(define (outline->painter)
+ (let ((v-tl (make-vect 0 0)) ; top left
+ (v-tr (make-vect 1 0)) ; top right
+ (v-br (make-vect 1 1)) ; bottom right
+ (v-bl (make-vect 0 1))) ; bottom left
+ (segments->painter
+ (list (make-segment v-tl v-tr)
+ (make-segment v-tr v-br)
+ (make-segment v-br v-bl)
+ (make-segment v-bl v-tl)))))
+
+
+(define (x->painter)
+ (let ((v-tl (make-vect 0 0)) ; top left
+ (v-tr (make-vect 1 0)) ; top right
+ (v-br (make-vect 1 1)) ; bottom right
+ (v-bl (make-vect 0 1))) ; bottom left
+ (segments->painter
+ (list (make-segment v-tl v-br)
+ (make-segment v-tr v-bl)))))
+
+
+(define (diamond->painter)
+ (let ((v-mt (make-vect 0.5 0)) ; midpoint top
+ (v-mr (make-vect 1 0.5)) ; midpoint right
+ (v-mb (make-vect 0.5 1)) ; midpoint bottom
+ (v-ml (make-vect 0 0.5))) ; midpoint left
+ (segments->painter
+ (list (make-segment v-mt v-mr)
+ (make-segment v-mr v-mb)
+ (make-segment v-mb v-ml)
+ (make-segment v-ml v-mt)))))