fix `attach-to`

main
Matthew Butterick 4 years ago
parent de5299441c
commit d709b3bcdf

@ -25,3 +25,8 @@
(map (λ (qe) (loop qe (add1 idx))) (quad-elems q)))) (map (λ (qe) (loop qe (add1 idx))) (quad-elems q))))
(* scaling-factor (+ (- xmax xmin) (* stroke-width 2) (* margin 2))) (* scaling-factor (+ (- xmax xmin) (* stroke-width 2) (* margin 2)))
(* scaling-factor (+ (- ymax ymin) (* stroke-width 2) (* margin 2))))) (* scaling-factor (+ (- ymax ymin) (* stroke-width 2) (* margin 2)))))
(module+ main
(define q1 (make-quad #:size '(25 25)))
(define q2 (make-quad #:size '(15 15)))
(quad->pict (position (attach-to q1 'e q2 'w))))

@ -10,7 +10,7 @@
(define (sum-base qs which) (define (sum-base qs which)
(for/sum ([q (in-list qs)]) (for/sum ([q (in-list qs)])
(which (size q)))) (which (size q))))
(define (sum-y qs) (sum-base qs pt-y)) (define (sum-y qs) (sum-base qs pt-y))
(define (sum-x qs) (sum-base qs pt-x)) (define (sum-x qs) (sum-base qs pt-x))
@ -143,7 +143,9 @@
(define (attach-to from-q from-pt to-q to-pt) (define (attach-to from-q from-pt to-q to-pt)
(quad-update! to-q (quad-update! to-q
[from-parent from-pt] [from-parent from-pt]
[to to-pt])) [to to-pt])
(quad-update! from-q
[elems (cons to-q (quad-elems from-q))]))
(module+ test (module+ test
(require rackunit) (require rackunit)

Loading…
Cancel
Save