Pict Abbrevs
(require pict-abbrevs) | package: pict-abbrevs |
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
If the name revolution is too long, then do (require (rename-in pict-abbrevs [revolution turn])).
> (arrowhead 30 (* 0 revolution)) > (arrowhead 30 (* 1/4 revolution)) > (arrowhead 30 (* 1/2 revolution))
contract
contract
> (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?)
procedure
(pict-color->color% pc #:default default) → (is-a?/c color%)
pc : pict-color/c default : pict-color/c
> (pict-color->color% "blue") (object:color% ...)
> (pict-color->color% #f) (object:color% ...)
contract
rgb-triplet/c : (-> any/c boolean?)
procedure
(rgb-triplet->color% c) → (is-a?/c color%)
c : rgb-triplet/c
procedure
(hex-triplet->color% n) → (is-a?/c color%)
n : (integer-in 0 16777215)
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"))
> (ht-append 10 (disk 20 #:color racket-red) (disk 20 #:color racket-blue))
> (define red (string->color% "red")) > (disk 20 #:color red) > (disk 20 #:color (color%-update-alpha red 0.3))
> (define red (string->color% "red")) > (disk 20 #:color red) > (disk 20 #:color (color%++ red 40)) > (disk 20 #:color (color%++ red -40))
procedure
(pict-bbox-sup p ...) → (listof pict?)
p : pict?
procedure
(pict-bbox-sup* p*) → (listof pict?)
p* : (listof pict?)
> (max* '(8 6 7)) 8
> (min* '(8 6 7)) 6
> (midpoint 10 20) 15
procedure
w : real? h : real? c : pict-color/c = "black"
procedure
(string->color% str) → (is-a?/c color%)
str : string?
procedure
ps : path-string? p : pict? kind : (or/c 'png 'jpeg 'xbm 'xpm 'bmp 'pdf 'ps 'eps) = 'png
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?
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-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-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
> (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
(bbox pp [ #:color color #:frame-color frame-color #:frame-width frame-width #:x-margin x-margin #:y-margin y-margin]) → pict? pp : pict? color : pict-color/c = "white" frame-color : (or/c #f pict-color/c) = (bbox-frame-color) frame-width : (or/c #f real?) = (bbox-frame-width) x-margin : (or/c #f real?) = (bbox-x-margin) y-margin : (or/c #f real?) = (bbox-y-margin)
Comes with reasonable defaults and parameters for fine-tuning.
> (hc-append 10 (bbox (text "Hello World")) (bbox (desktop-machine 1)))
> (hc-append 10 (sbox (text "Hello World")) (sbox (desktop-machine 1)))
parameter
(bbox-radius) → real?
(bbox-radius rad) → void? rad : real?
= 1
parameter
(bbox-x-margin) → real?
(bbox-x-margin xx) → void? xx : real?
= 66
parameter
(bbox-y-margin) → real?
(bbox-y-margin yy) → void? yy : real?
= 14
parameter
(bbox-frame-width fw) → void? fw : real?
= 2
parameter
(bbox-frame-color cc) → void? cc : pict-color/c
= (hex-triplet->color% 11885)
procedure
(tag-append x ...) → symbol?
x : any/c
(string->symbol (string-join (map ~a x*) "-"))
> (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
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 four invisible lines around the pict, one on each side, each one centered in the middle of the side and hub-len units long.
The margin sets the distance between a hub and the edge of the base pict. If #f, the default is a small positive distance.
> (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
pp : pict? width : nonnegative-real? height : nonnegative-real?
1.1 Pict Constructors
The pict function ghost is similar, but preserves tags and other metadata.
Added in version 0.7 of package pict-abbrevs.
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
> (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"
> (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
> (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"
> (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"
> (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
Increase flag-x-margin and flag-y-margin to add space between the base pict and the edge of the flag.
> (make-simple-flag (standard-fish 80 40 #:direction 'right))
procedure
(lightbulb-pict [ #:color color #:base-color base-color #:border-color border-color #:tip-color tip-color #:border-width border-width #:bulb-radius bulb-radius #:stem-width-radians stem-width-radians #:stem-height stem-height #:base-segments base-segments #:base-segment-height base-segment-height #:base-segment-corner-radius base-segment-corner-radius #:tip-ratio tip-ratio]) → pict?
color : (or/c string? (is-a?/c color%) (is-a?/c brush%)) = "yellow"
base-color : (or/c string? (is-a?/c color%)) = (make-color 200 200 200)
border-color : (or/c string? (is-a?/c color%)) = (make-color 0 0 0) tip-color : (or/c string? (is-a?/c color%)) = border-color border-width : (real-in 0 255) = 2.5 bulb-radius : (and/c rational? (not/c negative?)) = 50
stem-width-radians : (and/c rational? (not/c negative?)) = (* pi 1/4) stem-height : (and/c rational? (not/c negative?)) = 15 base-segments : natural-number/c = 3 base-segment-height : (and/c rational? (not/c negative?)) = 9 base-segment-corner-radius : real? = 3 tip-ratio : (and/c rational? (not/c negative?)) = 5/12
> (lightbulb-pict)
Added in version 0.11 of package pict-abbrevs.
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
> (make-font-table-pict "Racket" #:limit 6)
2 Arrow Abbrevs
(require pict-abbrevs/arrow) | package: pict-abbrevs |
Added in version 0.12 of package pict-abbrevs.
struct
(struct parrow ( src-tag src-find tgt-tag tgt-find start-angle end-angle start-pull end-pull style) #:extra-constructor-name make-parrow) src-tag : (or/c symbol? pict-path?) src-find : (pict-convertible? pict-path? . -> . (values real? real?)) tgt-tag : (or/c symbol? pict-path?) tgt-find : (pict-convertible? pict-path? . -> . (values real? real?)) start-angle : real? end-angle : real? start-pull : real? end-pull : real? 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 #f)
parameter
(*parrow-line-width* line-width) → void? line-width : real?
= 4
parameter
(*parrow-arrow-size* arrow-size) → void? arrow-size : real?
= 14
parameter
(*parrow-color*) → (is-a?/c color%)
(*parrow-color* cc) → void? cc : (is-a?/c color%)
= "black"
procedure
(add-parrow base-pict arrow [ #:double-head? double-head? #:arrow-size arrow-size #:line-width line-width #:color color #:label label #:x-adjust-label x-sep #:y-adjust-label y-sep #:hide? hide?]) → pict? base-pict : pict? arrow : parrow? double-head? : any/c = #f arrow-size : real? = (*parrow-arrow-size*) line-width : real? = (*parrow-line-width*) color : (is-a?/c color%) = (*parrow-color*) label : pict? = (blank) x-sep : real? = 0 y-sep : real? = 0 hide? : any/c = #f
> (require pict-abbrevs/arrow) > (define pict-a (add-hubs (rectangle 40 40) 'A)) > (define pict-b (add-hubs (circle 40) 'B)) > (define above-arrow (parrow 'A-N ct-find 'B-N ct-find (* 1/4 revolution) (* 3/4 revolution) 1/4 1/4 'solid)) > (define below-arrow (parrow 'A-S cb-find 'B-S cb-find (* 3/4 revolution) (* 1/4 revolution) 1/2 1/2 'long-dash))
> (add-parrow (add-parrow (hc-append pict-a (blank 80 200) pict-b) above-arrow) below-arrow)
procedure
(add-pline base-pict arrow [ #:line-width line-width #:color color #:label label #:x-adjust-label x-sep #:y-adjust-label y-sep #:hide? hide?]) → pict? base-pict : pict? arrow : parrow? line-width : real? = (*parrow-line-width*) color : (is-a?/c color%) = (*parrow-color*) label : pict? = (blank) x-sep : real? = 0 y-sep : real? = 0 hide? : any/c = #f
> (add-pline (hc-append 80 (tag-pict (rectangle 40 40) 'A) (tag-pict (circle 40) 'B)) (parrow 'A rc-find 'B lc-find 0 0 1 1 'solid) #:label (text "from rectangle to circle") #:y-adjust-label -10)
procedure
(add-parrows base-pict #:arrow-size arrow-size #:color color arrows ...) → pict? base-pict : pict? arrow-size : (*parrow-arrow-size*) color : (is-a?/c color%) arrows : (listof parrow?)
procedure
(add-parrows* base-pict arrows #:arrow-size arrow-size #:color color) → pict? base-pict : pict? arrows : (listof parrow?) arrow-size : (*parrow-arrow-size*) color : (is-a?/c color%)
procedure
(add-parrow* base-pict arrows #:arrow-size arrow-size #:color color) → pict? base-pict : pict? arrows : (listof parrow?) arrow-size : (*parrow-arrow-size*) color : (is-a?/c color%)
procedure
(add-plines base-pict #:color color lines ...) → pict? base-pict : pict? color : (is-a?/c color%) lines : (listof parrow?)
procedure
(add-pline* base-pict lines #:color color) → pict?
base-pict : pict? lines : (listof parrow?) color : (is-a?/c color%)
3 LTL Abbrevs
(require pict-abbrevs/ltl) | package: pict-abbrevs |
Added in version 0.12 of package pict-abbrevs.
procedure
(trace-pict sym** [ #:index-labels? index-labels #:lasso? lasso?]) → pict? sym** : (listof (listof (or/c 'R 'G 'B))) index-labels : any/c = #true lasso? : any/c = #true
> (trace-pict '((R) (G) (B))) > (trace-pict '((R G B) (G)) #:lasso? #f)
4 Slideshow Abbrevs
(require pict-abbrevs/slideshow) | package: pict-abbrevs |
contract
slide-assembler/c : chaperone-contract?
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
#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?
procedure
(pixels->h% x) → real%
x : nonnegative-real?
procedure
(w%->pixels w) → nonnegative-real?
w : real%
#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%
procedure
(text/color str c) → pict?
str : string? c : pict-color/c
#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?
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?)
#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?)
#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
#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
value
highlight-brush-color : pict-color/c
5 PPict Abbrevs
(require pict-abbrevs/pplay) | package: pict-abbrevs |
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
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.
(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.
6 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.