fix geometry bug reported by Will Byrd

task-6.rkt

@@ -9,9 +9,10 @@
 (struct circle (x y d action) #:transparent)
 
 (define (draw-1-circle dc brush c)
-  (send dc set-brush brush)
   (match-define (circle x y d _a) c)
-  (send dc draw-ellipse x y d d))
+  (send dc set-brush brush)
+  (define r (/ d 2))
+  (send dc draw-ellipse (- x r) (- y r) d d))
 
 (define *circles '())
 
@@ -46,7 +47,12 @@
         (set!-values (*circles *history) (values (cons fst (rest *circles)) (rest *history))))))
 
 (define (the-closest xm ym (circles *circles))
-  (argmin (distance xm ym) circles))
+  (define cdistance (distance xm ym))
+  (define-values (good-circles distance*)
+    (for*/fold ([good-circles '()][distance* '()])
+               ((c circles) (d (in-value (cdistance c))) #:when (< d (/ (circle-d c) 2)))
+      (values (cons c good-circles) (cons d distance*))))
+  (and (cons? distance*) (first (argmin second (map list good-circles distance*)))))
 
 (define (is-empty-area xm ym (circles *circles))
   (define dist (distance xm ym))
@@ -81,7 +87,7 @@
           [(eq? 'leave type) (set! *x #f)]
           [(eq? 'enter type) (set! *x 0)]
           [(and (eq? 'left-down type) (is-empty-area *x *y)) (add-circle! *x *y)]
-          [(and (eq? 'right-down type) (cons? *circles)) (lock) (popup-adjuster (the-closest *x *y))])
+          [(and (eq? 'right-down type) (the-closest *x *y)) => (λ (tc) (lock) (popup-adjuster tc))])
         (paint-callback this 'y)))
 
     (define (paint-callback _self _evt)