3 Pict Utilities

6.1

3 Pict Utilities

This library is unstable; compatibility will not be maintained. See Unstable: May Change Without Warning for more information.

(require unstable/gui/pict)

package: unstable-lib

The functions and macros exported by this module are also exported by unstable/gui/slideshow.

3.1 Pict Colors

procedure
(color c p) → pict?
c : color/c
p : pict?

Applies color c to picture p. Equivalent to (colorize p c).

Example:

> (color "red" (disk 20))

procedure
(red pict) → pict?
  pict : pict?
procedure
(orange pict) → pict?
  pict : pict?
procedure
(yellow pict) → pict?
  pict : pict?
procedure
(green pict) → pict?
  pict : pict?
procedure
(blue pict) → pict?
  pict : pict?
procedure
(purple pict) → pict?
  pict : pict?
procedure
(black pict) → pict?
  pict : pict?
procedure
(brown pict) → pict?
  pict : pict?
procedure
(gray pict) → pict?
  pict : pict?
procedure
(white pict) → pict?
  pict : pict?
procedure
(cyan pict) → pict?
  pict : pict?
procedure
(magenta pict) → pict?
  pict : pict?

These functions apply appropriate colors to picture p.

Example:

> (red (disk 20))

procedure
(light color) → color/c
color : color/c
procedure
(dark color) → color/c
color : color/c

These functions produce ligher or darker versions of a color.

Example:

> (hc-append (colorize (disk 20) "red")
(colorize (disk 20) (dark "red"))
(colorize (disk 20) (light "red")))

value
color/c : flat-contract?

This contract recognizes color strings, color% instances, and RGB color lists.

3.2 Pict Manipulation

procedure
(fill pict width height) → pict?
  pict : pict?
  width : (or/c real? #f)
  height : (or/c real? #f)

Extends pict’s bounding box to a minimum width and/or height, placing the original picture in the middle of the space.

Example:

> (frame (fill (disk 20) 40 40))

procedure
(scale-to pict width height [#:mode mode]) → pict?
  pict : pict?
  width : real?
  height : real?
  mode : (or/c 'preserve 'inset 'distort) = 'preserve

Scales pict so that its width and height are at most width and height, respectively. If mode is 'preserve, the width and height are scaled by the same factor so pict’s aspect ratio is preserved; the result’s bounding box may be smaller than width by height. If mode is 'inset, the aspect ratio is preserved as with 'preserve, but the resulting pict is centered in a bounding box of exactly width by height. If mode is 'distort, the width and height are scaled separately.

Examples:

> (frame (scale-to (circle 100) 40 20))
> (frame (scale-to (circle 100) 40 20 #:mode 'inset))
> (frame (scale-to (circle 100) 40 20 #:mode 'distort))

3.2.1 Conditional Manipulations

These pict transformers all take boolean arguments that determine whether to transform the pict or leave it unchanged. These transformations can be useful for staged slides, as the resulting pict always has the same size and shape, and its contents always appear at the same position, but changing the boolean argument between slides can control when the transformation occurs.

procedure
(show pict [show?]) → pict?
  pict : pict?
  show? : truth/c = #t
procedure
(hide pict [hide?]) → pict?
  pict : pict?
  hide? : truth/c = #t

These functions conditionally show or hide an image, essentially choosing between pict and (ghost pict). The only difference between the two is the default behavior and the opposite meaning of the show? and hide? booleans. Both functions are provided for mnemonic purposes.

procedure
(strike pict [strike?]) → pict?
pict : pict?
strike? : truth/c = #t

Displays a strikethrough image by putting a line through the middle of pict if strike? is true; produces pict unchanged otherwise.

Example:

> (strike (colorize (disk 20) "yellow"))

procedure
(shade pict [shade? #:ratio ratio]) → pict?
  pict : pict?
  shade? : truth/c = #t
  ratio : (real-in 0 1) = 1/2

Shades pict to show with ratio of its normal opacity; if ratio is 1 or shade? is #f, shows pict unchanged.

Example:

> (shade (colorize (disk 20) "red"))

3.2.2 Conditional Combinations

These pict control flow operators decide which pict of several to use. All branches are evaluated; the resulting pict is a combination of the pict chosen by normal conditional flow with ghost applied to all the other picts. The result is a picture large enough to accommodate each alternative, but showing only the chosen one. This is useful for staged slides, as the pict chosen may change with each slide but its size and position will not.

syntax
(pict-if maybe-combine test-expr then-expr else-expr)

maybe-combine =
| #:combine combine-expr

Chooses either then-expr or else-expr based on test-expr, similarly to if. Combines the chosen, visible image with the other, invisible image using combine-expr, defaulting to pict-combine.

Example:

> (let ([f (lambda (x)
             (pict-if x
                      (disk 20)
                      (disk 40)))])
    (hc-append 10
               (frame (f #t))
               (frame (f #f))))

syntax
(pict-cond maybe-combine [test-expr pict-expr] ...)

maybe-combine =
| #:combine combine-expr

Chooses a pict-expr based on the first successful test-expr, similarly to cond. Combines the chosen, visible image with the other, invisible images using combine-expr, defaulting to pict-combine.

Example:

> (let ([f (lambda (x)
             (pict-cond
               [(eq? x 'circle) (circle 20)]
               [(eq? x 'disk) (disk 40)]
               [(eq? x 'text) (text "ok" null 20)]))])
    (hc-append 10
               (frame (f 'circle))
               (frame (f 'disk))
               (frame (f 'text))))

syntax
(pict-case test-expr maybe-combine [literals pict-expr] ...)

maybe-combine =
| #:combine combine-expr

Chooses a pict-expr based on test-expr and each list of literals, similarly to case. Combines the chosen, visible image with the other, invisible images using combine-expr, defaulting to pict-combine.

Example:

> (let ([f (lambda (x)
             (pict-case x
               [(circle) (circle 20)]
               [(disk) (disk 40)]
               [(text) (text "ok" null 20)]))])
    (hc-append 10
               (frame (f 'circle))
               (frame (f 'disk))
               (frame (f 'text))))

syntax
(pict-match test-expr maybe-combine [pattern pict-expr] ...)

maybe-combine =
| #:combine combine-expr

Chooses a pict-expr based on test-expr and each pattern, similarly to match. Combines the chosen, visible image with the other, invisible images using combine-expr, defaulting to pict-combine.

syntax
pict-combine

This syntax parameter determines the default pict combining form used by the above macros. It defaults to lbl-superimpose.

syntax
(with-pict-combine combine-id body ...)

Sets pict-combine to refer to combine-id within each of the body terms, which are spliced into the containing context.

Example:

> (let ([f (lambda (x)
             (with-pict-combine cc-superimpose
               (pict-case x
                 [(circle) (circle 20)]
                 [(disk) (disk 40)]
                 [(text) (text "ok" null 20)])))])
    (hc-append 10
               (frame (f 'circle))
               (frame (f 'disk))
               (frame (f 'text))))

3.3 Shapes with Borders

The subsequent bindings were added by Vincent St-Amour.

procedure
(ellipse/border w
h
[ #:color color
#:border-color border-color
#:border-width border-width]) → pict?
  w : real?
  h : real?
  color : color/c = "white"
  border-color : color/c = "black"
  border-width : real? = 2
procedure
(circle/border diameter
[ #:color color
#:border-color border-color
#:border-width border-width]) → pict?
  diameter : real?
  color : color/c = "white"
  border-color : color/c = "black"
  border-width : real? = 2
procedure
(rectangle/border w
h
[ #:color color
#:border-color border-color
#:border-width border-width]) → pict?
  w : real?
  h : real?
  color : color/c = "white"
  border-color : color/c = "black"
  border-width : real? = 2
procedure
(rounded-rectangle/border w
h
[ #:color color
#:border-color border-color
#:border-width border-width
#:corner-radius corner-radius
#:angle angle])
→ pict?
  w : real?
  h : real?
  color : color/c = "white"
  border-color : color/c = "black"
  border-width : real? = 2
  corner-radius : real? = -0.25
  angle : real? = 0

These functions create shapes with border of the given color and width.

Examples:

> (ellipse/border 80 40 #:border-color "blue")
> (rounded-rectangle/border 60 60 #:color "red" #:angle 1 #:border-width 3)
> (circle/border 40 #:color "green" #:border-color "purple")
> (rectangle/border 200 20 #:border-width 5)

3.4 Lines with Labels

The subsequent bindings were added by Scott Owens.

procedure
(pin-label-line label
pict
src-pict
src-coord-fn
dest-pict
dest-coord-fn
[ #:start-angle start-angle
#:end-angle end-angle
#:start-pull start-pull
#:end-pull end-pull
#:line-width line-width
#:color color
#:alpha alpha
#:style style
#:under? under?
#:x-adjust x-adjust
#:y-adjust y-adjust]) → pict?
  label : pict?
  pict : pict?
  src-pict : pict-path?
  src-coord-fn : (-> pict-path? (values real? real?))
  dest-pict : pict-path?
  dest-coord-fn : (-> pict-path? (values real? real?))
  start-angle : (or/c real? #f) = #f
  end-angle : (or/c real? #f) = #f
  start-pull : real? = 1/4
  end-pull : real? = 1/4
  line-width : (or/c real? #f) = #f
  color : (or/c #f string? (is-a?/c color%)) = #f
  alpha : (real-in 0 1) = 1
  style : pen-style/c = 'solid
  under? : any/c = #f
  x-adjust : real? = 0
  y-adjust : real? = 0
procedure
(pin-arrow-label-line label
arrow-size
pict
src-pict
src-coord-fn
dest-pict
dest-coord-fn
[ #:start-angle start-angle
#:end-angle end-angle
#:start-pull start-pull
#:end-pull end-pull
#:line-width line-width
#:color color
#:alpha alpha
#:style style
#:solid? solid?
#:under? under?
#:hide-arrowhead? hide-arrowhead?
#:x-adjust x-adjust
#:y-adjust y-adjust])
→ pict?
  label : pict?
  arrow-size : real?
  pict : pict?
  src-pict : pict-path?
  src-coord-fn : (-> pict-path? (values real? real?))
  dest-pict : pict-path?
  dest-coord-fn : (-> pict-path? (values real? real?))
  start-angle : (or/c real? #f) = #f
  end-angle : (or/c real? #f) = #f
  start-pull : real? = 1/4
  end-pull : real? = 1/4
  line-width : (or/c real? #f) = #f
  color : (or/c #f string? (is-a?/c color%)) = #f
  alpha : (real-in 0 1) = 1
  style : pen-style/c = 'solid
  solid? : boolean? = #t
  under? : any/c = #f
  hide-arrowhead? : any/c = #f
  x-adjust : real? = 0
  y-adjust : real? = 0
procedure
(pin-arrows-label-line label
arrow-size
pict
src-pict
src-coord-fn
dest-pict
dest-coord-fn
[ #:start-angle start-angle
#:end-angle end-angle
#:start-pull start-pull
#:end-pull end-pull
#:line-width line-width
#:color color
#:alpha alpha
#:style style
#:solid? solid?
#:under? under?
#:hide-arrowhead? hide-arrowhead?
#:x-adjust x-adjust
#:y-adjust y-adjust])
→ pict?
  label : pict?
  arrow-size : real?
  pict : pict?
  src-pict : pict-path?
  src-coord-fn : (-> pict-path? (values real? real?))
  dest-pict : pict-path?
  dest-coord-fn : (-> pict-path? (values real? real?))
  start-angle : (or/c real? #f) = #f
  end-angle : (or/c real? #f) = #f
  start-pull : real? = 1/4
  end-pull : real? = 1/4
  line-width : (or/c real? #f) = #f
  color : (or/c #f string? (is-a?/c color%)) = #f
  alpha : (real-in 0 1) = 1
  style : pen-style/c = 'solid
  solid? : boolean? = #t
  under? : any/c = #f
  hide-arrowhead? : any/c = #f
  x-adjust : real? = 0
  y-adjust : real? = 0

These functions behave like pin-line, pin-arrow-line and pin-arrows-line with the addition of a label attached to the line.

Example:

> (let* ([a (red (disk 20))]
         [b (blue (filled-rectangle 20 20))]
         [p (vl-append a (hb-append (blank 100) b))])
    (pin-arrow-label-line
     (rotate (text "label" null 10) (/ pi -4))
     10 p
     a rb-find
     b lt-find))

3.5 Blur

The subsequent bindings were added by Ryan Culpepper.

procedure
(blur p h-radius [v-radius]) → pict?
  p : pict?
  h-radius : (and/c real? (not/c negative?))
  v-radius : (and/c real? (not/c negative?)) = h-radius

Blurs p using an iterated box blur that approximates a gaussian blur. The h-radius and v-radius arguments control the strength of the horizontal and vertical components of the blur, respectively. They are given in terms of pict units, which may not directly correspond to screen pixels.

The blur function takes work proportional to

(* (pict-width p) (pict-height p))

but it may be sped up by a factor of up to (processor-count) due to the use of futures.

Examples:

> (blur (text "blur" null 40) 5)
> (blur (text "more blur" null 40) 10)
> (blur (text "much blur" null 40) 20)
> (blur (text "horiz. blur" null 40) 10 0)

The resulting pict has the same bounding box as p, so when picts are automatically clipped (as in Scribble documents), the pict should be inset by the blur radius.

Example:

> (inset (blur (text "more blur" null 40) 10) 10)

procedure
(shadow p
radius
[ dx
dy
#:color color
#:shadow-color shadow-color]) → pict?
  p : pict?
  radius : (and/c real? (not/c negative?))
  dx : real? = 0
  dy : real? = dx
  color : (or/c #f string? (is-a?/c color%)) = #f
  shadow-color : (or/c #f string? (is-a?/c color%)) = #f

Creates a shadow effect by superimposing p over a blurred version of p. The shadow is offset from p by (dx, dy) units.

If color is not #f, the foreground part is (colorize p color); otherwise it is just p. If shadow-color is not #f, the shadow part is produced by blurring (colorize p shadow-color); otherwise it is produced by blurring p.

The resulting pict has the same bounding box as p.

Examples:

> (inset (shadow (text "shadow" null 50) 10) 10)
> (inset (shadow (text "shadow" null 50) 10 5) 10)
> (inset (shadow (text "shadow" null 50)
5 0 2 #:color "white" #:shadow-color "red")
10)

procedure
(blur-bitmap! bitmap h-radius [v-radius]) → void?
  bitmap : (is-a?/c bitmap%)
  h-radius : (and/c real? (not/c negative?))
  v-radius : (and/c real? (not/c negative?)) = h-radius

Blurs bitmap using blur radii h-radius and v-radius.

3.5.1 Tagged Picts

procedure
(tag-pict p tag) → pict?
p : pict?
tag : symbol?

Returns a pict like p that carries a symbolic tag. The tag can be used with find-tag to locate the pict.

procedure
(find-tag p find) → (or/c pict-path? #f)
p : pict?
find : tag-path?

Locates a sub-pict of p. Returns a pict-path that can be used with functions like lt-find, etc.

Example:

> (let* ([a (tag-pict (red (disk 20)) 'a)]
         [b (tag-pict (blue (filled-rectangle 20 20)) 'b)]
         [p (vl-append a (hb-append (blank 100) b))])
    (pin-arrow-line 10 p
                    (find-tag p 'a) rb-find
                    (find-tag p 'b) lt-find))

procedure
(find-tag* p find) → (listof pict-path?)
p : pict?
find : tag-path?

Like find-tag, but returns all pict-paths corresponding to the given tag-path.

Example:

> (let* ([a (lambda () (tag-pict (red (disk 20)) 'a))]
         [b (lambda () (tag-pict (blue (filled-rectangle 20 20)) 'b))]
         [as (vc-append 10 (a) (a) (a))]
         [bs (vc-append 10 (b) (b) (b))]
         [p (hc-append as (blank 60 0) bs)])
    (for*/fold ([p p])
        ([apath (in-list (find-tag* p 'a))]
         [bpath (in-list (find-tag* p 'b))])
      (pin-arrow-line 4 p
                      apath rc-find
                      bpath lc-find)))

procedure
(tag-path? x) → boolean?
x : any/c

Returns #t if x is a symbol or a non-empty list of symbols, #f otherwise.

3.6 Shadow Frames

procedure
(shadow-frame pict
...
[ #:sep separation
#:margin margin
#:background-color bg-color
#:frame-color frame-color
#:frame-line-width frame-line-width
#:shadow-side-length shadow-side-length
#:shadow-top-y-offset shadow-top-y-offset
#:shadow-bottom-y-offset shadow-bottom-y-offset
#:shadow-descent shadow-descent
#:shadow-alpha-factor shadow-alpha-factor
#:blur blur-radius])
→ pict?
  pict : pict?
  separation : real? = 5
  margin : real? = 20
  bg-color : (or/c string? (is-a?/c color%)) = "white"
  frame-color : (or/c string? (is-a?/c color%)) = "gray"
  frame-line-width : (or/c real? #f) = 0
  shadow-side-length : real? = 4
  shadow-top-y-offset : real? = 10
  shadow-bottom-y-offset : real? = 4
  shadow-descent : (and/c real? (not/c negative?)) = 40
  shadow-alpha-factor : real? = 3/4
  blur-radius : (and/c real? (not/c negative?)) = 20

Surrounds the picts with a rectangular frame that casts a symmetric “curled paper” shadow.

The picts are vertically appended with separation space between them. They are placed on a rectangular background of solid bg-color with margin space on all sides. A frame of frame-color and frame-line-width is added around the rectangle. The rectangle casts a shadow that extends shadow-side-length to the left and right, starts shadow-top-y-offset below the top of the rectangle and extends to shadow-bottom-y-offset below the bottom of the rectangle in the center and an additional shadow-descent below that on the sides. The shadow is painted using a linear gradient; shadow-alpha-factor determines its density at the center. Finally, the shadow is blurred by blur-radius; all previous measurements are pre-blur measurements.

Example:

> (scale (shadow-frame (text "text in a nifty frame" null 60)) 1/2)

procedure
(arch outer-width
inner-width
solid-height
leg-height) → pict?
  outer-width : real?
  inner-width : real?
  solid-height : real?
  leg-height : real?

Creates an arch.

Example:

> (colorize (arch 100 80 20 20) "red")

3.7 Drawing

The subsequent bindings were added by Jay McCarthy.

procedure
(draw-pict-centered p dc w h) → void?
  p : pict?
  dc : (is-a?/c dc<%>)
  w : real?
  h : real?

Draws the pict p on dc centered in a wxh rectangle.

3.8 Additional combinators

The subsequent bindings were added by Asumu Takikawa.

procedure
(backdrop pict [#:color color]) → pict?
pict : pict?
color : color/c = "white"

Adds a background highlighted with color to pict.

Examples:

> (backdrop (circle 20) #:color "whitesmoke")
> (backdrop (text "broccoli rabé") #:color "PaleGreen")

procedure
(cross-out pict
[ #:width width
#:style style
#:color color]) → pict?
  pict : pict?
  width : real? = 1
   style :
(or/c 'transparent 'solid 'xor
      'hilite 'dot 'long-dash 'short-dash
      'dot-dash 'xor-dot 'xor-long-dash
      'xor-short-dash 'xor-dot-dash)
= 'solid
  color : color/c = "black"

Crosses out pict with two diagonal lines drawn with the given line width and with the line style. The lines are colored with color.

Examples:

> (cross-out (circle 20))
> (cross-out (rectangle 30 20) #:width 2 #:style 'long-dash)
> (cross-out (text "rapini") #:width 3 #:color "red")

3.9 Alignment

(require unstable/gui/pict/align)

package: unstable-lib

value
align/c : contract?

A contract for the values '(lt ct rt lc cc rc lb cb rb).

value
halign/c : contract?

A contract for the values '(l c r).

value
valign/c : contract?

A contract for the values '(t c b).

procedure
(align->h a) → halign/c
a : align/c

Extracts the halign/c part from a.

procedure
(align->v a) → valign/c
a : align/c

Extracts the valign/c part from a.

procedure
(align->frac a) → real?
a : (or/c halign/c valign/c)

Computes the fraction corresponding to an alignment where the top-left is 0.

procedure
(halign->vcompose ha) → procedure?
ha : halign/c

Returns the h*-append function for horizontal alignment.

procedure
(valign->hcompose va) → procedure?
va : valign/c

Returns the v*-append function for vertical alignment.

procedure
(pin-over/align scene x y halign valign pict) → pict?
  scene : pict?
  x : real?
  y : real?
  halign : halign/c
  valign : valign/c
  pict : pict?

Pins pict over scene centered at xxy aligned as specified in halign and valign.

3.10 PLT Logos

(require unstable/gui/pict/plt-logo)
	package: unstable-lib

The subsequent bindings were added by Jay McCarthy.

procedure
(make-plt-title-background w h) → pict?
w : real?
h : real?

Draws the PLT logo inside a wxh rectangle.

top ← prev up next →

1	Notify-boxes
2	Preferences
3	Pict Utilities
4	Slideshow Presentations
5	Progressive Picts and Slides
6	Snip Utilities
7	Scribble Utilities

3.1	Pict Colors
3.2	Pict Manipulation
3.3	Shapes with Borders
3.4	Lines with Labels
3.5	Blur
3.6	Shadow Frames
3.7	Drawing
3.8	Additional combinators
3.9	Alignment
3.10	PLT Logos