More progress. Got up to 2.65
This commit is contained in:
54
ex-2-40.rkt
54
ex-2-40.rkt
@ -133,6 +133,7 @@
|
||||
(make-vect (* (vect-xcoor v) n)
|
||||
(* (vect-ycoor v) n)))
|
||||
;; 2.47
|
||||
;; a list-of-three representation
|
||||
(define (make-frame1 origin edge1 edge2)
|
||||
(list origin edge1 edge2))
|
||||
(define (frame-origin1 f)
|
||||
@ -142,8 +143,61 @@
|
||||
(define (frame-edge2-1 f)
|
||||
(list-ref f 2))
|
||||
|
||||
; two cons representation
|
||||
(define (make-frame2 origin edge1 edge2)
|
||||
(cons origin (cons edge1 edge2)))
|
||||
(define frame-origin2 car)
|
||||
(define frame-edge1-2 cadr)
|
||||
(define frame-edge2-2 cddr)
|
||||
|
||||
; choose one impl
|
||||
(define origin-frame frame-origin2)
|
||||
(define edge1-frame frame-edge1-2)
|
||||
(define edge2-frame frame-edge2-2)
|
||||
|
||||
;; 2.48
|
||||
;; decided to stop using define-struct for this, as it kinda
|
||||
;; screws with the naming conventions
|
||||
(define make-segment cons)
|
||||
|
||||
(define start-segment car)
|
||||
(define end-segment cdr)
|
||||
|
||||
;; 2.49
|
||||
(define (draw-line x y) #f)
|
||||
(define (frame-coord-map frame)
|
||||
(lambda (v)
|
||||
(add-vect
|
||||
(origin-frame frame)
|
||||
(add-vect (scale-vect (xcoor-vect v) (edge1-frame frame))
|
||||
(scale-vect (ycoor-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)))
|
||||
|
||||
; I really should have thought of making a better
|
||||
; notation for these things, it would have been super easy too.
|
||||
; but I've already written it, so it stays, I guess.
|
||||
(define outline-painter
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0 0) (make-vect 0 1))
|
||||
(make-segment (make-vect 0 0) (make-vect 1 0))
|
||||
(make-segment (make-vect 1 0) (make-vect 1 1))
|
||||
(make-segment (make-vect 0 1) (make-vect 1 1)))))
|
||||
(define x-painter
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0 0) (make-vect 1 1))
|
||||
(make-segment (make-vect 1 0) (make-vect 0 1)))))
|
||||
(define diamond
|
||||
(segments->painter
|
||||
(list (make-segment (make-vect 0.5 0) (make-vect 0 0.5))
|
||||
(make-segment (make-vect 0.5 0) (make-vect 1 0.5))
|
||||
(make-segment (make-vect 0 0.5) (make-vect 0.5 1))
|
||||
(make-segment (make-vect 1 0.5) (make-vect 0.5 1)))))
|
||||
|
Reference in New Issue
Block a user