[racket] newb: implementation of select items

I wish to draw onto a canvas, select certain objects using a (repaint
the selected objects red) self-implemented select method, and delete
them (undo if done wrongly) with, small misc. features like zooming in
and out, dragging the canvas to view different areas. I've gotten so
far as mimicking a graphical representation of "selecting", but it
seems awfully laggy. Second, the bounding box of "select" disappears
if the user holds the mouse cursor inert. I can remedy this by placing
the line drawing functions in paint-callback, but i don't know if that
would be a good idea to do it with a flag (to differentiate between
normal drawing and redrawing selected items) Also, implementing a
select method seems way more complex than i first thought it would be,
although since now i'm at this point, i can roughly figure out the
next few steps would be.


1. A function to calculate all the bounding areas of currently-drawn
objects, then redraw them in red if their coordinates are within the
bounding box of "select".

2. Redraw all objects without selected items if delete button pressed.


If i am unnecessarily doing anything or looking at the problem the
wrong way, please let me know. Thanks!


#lang racket/gui

(define WIDTH 800)
(define HEIGHT 600)
(define GLOBAL-X-OFFSET 200)
(define GLOBAL-Y-OFFSET 450)
(define X-SCALE 1)
(define Y-SCALE -1)
(define TRANSFORMATION-MATRIX (vector 1 0 0 1 0 0))
(define ROTATION 0)
(define init-x 0)
(define init-y 0)
(define top-frame (new frame%
                         [label "KR"]
                         [width WIDTH]
                         [height HEIGHT]
                         [alignment (list 'left 'top)]))

(define my-canvas%
  (class canvas% ; The base class is canvas%
    ;; Declare overrides:
    (override on-char)
    ;; Define overriding method to handle mouse events
    (define on-char (lambda (event)
                      (let ((key (send event get-key-code)))
                        (case key
                          ['wheel-up    (set! X-SCALE (+ X-SCALE 0.1))
(set! Y-SCALE (- Y-SCALE 0.1))]
                          ['wheel-down  (set! X-SCALE (- X-SCALE 0.1))
(set! Y-SCALE (+ Y-SCALE 0.1))])
                          (send drawer set-transformation (vector
TRANSFORMATION-MATRIX GLOBAL-X-OFFSET GLOBAL-Y-OFFSET X-SCALE Y-SCALE
ROTATION))
                          (send canvas refresh-now))))
    ;; Call the superclass initialization (and pass on all init args)
    (define/override (on-event event)
        (define x (send event get-x))
        (define y (send event get-y))
        (cond
          ((and (send event button-down? 'left) (send event get-control-down))
           (set! init-x x)
           (set! init-y y)
           (display (list y (- init-y GLOBAL-Y-OFFSET))))
          ((and (send event button-up? 'left) (send event get-control-down)))
           ;(send drawer draw-line init-x 0 x 0))
          ((and (send event dragging?) (send event get-control-down))
           (let ((start-x      (/ (- init-x GLOBAL-X-OFFSET) X-SCALE))
                 (start-y      (/ (- init-y GLOBAL-Y-OFFSET) Y-SCALE))
                 (current-x    (/ (- x GLOBAL-X-OFFSET) X-SCALE))
                 (current-y    (/ (- y GLOBAL-Y-OFFSET) Y-SCALE)))
             (send drawer draw-line start-x start-y current-x start-y)
             (send drawer draw-line current-x start-y current-x current-y)
             (send drawer draw-line current-x current-y start-x current-y)
             (send drawer draw-line start-x current-y start-x start-y)))
          ((send event button-down? 'left)
           (set! init-x x)
           (set! init-y y))
          ((send event button-up? 'left)
           (set! GLOBAL-X-OFFSET (vector-ref (send drawer
get-transformation) 1))
           (set! GLOBAL-Y-OFFSET (vector-ref (send drawer
get-transformation) 2)))
          ((send event dragging?)
           (let* ((current-x (- x init-x))
                  (current-y (- y init-y)))
             (send drawer set-transformation (vector
TRANSFORMATION-MATRIX (+ current-x GLOBAL-X-OFFSET) (+ current-y
GLOBAL-Y-OFFSET) X-SCALE Y-SCALE ROTATION))
             (send canvas refresh-now)))))
    (super-instantiate ())))

(new button%
     [label "Select"]
     [parent top-frame])
(new button%
     [label "Select"]
     [parent top-frame])

(define canvas (new my-canvas%
                    [parent top-frame]
                    ;[style (list 'hscroll 'vscroll 'resize-corner)]
                    [paint-callback (lambda (canvas dc)
                                      (define no-brush (new brush%
[style 'transparent]))
                                      (send drawer set-brush no-brush)
                                      (send drawer draw-line 0 0 200 200)
                                      ;(send drawer draw-line 0 0 0 200)
                                      ;(send drawer draw-line 0 200 200 200)
                                      ;(send drawer draw-line 200 200 200 0)
                                      )]))
(define drawer (send canvas get-dc))
(send top-frame show #t)
(send drawer set-transformation (vector TRANSFORMATION-MATRIX
GLOBAL-X-OFFSET GLOBAL-Y-OFFSET X-SCALE Y-SCALE ROTATION))
(sleep/yield 0.1)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20141222/5232d81f/attachment.html>