building a GUI rectangle builder: I have a little bug.

24 views
Skip to first unread message

KOKOU AFIDEGNON

unread,
Nov 23, 2020, 4:44:17 AM11/23/20
to Racket Users
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))
```

KOKOU AFIDEGNON

unread,
Nov 23, 2020, 6:45:13 AM11/23/20
to Racket Users
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)
```
Reply all
Reply to author
Forward
0 new messages