More progress. Got up to 2.65

This commit is contained in:
Emin Arslan
2025-01-16 20:06:34 +03:00
parent 93fe63d683
commit ce27776d82
4 changed files with 379 additions and 0 deletions

View File

@ -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)))))