gistfile1.txt

$ racket snip.rkt
(object:2d-plot-snip% ... ...)
cpu time: 3 real time: 3 gc time: 0
cpu time: 3 real time: 3 gc time: 0
cpu time: 3 real time: 3 gc time: 0
cpu time: 12 real time: 11 gc time: 0
cpu time: 21 real time: 21 gc time: 12
cpu time: 9 real time: 9 gc time: 0
cpu time: 9 real time: 9 gc time: 0
cpu time: 10 real time: 10 gc time: 0
cpu time: 9 real time: 9 gc time: 0
cpu time: 10 real time: 10 gc time: 0
cpu time: 12 real time: 12 gc time: 0
cpu time: 12 real time: 12 gc time: 0
cpu time: 13 real time: 13 gc time: 0
cpu time: 14 real time: 14 gc time: 0
cpu time: 15 real time: 15 gc time: 0
cpu time: 16 real time: 16 gc time: 0
cpu time: 19 real time: 19 gc time: 1
cpu time: 19 real time: 19 gc time: 0
cpu time: 21 real time: 21 gc time: 0
cpu time: 23 real time: 23 gc time: 0
cpu time: 23 real time: 23 gc time: 0
cpu time: 26 real time: 26 gc time: 0
cpu time: 26 real time: 26 gc time: 0
cpu time: 29 real time: 29 gc time: 0
cpu time: 30 real time: 30 gc time: 0
cpu time: 31 real time: 31 gc time: 0
cpu time: 34 real time: 35 gc time: 0
cpu time: 41 real time: 42 gc time: 0
cpu time: 39 real time: 40 gc time: 0
cpu time: 42 real time: 43 gc time: 0
cpu time: 45 real time: 46 gc time: 0
cpu time: 50 real time: 50 gc time: 0
cpu time: 52 real time: 53 gc time: 0
cpu time: 52 real time: 52 gc time: 0
cpu time: 54 real time: 54 gc time: 0
cpu time: 58 real time: 59 gc time: 0
cpu time: 67 real time: 68 gc time: 0
cpu time: 74 real time: 74 gc time: 0
cpu time: 68 real time: 68 gc time: 0
cpu time: 72 real time: 72 gc time: 0
cpu time: 73 real time: 74 gc time: 0
cpu time: 80 real time: 80 gc time: 0
cpu time: 81 real time: 82 gc time: 0
cpu time: 94 real time: 94 gc time: 0
cpu time: 91 real time: 92 gc time: 0
cpu time: 102 real time: 102 gc time: 0
cpu time: 119 real time: 120 gc time: 0
cpu time: 109 real time: 110 gc time: 0
cpu time: 110 real time: 111 gc time: 0
cpu time: 123 real time: 124 gc time: 5
cpu time: 120 real time: 121 gc time: 0
cpu time: 128 real time: 129 gc time: 0
cpu time: 134 real time: 136 gc time: 0
cpu time: 147 real time: 148 gc time: 0
cpu time: 144 real time: 147 gc time: 0
cpu time: 129 real time: 131 gc time: 0
cpu time: 142 real time: 144 gc time: 0
cpu time: 164 real time: 165 gc time: 0
cpu time: 166 real time: 167 gc time: 0
cpu time: 181 real time: 182 gc time: 0
cpu time: 171 real time: 172 gc time: 0
cpu time: 183 real time: 185 gc time: 0
cpu time: 199 real time: 201 gc time: 0
cpu time: 186 real time: 188 gc time: 0
cpu time: 194 real time: 196 gc time: 0
cpu time: 208 real time: 210 gc time: 0

snip.rkt

#lang racket/base

(require plot
         racket/class
         (prefix-in gui: racket/gui)
         racket/math)

(define snip-canvas%
  (class gui:canvas%
    (init-field snip)
    (inherit get-dc)
    (super-new)

    (send snip resize 400 300)
    (send snip get-extent (get-dc) 0 0)

    (define/override (on-paint)
      (define dc (get-dc))
      (send dc suspend-flush)
      (time (send snip draw dc 0 0 0 0 400 300 0 0 'no-caret))
      (send dc resume-flush))

    (define/override (on-event event)
      (begin0 #f
        (if (send event leaving?)
            (send snip on-goodbye-event (get-dc) 0 0 0 0 event)
            (send snip on-event (get-dc) 0 0 0 0 event))))))

(define snip-editor%
  (class object%
    (super-new)

    (define/public (on-change)
      (void))

    (define/public (set-caret-owner _maybe-snip [_domain 'immediate])
      (void))))

(define snip-admin%
  (class gui:snip-admin%
    (init-field canvas)
    (super-new)

    (define editor (new snip-editor%))
    (define/override (get-editor) editor)

    (define/override (needs-update _s _x _y _w _h)
      (send canvas refresh))
    (define/override (resized _s redraw?)
      (when redraw?
        (send canvas refresh)))))

(define (x s) (sin (+ pi (* s (- (/ pi 30))))))
(define (y s) (cos (+ pi (* s (- (/ pi 30))))))
(define the-snip
  (plot-snip
   (list
    (lines
     (for/list ([s (in-range 0 60)])
       (list s (x s))))
    (lines
     (for/list ([s (in-range 0 60)])
       (list s (y s)))))))

(send the-snip set-mouse-event-callback (λ (snip event x y)
                                          (when x
                                            (send snip set-overlay-renderers (list (vrule x))))))

(define f
  (new gui:frame%
       [label "Example"]
       [width 800]
       [height 600]))

(define c
  (new snip-canvas%
       [parent f]
       [snip the-snip]))

(define a
  (new snip-admin%
       [canvas c]))

(send the-snip set-admin a)
(send f show #t)