#lang racket/gui

 

(define WORLD-W 650)

(define W-W/2 (/ WORLD-W 2))

 

(define pens (new pen-list%))

(define fr (new frame% [label "test"]))

(define canv

  (new canvas%

       [parent fr]

       [min-width WORLD-W]

       [min-height WORLD-W]

       [stretchable-width #f]

       [stretchable-height #f]

       [style '(no-autoclear)]))

(send fr show #t)

 

(define dc (send canv get-dc))

(send* dc

  (set-background "black")

  (set-brush "black" 'transparent))

 

 

(define (dravv fx #:x [x -100] #:dx [dx .1]

               #:tick [tick .01] #:scale [scale #f]

               #:x-range [xr (cons -5 5)])

  (send* dc

    (clear)

    (set-pen (send pens find-or-create-pen

                   (make-object color% 255 255 255 .5) 1 'solid))

    (draw-line 0 W-W/2 WORLD-W W-W/2)

    (draw-line W-W/2 0 W-W/2 WORLD-W)

    (set-pen (send pens find-or-create-pen "green" 1 'solid)))

  (let* ((scale

          (if scale scale

              (let ((sq (quotient (abs x) 2)))

                (if (< 1 sq) sq 1))))

         (limit-x?

          (lambda (x scx) (and (> scx (add1 WORLD-W)) (> x 0))))

         (out-of-range?

          (lambda (x y)

            (or (not (real? x)) (not (real? y))

                (< x 0) (< y 0) (> y WORLD-W))))

         (d-x

          (lambda (x)

            (+ W-W/2 (* scale x))))

         (d-y

          (lambda (x)

            (with-handlers ([exn:fail? void])

              (+ W-W/2 (* scale (- (fx x))))))))

    (let loop ((x x) (path #f))

      (let ((scx (d-x x))

            (scy (d-y x)))        

        (cond ((limit-x? x scx)

               (for/list ((x (in-range

                              (car xr)

                              (add1 (cdr xr)))))

                 (cons x (with-handlers

                             ([exn:fail?

                               (lambda (exn) "n/a")])

                           (fx x)))))

              ((out-of-range? scx scy)

               (loop (+ dx x) #f))

              (path (send path line-to scx scy)

                    (send dc draw-path path)

                    (sleep tick)

                    (loop (+ dx x) path))

              (else

               (let ((pth (new dc-path%)))

                 (send pth move-to scx scy)

                 (loop x pth))))))))