[racket] Picts in DrRacket

The smoothed solution almost works for me.
In MetaPict curves are represented as lists of Bezier curves.
Therefore almost all picts need to be drawn as smoothed.
Using smoothed in function that converts curves into picts works,
but since MetaPict generates nested picts, I'd like to avoid
some of the overhead. I'll experiment with a parameter.

Note that the child field must be  (list (make-child p 0 0 1 1 0 0))
in order for nested picts to work.

Thanks,
Jens Axel




(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 (make-child p 0 0 1 1 0 0))
             #f
             (pict-last p)))


2014-03-24 21:40 GMT+01:00 Matthew Flatt <mflatt at cs.utah.edu>:
> 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



-- 
--
Jens Axel Søgaard