[racket] Picts in DrRacket

From: Jens Axel Søgaard (jensaxel at soegaard.net)
Date: Mon Mar 24 16:00:37 EDT 2014

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


Posted on the users mailing list.