Pict Abbrevs

8.12

Pict Abbrevs🔗ℹ

The pict-abbrevs module exports the following bindings and does not depend on racket/gui/base.

Changed in version 0.3 of package pict-abbrevs: The pict-abbrevs module no longer reprovides pict-abbrevs/slideshow, and consequently no longer depends on racket/gui/base.

1 Pict Utilities🔗ℹ

value
revolution : real?

Equal to (* 2 pi), or the tau constant. Useful for rotating picts.

If the name revolution is too long, then do (require (rename-in pict-abbrevs [revolution turn])).

Examples:

> (arrowhead 30 (* 0 revolution))
> (arrowhead 30 (* 1/4 revolution))
> (arrowhead 30 (* 1/2 revolution))

contract
real% : flat-contract?

Contract for "real percent". Same as (between/c 0 1).

contract
nonnegative-real? : flat-contract?

Same as (>=/c 0).

Examples:

> (nonnegative-real? 0)
#t
> (nonnegative-real? 2.77)
#t
> (nonnegative-real? 9001)
#t
> (nonnegative-real? -1)
#f
> (nonnegative-real? 'X)
#f

contract
pict-color/c : (-> any/c boolean?)

Flat contract for the kinds of values that pict functions can usually interpret as colors.

procedure
(pict-color->color% pc #:default default) → (is-a?/c color%)
pc : pict-color/c
default : pict-color/c

Creates a color% object. If pc and default are #false, returns (string->color% "white").

Examples:

> (pict-color->color% "blue")
(object:color% ...)
> (pict-color->color% #f)
(object:color% ...)

contract
rgb-triplet/c : (-> any/c boolean?)

Flat contract for an RGB triplet. See also: Plot Utilities.

procedure
(rgb-triplet->color% c) → (is-a?/c color%)
c : rgb-triplet/c

Converts an RGB triplet to a color object.

procedure
(hex-triplet->color% n) → (is-a?/c color%)
n : (integer-in 0 16777215)

Converts a Hex Code RGB to a color object. Expects inputs between #x000000 and #xffffff.

https://image-color.com can select hex colors from an image.

value
racket-red : (is-a?/c color%)
= (hex-triplet->color% (string->number "#x9F1D20"))
value
racket-blue : (is-a?/c color%)
= (hex-triplet->color% (string->number "#x3E5BA9"))

Colors from Matthew Butterick’s Racket logo.

Example:

> (ht-append 10
(disk 20 #:color racket-red)
(disk 20 #:color racket-blue))

procedure
(color%-update-alpha c a) → (is-a?/c color%)
c : (is-a?/c color%)
a : (real-in 0 1)

Examples:

> (define red (string->color% "red"))
> (disk 20 #:color red)
> (disk 20 #:color (color%-update-alpha red 0.3))

procedure
(pict-bbox-sup p ...) → (listof pict?)
p : pict?
procedure
(pict-bbox-sup* p*) → (listof pict?)
p* : (listof pict?)

Returns a list of picts with identical width and height. The new picts may be old picts superimposed upon a blank background.

Example:

> (map frame (pict-bbox-sup (disk 10) (disk 20) (disk 5)))
'( )

procedure
(max* r*) → real?
r* : (listof real?)

Similar to max but expects a list of numbers. Raises an exn:fail:contract? error when given an empty list.

Example:

> (max* '(8 6 7))
8

procedure
(min* r*) → real?
r* : (listof real?)

Similar to min but expects a list of numbers. Raises an exn:fail:contract? error when given an empty list.

Example:

> (min* '(8 6 7))
6

procedure
(midpoint x0 x1) → real?
x0 : real?
x1 : (>=/c x0)

Compute the midpoint of the interval [x0, x1].

Example:

> (midpoint 10 20)
15

procedure
(rule w h [#:color c]) → pict?
  w : real?
  h : real?
  c : pict-color/c = "black"

Returns a filled-rectangle with the given width, height, and color.

Examples:

> (rule 20 2)
> (rule 1 10)
> (rule 8 8)

procedure
(string->color% str) → (is-a?/c color%)
str : string?

Converts a string to a color object.

procedure
(save-pict ps p [kind]) → boolean?
  ps : path-string?
  p : pict?
  kind : (or/c 'png 'jpeg 'xbm 'xpm 'bmp 'pdf 'ps 'eps) = 'png

Exports the given pict to the file ps, using kind to determine the output format.

Changed in version 0.8 of package pict-abbrevs: Added support for 'pdf, 'ps, 'eps. Thanks to racket/pict/issues/74.

procedure
(scale-to-width pp w) → pict?
  pp : pict?
  w : real?
procedure
(scale-to-height pp h) → pict?
  pp : pict?
  h : real?
procedure
(scale-to-square pp len) → pict?
  pp : pict?
  len : real?
procedure
(scale-to-pict pp frame) → pict?
  pp : pict?
  frame : pict?

Variants of scale-to-fit.

Added in version 0.8 of package pict-abbrevs.

procedure
(add-rectangle-background pp
[ #:radius radius
#:color color
#:draw-border? draw-border?
#:x-margin x-margin
#:y-margin y-margin]) → pict?
  pp : pict?
  radius : real? = 10
  color : pict-color/c = "white"
  draw-border? : boolean? = #false
  x-margin : real? = 0
  y-margin : real? = 0

Add a rectangle behind a pict.

Example:

> (add-rectangle-background (standard-fish 100 50) #:color "bisque")

procedure
(add-rounded-border pp
[ #:radius radius
#:background-color bg-color
#:frame-width frame-width
#:frame-color frame-color
#:x-margin x-margin
#:y-margin y-margin]) → pict?
  pp : pict?
  radius : real? = 10
  bg-color : pict-color/c = "white"
  frame-width : real? = 1
  frame-color : pict-color/c = "black"
  x-margin : real? = 0
  y-margin : real? = 0

Add a bordered rectangle behind a pict.

Example:

> (add-rounded-border (standard-fish 100 50) #:x-margin 20 #:y-margin 30)

procedure
(add-spotlight-background pp
[ #:blur blur
#:border-color border-color
#:color color
#:border-width border-width
#:x-margin x-margin
#:y-margin y-margin]) → pict?
  pp : pict?
  blur : (or/c #f real?) = 15
  border-color : pict-color/c = "plum"
  color : pict-color/c = border-color
  border-width : real? = 10
  x-margin : real? = 40
  y-margin : real? = 40

Superimposes the given pict on a blurred ellipse.

Examples:

> (add-spotlight-background (jack-o-lantern 80))
> (add-spotlight-background (jack-o-lantern 80)
                            #:border-color "firebrick"
                            #:color (color%-update-alpha (string->color% "white") 0)
                            #:border-width 15
                            #:x-margin 30
                            #:y-margin 5)

procedure
(tag-append x ...) → symbol?
x : any/c

Create a new tag (symbol) from a sequence of values. Equivalent to:

(string->symbol (string-join (map ~a x*) "-"))

Examples:

> (tag-append 'N 'W)
'N-W
> (tag-append "-" 1)
'--1

procedure
(add-hubs pp
tag
[ #:hub-length hub-len
#:margin margin]) → pict?
  pp : pict?
  tag : symbol?
  hub-len : (or/c nonnegative-real? #f) = #f
  margin : (or/c nonnegative-real? #f) = #f

Add four blank picts to the sides of the base pict. These blank "hubs" are useful targets for lines and/or arrows; see the examples below.

Each hub has a tag based on its compass direction: (tag-append tag 'N) for the top hub, (tag-append tag 'E) for the right hub, (tag-append tag 'S) for the bottom hub, and (tag-append tag 'W) for the left hub.
The hub-len sets the size of each hub. Imagine an invisible length of string hub-len units long centered at and parallel with each side of the pict.
The margin sets the distance between a hub and the edge of the base pict. If #f, the default is a small positive distance.

Non-Example:

> (let ((pp (ht-append 40
              (tag-pict (disk 30 #:color "pink") 'A)
              (tag-pict (disk 30 #:color "peru") 'B))))
    (pin-line pp
      (find-tag pp 'A) rc-find
      (find-tag pp 'B) lc-find))

Examples:

> (let ((pp (ht-append 40
              (add-hubs (disk 30 #:color "pink") 'A)
              (add-hubs (disk 30 #:color "peru") 'B))))
    (pin-line pp
      (find-tag pp 'A-E) rc-find
      (find-tag pp 'B-W) lc-find))
> (let ((pp (ht-append 40
              (add-hubs (disk 30 #:color "pink") 'A)
              (add-hubs (disk 30 #:color "peru") 'B))))
    (pin-arrow-line 9 pp
      (find-tag pp 'A-E) rt-find
      (find-tag pp 'B-W) lb-find
      #:start-angle (* 1/8 revolution)
      #:end-angle (* 1/8 revolution)
      #:start-pull 5/4
      #:end-pull 5/4))

procedure
(clip-to pp width height) → pict?
  pp : pict?
  width : nonnegative-real?
  height : nonnegative-real?

Clips a pict to a box with the given width and height (positioned at the center of the pict).

Example:

> (clip-to (disk 50) 40 30)

1.1 Pict Constructors🔗ℹ

procedure
(pblank base) → pict?
base : pict?

Draw a blank pict with the same width and height as the given pict.

Example:

> (let* ((p0 (filled-rectangle 30 30))
         (p1 (pblank p0))
         (sep 2)
         (r0 (ht-append sep p0 p1 p0))
         (r1 (ht-append sep p1 p0 p1)))
    (vc-append sep r0 r1))

The pict function ghost is similar, but preserves tags and other metadata.

procedure
(xblank width) → pict?
width : real?

Draw a blank pict with the given width and zero height. Same as (blank width 0).

Added in version 0.7 of package pict-abbrevs.

procedure
(yblank height) → pict?
height : real?

Draw a blank pict with the given height and zero width. Same as (blank 0 height).

Added in version 0.7 of package pict-abbrevs.

procedure
(ptable pict-tree
[ #:ncols ncols
#:col-sep col-sep
#:row-sep row-sep
#:col-align col-align
#:row-align row-align]) → pict?
  pict-tree : (listof (or/c pict? pair? list?))
  ncols : (or/c natural? #f) = 2
  col-sep : (or/c nonnegative-real? #f) = 20
  row-sep : (or/c nonnegative-real? #f) = 10
  col-align : (or/c procedure? list? #f) = lc-superimpose
  row-align : (or/c procedure? list? #f) = cc-superimpose

Wrapper for the pict table function. Accepts either a flat list of picts or a list of equal-length lists.

Examples:

> (define (rect color-name)
    (filled-rounded-rectangle 30 20 2 #:color color-name #:draw-border? #f))
> (define pairs
    (for/list ((color-name (in-list '("aquamarine" "powder blue" "plum"))))
      (cons (text color-name)
            (rect color-name))))
> (ptable pairs)

Added in version 0.8 of package pict-abbrevs.

procedure
(make-envelope-pict w
h
[ #:color color
#:line-width line-width
#:line-color line-color]) → pict?
  w : nonnegative-real?
  h : nonnegative-real?
  color : pict-color/c = "mint cream"
  line-width : nonnegative-real? = 2
  line-color : pict-color/c = "black"

Draw an envelope.

Examples:

> (make-envelope-pict 28 20)
> (make-envelope-pict 50 24 #:color "rosy brown" #:line-color "powder blue" #:line-width 4)

Added in version 0.8 of package pict-abbrevs.

procedure
(make-check-pict n
[ #:color color
#:line-width line-width
#:line-color line-color]) → pict?
  n : nonnegative-real?
  color : pict-color/c = #f
  line-width : nonnegative-real? = #f
  line-color : pict-color/c = #f
procedure
(make-cross-pict n
[ #:color color
#:line-width line-width
#:line-color line-color]) → pict?
  n : nonnegative-real?
  color : pict-color/c = #f
  line-width : nonnegative-real? = #f
  line-color : pict-color/c = #f

Draw a check mark, draw an X mark.

Example:

> (ht-append 4
(make-check-pict 40)
(make-cross-pict 40))

Added in version 0.8 of package pict-abbrevs.

procedure
(make-compass-pict side-len [#:color color]) → pict?
side-len : nonnegative-real?
color : pict-color/c = "black"

Draw a 4-pointed star that fits in a square with side length side-len.

Examples:

> (make-compass-pict 10)
> (make-compass-pict 20)

procedure
(make-mouse-cursor-pict w h [#:color color]) → pict?
  w : nonnegative-real?
  h : nonnegative-real?
  color : pict-color/c = "black"

Draw a simple mouse cursor.

Example:

> (make-mouse-cursor-pict 20 32)

procedure
(make-simple-flag
base
[ #:flag-background-color flag-background-color
#:flag-border-color flag-border-color
#:flag-border-width flag-border-width
#:flag-brush-style flag-brush-style
#:flag-x-margin flag-x-margin
#:flag-y-margin flag-y-margin
#:pole-width pole-width
#:pole-height pole-height
#:pole-color pole-color
#:pole-border-color pole-border-color])
→ pict?
  base : pict?
  flag-background-color : (or/c (is-a?/c color%) #f) = #f
  flag-border-color : (or/c (is-a?/c color%) #f) = #f
  flag-border-width : (or/c nonnegative-real? #f) = #f
  flag-brush-style : (or/c brush-style/c #f) = #f
  flag-x-margin : (or/c nonnegative-real? #f) = #f
  flag-y-margin : (or/c nonnegative-real? #f) = #f
  pole-width : (or/c nonnegative-real? #f) = #f
  pole-height : (or/c nonnegative-real? #f) = #f
  pole-color : (or/c (is-a?/c color%) #f) = #f
  pole-border-color : (or/c (is-a?/c color%) #f) = #f

Draw a simple flag with base superimposed on the fabric.

Increase flag-x-margin and flag-y-margin to add space between the base pict and the edge of the flag.

Example:

> (make-simple-flag (standard-fish 80 40 #:direction 'right))

procedure
(make-font-table-pict example-str
[ #:size font-size
#:limit n]) → pict?
  example-str : string?
  font-size : (or/c (integer-in 1 1024) #f) = #f
  n : (or/c exact-nonnegative-integer? #f) = #f

Draw the given string using all fonts returned by (get-face-list), or the first n fonts if a limit is supplied.

Example:

> (make-font-table-pict "Racket" #:limit 6)

2 Slideshow Abbrevs🔗ℹ

(require pict-abbrevs/slideshow)

package: pict-abbrevs

Helpers for working with slideshow or ppict/2. This module depends on racket/gui/base.

contract
slide-assembler/c : chaperone-contract?

Contract for a function that can be used to build slideshow slides. See also current-slide-assembler.

procedure
(slide-assembler/background base-assembler
#:color background-color
[ #:draw-border? draw-border?
#:border-color border-color
#:border-width border-width])
→ slide-assembler/c
  base-assembler : slide-assembler/c
  background-color : pict-color/c
  draw-border? : boolean? = #false
  border-color : pict-color/c = #false
  border-width : (or/c #f real?) = #false

Returns a slide assembler that: (1) uses the given base-assembler to create a pict, and (2) superimposes the pict onto a filled-rectangle that covers the screen. The optional arguments set the style of the background rectangle.

#lang racket/base
(require pict-abbrevs/slideshow slideshow)

(parameterize ((current-slide-assembler
                 (slide-assembler/background
                   (current-slide-assembler)
                   #:color "red"))
               (current-font-size 60))
  (slide (t "HOLA")))

procedure
(pixels->w% x) → real%
x : nonnegative-real?

Converts a pixel distance to a percentage of the max screen width, i.e., (+ (* 2 margin) client-w). Raise an exn:fail:contract? exception if the given distance exceeds the max width.

procedure
(pixels->h% x) → real%
x : nonnegative-real?

Converts a pixel distance to a percentage of the max screen height, i.e., (+ (* 2 margin) client-h). Raise an exn:fail:contract? exception if the given distance exceeds the max height.

procedure
(w%->pixels w) → nonnegative-real?
w : real%

Converts a percent to the number of pixels required to cover that percent of client-w.

#lang racket/base
(require slideshow/base pict-abbrevs/slideshow)

(w%->pixels 1/10)
(w%->pixels 5/10)
(= client-w (w%->pixels 1))

procedure
(h%->pixels w) → nonnegative-real?
w : real%

Converts a percent to the number of pixels required to cover that percent of client-h.

procedure
(text/color str c) → pict?
str : string?
c : pict-color/c

Draws colored text.

#lang racket/base
(require pict-abbrevs/slideshow)

(text/color "red" "red")

procedure
(at-underline pp
#:abs-x abs-x
#:abs-y abs-y) → refpoint-placer?
  pp : (or/c tag-path? pict-path?)
  abs-x : real?
  abs-y : real?
procedure
(at-leftline pp #:abs-x abs-x #:abs-y abs-y) → refpoint-placer?
  pp : (or/c tag-path? pict-path?)
  abs-x : real?
  abs-y : real?

Returns a placer that places picts to a reference point relative to an existing pict within the base. For at-underline the reference point is the bottom-left. For at-leftline the reference point is the top-left. If given, abs-x and abs-y shift the reference point. See also at-find-pict.

procedure
(make-underline pp
#:height height
#:color color
[ #:width width]) → pict?
  pp : (or/c pict? real?)
  height : real?
  color : pict-color/c
  width : #f = (or/c #f real?)

Draw a horizontal line wide enough to underline the given pict.

#lang racket/base
(require pict-abbrevs/slideshow ppict/2)

(let ((word (text "Word")))
  (ppict-do
    (file-icon 50 40 "bisque")
    #:go (coord 1/2 1/2 'cc)
    word
    #:go (at-underline word)
    (make-underline word)))

procedure
(make-leftline pp
#:height height
#:color color
[ #:width width]) → pict?
  pp : (or/c pict? real?)
  height : real?
  color : pict-color/c
  width : #f = (or/c #f real?)

Draw a vertical line that is equally high as the given pict.

#lang racket/base
(require pict-abbrevs/slideshow ppict/2)

(let ((word (text "Word")))
  (ppict-do
    (file-icon 100 80 "bisque")
    #:go (coord 1/2 1/2 'cc)
    word
    #:go (at-leftline word)
    (make-leftline word #:width 10)))

procedure
(make-highlight* pp tag #:color color) → pict?
  pp : pict?
  tag : symbol?
  color : pict-color/c

Add a background of the given color to all picts tagged (in the sense of tag-pict?) with tag in the scene pp.

#lang racket/base
(require pict-abbrevs/slideshow ppict/2)

(ppict-do
  (blank 80 40)
  #:set (for/fold ((acc ppict-do-state))
                  ((i (in-range 8)))
          (ppict-do
            acc
            #:go (coord (/ (* i 10)  80) 9/10)
            (if (even? i)
              (tag-pict (text "X") 'X)
              (tag-pict (text "O") 'O))))
  #:set (make-highlight* ppict-do-state 'X))

value
highlight-pen-color : pict-color/c

Default color for underlines, etc.

value
highlight-brush-color : pict-color/c

Default color for highlights.

3 PPict Abbrevs🔗ℹ

(require pict-abbrevs/pplay)

package: pict-abbrevs

Animation helper for ppicts.

Origin: https://github.com/rmculpepper/ppict/pull/6

procedure
(pplay gen
[ #:steps steps
#:delay delay-secs
#:skip-first? skip-first?
#:title title
#:name name
#:aspect aspect
#:layout layout]
#:gap-size real?
#:inset slide-inset?) → void?
  gen : (-> ppict? (real-in 0.0 1.0) pict?)
  steps : exact-positive-integer? = (current-play-steps)
  delay-secs : real? = 0.05
  skip-first? : any/c = #f
  title : (or/c string? #f) = #f
  name : (or/c string? #f) = title
  aspect : aspect? = #f
  layout : (or/c 'auto 'center 'top 'tall) = 'auto
  real? : (current-gap-size)
  slide-inset? : no-inset

Generates steps+1 pslides by calling gen on a base ppict (created by pslide) and equally-spaced values from 0.0 (inclusive) to 1.0 (exclusive). Except for the first slide (which may be skipped), each slide has a timeout of delay-secs, so that the next slide appears automatically.

The #:steps, #:delay, and #:skip-first? options are interpreted the same as for the play procedure. The remaining options are interpreted the same as for pslide.

Example:

(pplay
  (lambda (pp n)
    (ppict-do
      pp
      #:go (coord 1/2 1/2)
      (cellophane (text "HELLO") n))))

Added in version 0.8 of package pict-abbrevs.

4 raco pict🔗ℹ

To vertically append image files and/or Racket modules:

raco pict vl-append ARG ...

If an ARG is an image file, then raco pict parses it via the bitmap function.

If an ARG is a #lang module, then it must contain a submodule named raco-pict that provides an identifier named raco-pict. For example:

#lang racket/base
(module+ raco-pict
  (require pict)
  (provide raco-pict)
  (define raco-pict (disk 40)))

Other pict functions may work.

Other arguments may work as expected. Certainly raco pict vl-append 20 a.png b.png vertically appends two image files with "20 space" in between.