[racket] Picts in DrRacket

Yes, I think this is the right approach, too.

Robby


On Mon, Mar 24, 2014 at 3:40 PM, Matthew Flatt <mflatt at cs.utah.edu> wrote:

> Probably something like this function belongs in `pict`:
>
> ;; smoothed : pict -> pict
> ;;  Produces a pict like `p`, but that always draws in
> ;;  'smoothed mode
> (define (smoothed p)
>   (define draw-p (make-pict-drawer p))
>   (define p2
>     (dc (lambda (dc x y)
>           (define s (send dc get-smoothing))
>           (send dc set-smoothing 'smoothed)
>           (draw-p dc x y)
>           (send dc set-smoothing s))
>         (pict-width p)
>         (pict-height p)))
>   (make-pict (pict-draw p2)
>              (pict-width p)
>              (pict-height p)
>              (pict-ascent p)
>              (pict-descent p)
>              (list p)
>              #f
>              (pict-last p)))
>
> At Mon, 24 Mar 2014 21:00:37 +0100, Jens Axel Søgaard wrote:
> > Hi all,
> >
> > DrRacket draws pict values in REPL. It seems DrRacket uses the
> > smoothing mode 'aligned.
> >
> > Is there a way to change this to 'smooth ?
> >
> > Below is a program that draws graphs of functions of a single variable
> > using Bezier curves.
> > It turns out that the Bezier curves doesn't fit together nicely when
> > the smoothing mode
> > 'aligned is used. On the bitmap version below this results in a
> > slightly jagged appearance.
> > If rendered to pdf, it becomes painfully obvious when you zoom.
> >
> > If on the other 'smooth is used everything fits nicely together.
> >
> > [Does 'aligned move all control points?]
> >
> > The program below draws the graph of x^2 in two ways: The first use
> DrRacket to
> > convert a pict to bitmap without touching the smoothing mode, the second
> > explicitly set smoothing to 'smooth.
> >
> > #lang racket
> > (require racket/draw pict)
> >
> > (define (f x)     (* x x))
> > (define (df/dx x) (* 2 x))
> >
> > (struct pt  (x y) #:transparent)              ; point
> > (struct vec (x y) #:transparent)              ; vector
> > (struct bez (p0 p1 p2 p3) #:transparent)      ; Bezier curve
> >
> > (define (vec* k v) ; multiply vector v with constant k
> >   (vec (* k (vec-x v)) (* k (vec-y v))))
> >
> > (define (pt+ p v)  ; add vector v to point p
> >   (pt (+ (pt-x p) (vec-x v)) (+ (pt-y p) (vec-y v))))
> >
> >
> > (define (draw-bezs dc bs) ; assumes the end and start points of each
> curve match
> >   (define p (new dc-path%))
> >   (match-define (list b0 b. ...) bs)
> >   (match-define (bez (pt x0 y0) (pt x1 y1) (pt x2 y2) (pt x3 y3)) b0)
> >   (send p move-to x0 y0)
> >   (send p curve-to x1 y1 x2 y2 x3 y3)
> >   (for ([b b.])
> >     (match-define (bez (pt x0 y0) (pt x1 y1) (pt x2 y2) (pt x3 y3)) b)
> >     (send p curve-to x1 y1 x2 y2 x3 y3))
> >   (send dc draw-path p))
> >
> > (define (graph #:samples [n 200])
> >   (define-values (xmin xmax ymin ymax) (values -1 1 -1 1))
> >   (define ε 1.0e-10)
> >   (define (φ x) (pt x (f x)))      ; x -> (x,f(x))
> >   (define (τ x) (vec 1 (df/dx x))) ; vector along tangent
> >   (define Δx (/ (- xmax xmin) n))
> >   (define x0 xmin)
> >   (define (xi i) (+ x0 (* i Δx)))
> >   (define bs (for/list ([i (in-range 0 (+ n 1))])
> >                (define x0 (xi i))
> >                (define x3 (xi (+ i 1)))
> >                ; See page 7 of:
> >                ;
> http://www.math.ubc.ca/~cass/graphics/manual/pdf/ch6.pdf
> >                (bez (φ x0)
> >                     (pt+ (φ x0) (vec* (/ Δx  3) (τ x0)))
> >                     (pt+ (φ x3) (vec* (/ Δx -3) (τ x3)))
> >                     (φ x3))))
> >   ; return pict that draws the Bezier curves
> >   (dc (lambda (dc x y)
> >         (define-values (old-x0 old-y0)           (send dc get-origin))
> >         (define-values (old-scale-x old-scale-y) (send dc get-scale))
> >         (define old-pen    (send dc get-pen))
> >         (send dc set-origin 200 200)
> >         (send dc set-scale 200 -200)
> >         (send dc set-pen "black" 0 'solid)
> >         (draw-bezs dc bs)
> >         (send dc set-pen    old-pen)
> >         (send dc set-scale  old-scale-x old-scale-y)
> >         (send dc set-origin old-x0 old-y0))
> >       400 400))
> >
> > (define bm (make-object bitmap% 400 400))
> > (define bm-dc (new bitmap-dc% [bitmap bm]))
> > (send bm-dc set-smoothing 'smoothed)
> >
> > (define p (graph #:samples 100))
> > (draw-pict p bm-dc 0 0)
> >
> > (list p bm)
> >
> >
> > --
> > Jens Axel Søgaard
> >
> > ____________________
> >   Racket Users list:
> >   http://lists.racket-lang.org/users
>
> ____________________
>   Racket Users list:
>   http://lists.racket-lang.org/users
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20140324/7995e86e/attachment-0001.html>