*please, disregard the previous email, there was a little bug. this is the
correct code. the issue still exists. *

I can click to drag in order to draw a rectangle, but when i drag the
created rectangle (for position adjustment), a new rectangle is created
from the said position. How do i constrain/fix the issue? i have been
trying to use key-combination to draw a new rectangle on demand. How do i
fix it ?

```
#lang racket/gui

(define (maybe-set-box! b v)
  (when b
    (set-box! b v)))



(define rect-snip-class%
  (class snip-class%
    (inherit set-classname)
    (super-new)

    (set-classname "rect-snip-class%")
    ))


(define rect-snip-class (new rect-snip-class%))

(define rect-snip%
  (class snip%
    (inherit set-snipclass
             set-flags get-flags
             get-admin)
    (init w h)
    (super-new)
    (set-snipclass rect-snip-class)
    (define height h)
    (define width w)

    (define/override (get-extent dc x y [w #f] [h #f] . _)
      (maybe-set-box! w width)
      (maybe-set-box! h height))

    (define/override (draw dc x y left top right bottom . _)
      (send dc draw-rectangle x y width height))
    ))



(define pb
  (new
   (class pasteboard%
     (super-new)
     (inherit insert)

     (define start-pos #f)

     (define/override (on-default-event event)
       (super on-default-event event)
       (define x (send event get-x))
       (define y (send event get-y))
       (cond
         [(and (equal? (send event get-event-type) 'left-down)
               (send event button-down? 'left)
               (not (send event dragging?)))
          (set! start-pos (cons x y))]
         [(and (equal? (send event get-event-type) 'left-up)
               start-pos)
          (let ([dx (- (car start-pos) x)]
                [dy (- (cdr start-pos) y)])
            (define-values (nx nw)
              (if (> dx 0)
                  (values x dx)
                  (values (+ x dx) (abs dx))))
            (define-values (ny nh)
              (if (> dy 0)
                  (values y dy)
                  (values (+ y dy) (abs dy))))
            (define sn (new rect-snip%
                            [w nw]
                            [h nh]))
            (insert sn nx ny)
            (set! start-pos #f))]))


     )))

(define f-main (new frame% [label "wireframe"]))
(define cnv-main (new editor-canvas%
                      [editor pb]
                      [parent f-main]))


(send f-main show #t)
```

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit 
https://groups.google.com/d/msgid/racket-users/CAGcmBVVWXxnAYqYt49O-JmW-AZYP-vMYyHeXrRPRa7%3DWRDY46w%40mail.gmail.com.

Reply via email to