please disregard the previous code. this si the correct code

```
#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)
```

On Mon, Nov 23, 2020 at 9:43 AM KOKOU AFIDEGNON <kokou.afideg...@gmail.com>
wrote:

> 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. can you
> please give a hint?
> ```
> #lang racket
> (require racket/gui racket/draw pict)
>
>
>
>
> (define my-pasteboard (class* pasteboard% ()
>                         (init)
>                         (super-new)
>                         (define/override (on-default-event evt)
>      (new-rect evt))))
>
>
>
> (define board (new pasteboard%))
> (define toplevel (new frame%
>                       [label "My board"]
>                       [width 500]
>                       [height 500]))
>
> (define canvas (new editor-canvas%
>                     [parent toplevel]
>                     [editor board]))
> (send toplevel show #t)
>
> (define my-snip-class
>   (new (class snip-class%
>          (super-new)
>          (send this set-classname "my-snip"))))
>
> (send (get-the-snip-class-list) add my-snip-class)
>
> (define rectangle-snip%
>   (class snip%
>     (init-field w h)
>     (super-new)
>     (send this set-snipclass my-snip-class)
>     (define/override (get-extent dc x y width height . other)
>       (when width (set-box! width w))
>       (when height (set-box! height h)))
>     (define/override (draw dc x y . other)
>       (draw-pict (rectangle w h) dc x y))))
>
>
> (define (new-rect) (send my-pasteboard insert (new rectangle-snip% [w 30]
> [h 80]) 100 300))
> ```
>

-- 
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/CAGcmBVWuESZp_C800ANz17biq1mnsWjJobHM15AHtCkjrc59Ag%40mail.gmail.com.

Reply via email to