[racket] Picts in DrRacket

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