suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

split off unstable/gui/pict module (no racket/gui dependency)

Browse Source 
added examples to docs
This commit is contained in:
Ryan Culpepper 2011-07-30 00:16:41 -05:00
parent 3bcf99b8f6
commit 19ec1fbccd
5 changed files with 767 additions and 624 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

354
collects/unstable/gui/pict.rkt Normal file
View File

@ -0,0 +1,354 @@
#lang racket/base
(require slideshow/pict
racket/contract racket/list racket/match
racket/splicing racket/stxparam racket/draw
racket/block racket/class
unstable/define
(for-syntax racket/base))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Picture Manipulation
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (fill pict w h)
(cc-superimpose
pict
(blank (or w (pict-width pict))
(or h (pict-height pict)))))
(define (color c p) (colorize p c))
(define color/c
(or/c string? ;; might be faster
;;(and/c string? (lambda (s) (send the-color-database find-color s)))
(is-a?/c color%)
(list/c byte? byte? byte?)))
(define-syntax-rule (define-colors name ...)
(begin (define (name pict) (color (symbol->string 'name) pict)) ...))
(define-colors
red orange yellow green blue purple
black brown gray white cyan magenta)
(define (light c) (scale-color 2 c))
(define (dark c) (scale-color 1/2 c))
(provide/contract
[color/c flat-contract?]
[red (-> pict? pict?)]
[orange (-> pict? pict?)]
[yellow (-> pict? pict?)]
[green (-> pict? pict?)]
[blue (-> pict? pict?)]
[purple (-> pict? pict?)]
[black (-> pict? pict?)]
[brown (-> pict? pict?)]
[gray (-> pict? pict?)]
[white (-> pict? pict?)]
[cyan (-> pict? pict?)]
[magenta (-> pict? pict?)]
[light (-> color/c color/c)]
[dark (-> color/c color/c)]
[color (-> color/c pict? pict?)]
[fill
(-> pict?
(or/c (real-in 0 +inf.0) #f)
(or/c (real-in 0 +inf.0) #f)
pict?)])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Space-smart picture selection
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax-parameter pict-combine #'ltl-superimpose)
(define-syntax-rule (with-pict-combine combine body ...)
(splicing-syntax-parameterize
([pict-combine #'combine])
body ...))
(define-syntax (pict-if stx)
(syntax-case stx ()
[(_ #:combine combine test success failure)
(syntax/loc stx
(let* ([result test])
(combine (show success result)
(hide failure result))))]
[(_ test success failure)
(quasisyntax/loc stx
(pict-if #:combine #,(syntax-parameter-value #'pict-combine)
test success failure))]))
(define-syntax (pict-cond stx)
(syntax-case stx (else)
[(_ #:combine combine [test expr] ... [else default])
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ... [final default])
(combine (cond [test pict] ... [else final])
(ghost pict) ... (ghost final)))))]
[(_ #:combine combine [test pict] ...)
(syntax/loc stx
(pict-cond #:combine combine [test pict] ... [else (blank 0 0)]))]
[(_ [test expr] ...)
(quasisyntax/loc stx
(pict-cond #:combine #,(syntax-parameter-value #'pict-combine)
[test expr] ...))]))
(define-syntax (pict-case stx)
(syntax-case stx (else)
[(_ test #:combine combine [literals expr] ... [else default])
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ... [final default])
(combine (case test [literals pict] ... [else final])
(ghost pict) ... (ghost final)))))]
[(_ test #:combine combine [literals expr] ...)
(syntax/loc stx
(pict-case test #:combine combine
[literals expr] ... [else (blank 0 0)]))]
[(_ test [literals expr] ...)
(quasisyntax/loc stx
(pict-case test #:combine #,(syntax-parameter-value #'pict-combine)
[literals expr] ...))]))
(define-syntax (pict-match stx)
(syntax-case stx ()
[(_ test #:combine combine [pattern expr] ...)
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ...)
(combine (match test [pattern pict] ... [_ (blank 0 0)])
(ghost pict) ...))))]
[(_ test [pattern expr] ...)
(quasisyntax/loc stx
(pict-match test #:combine #,(syntax-parameter-value #'pict-combine)
[pattern expr] ...))]))
(provide/contract
[hide (->* [pict?] [any/c] pict?)]
[show (->* [pict?] [any/c] pict?)]
[strike (->* [pict?] [any/c] pict?)]
[shade (->* [pict?] [any/c #:ratio (real-in 0 1)] pict?)])
(provide staged stage stage-name
before at after before/at at/after
pict-if pict-cond pict-case pict-match
pict-combine with-pict-combine)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Slide Staging
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-for-syntax (stage-keyword stx)
(raise-syntax-error #f "not in the body of a staged slide" stx))
(define-syntax-parameter stage stage-keyword)
(define-syntax-parameter stage-name stage-keyword)
(define-syntax (staged stx)
(syntax-case stx ()
[(_ [name ...] body ...)
(let* ([ids (syntax->list #'(name ...))])
(for ([id (in-list ids)] #:when (not (identifier? id)))
(raise-syntax-error #f "expected an identifier" stx id))
(with-syntax ([(num ...)
(for/list ([i (in-naturals 1)] [id (in-list ids)])
(datum->syntax #'here i id))])
(syntax/loc stx
(let* ([name num] ...)
(define (staged-computation number symbol)
(syntax-parameterize
([stage (make-rename-transformer #'number)]
[stage-name (make-rename-transformer #'symbol)])
(block body ...)))
(begin (staged-computation name 'name) ...)))))]))
(define-syntax-rule (before name) (< stage name))
(define-syntax-rule (before/at name) (<= stage name))
(define-syntax-rule (at/after name) (>= stage name))
(define-syntax-rule (after name) (> stage name))
(define-syntax-rule (before/after name) (not (= stage name)))
(define-syntax-rule (at name ...) (or (= stage name) ...))
(define (hide pict [hide? #t])
(if hide? (ghost pict) pict))
(define (show pict [show? #t])
(if show? pict (ghost pict)))
(define (shade pict [shade? #t] #:ratio [ratio 0.5])
(if shade? (cellophane pict ratio) pict))
(define (strike pict [strike? #t])
(if strike?
(pin-over pict
0
(/ (pict-height pict) 2)
(pip-line (pict-width pict) 0 0))
pict))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Misc
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the following has been added by stamourv
;; borders may be of slightly uneven width, sadly
(define-values (ellipse/border
rectangle/border
rounded-rectangle/border)
(let ()
(define ((mk shape) w h
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (shape w h) border-color)
(colorize (shape (- w (* 2 border-width))
(- h (* 2 border-width)))
color)))
(values (mk filled-ellipse)
(mk filled-rectangle)
(mk filled-rounded-rectangle))))
(define (circle/border d
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (disk d) border-color)
(colorize (disk (- d (* 2 border-width)))
color)))
(define shape/border-contract
(->* [real? real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?))
(provide/contract
[ellipse/border shape/border-contract]
[rectangle/border shape/border-contract]
[rounded-rectangle/border shape/border-contract]
[circle/border
(->* [real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?)])
;; the following has been written by Scott Owens
;; and updated and added by stamourv
(define (label-line label pict src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust (x-adjust 0) #:y-adjust (y-adjust 0))
(let-values (((src-x src-y) (src-coord-fn pict src-pict))
((dest-x dest-y) (dest-coord-fn pict dest-pict)))
(let* ((src (make-rectangular src-x src-y))
(dest (make-rectangular dest-x dest-y))
(adjust (make-rectangular x-adjust y-adjust))
(v (- dest src))
(h2 (pict-height label)))
;; Ensure that the src is left of dest
(when (< (real-part v) 0)
(set! v (- v))
(set! src dest))
(let ((p (+ src
;; Move the label to sit atop the line.
(/ (* h2 -i v) (magnitude v) 2)
;; Center the label in the line.
(/ (- v (make-rectangular (pict-width label)
(pict-height label)))
2)
adjust)))
(pin-over
pict
(real-part p)
(imag-part p)
label)))))
(define (pin-label-line label pict
src-pict src-coord-fn
dest-pict dest-coord-fn
#:start-angle (start-angle #f)
#:end-angle (end-angle #f)
#:start-pull (start-pull 1/4)
#:end-pull (end-pull 1/4)
#:line-width (line-width #f)
#:color (color #f)
#:under? (under? #f)
#:x-adjust (x-adjust 0)
#:y-adjust (y-adjust 0))
(label-line
label
(pin-line
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 #:under? under?)
src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust x-adjust #:y-adjust y-adjust))
(define-values (pin-arrow-label-line
pin-arrows-label-line)
(let ()
(define ((mk fn)
label arrow-size pict
src-pict src-coord-fn
dest-pict dest-coord-fn
#:start-angle (start-angle #f)
#:end-angle (end-angle #f)
#:start-pull (start-pull 1/4)
#:end-pull (end-pull 1/4)
#:line-width (line-width #f)
#:color (color #f)
#:under? (under? #f)
#:solid? (solid? #t)
#:hide-arrowhead? (hide-arrowhead? #f)
#:x-adjust (x-adjust 0)
#:y-adjust (y-adjust 0))
(label-line
label
(fn
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 #:under? under?
#:hide-arrowhead? hide-arrowhead?)
src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust x-adjust #:y-adjust y-adjust))
(values (mk pin-arrow-line)
(mk pin-arrows-line))))
(define pin-arrow-label-line-contract
(->* [pict? real? pict?
pict-path? (-> pict? pict-path? (values real? real?))
pict-path? (-> pict? pict-path? (values real? real?))]
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
#:start-pull real? #:end-pull real?
#:line-width (or/c real? #f)
#:color (or/c #f string? (is-a?/c color%))
#:under? any/c #:hide-arrowhead? any/c
#:x-adjust real? #:y-adjust real?]
pict?))
(provide/contract
[pin-label-line
(->* [pict? pict?
pict-path? (-> pict? pict-path? (values real? real?))
pict-path? (-> pict? pict-path? (values real? real?))]
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
#:start-pull real? #:end-pull real?
#:line-width (or/c real? #f)
#:color (or/c #f string? (is-a?/c color%))
#:under? any/c
#:x-adjust real? #:y-adjust real?]
pict?)]
[pin-arrow-label-line pin-arrow-label-line-contract]
[pin-arrows-label-line pin-arrow-label-line-contract])

386
collects/unstable/gui/slideshow.rkt
View File

@ -1,11 +1,12 @@
#lang racket/base
(require slideshow/base slideshow/pict
racket/contract racket/list racket/match
racket/splicing racket/stxparam racket/gui/base
racket/block racket/class
unstable/define
(for-syntax scheme/base))
(for-syntax racket/base)
"pict.rkt")
(provide (all-from-out "pict.rkt"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -32,35 +33,18 @@
(define-style superscript 'superscript)
(define-style caps 'caps)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Picture Manipulation
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide with-size
with-scale
big
small
(define (fill pict w h)
(cc-superimpose
pict
(blank (or w (pict-width pict))
(or h (pict-height pict)))))
(define (color c p) (colorize p c))
(define color/c
(or/c string? ;; might be faster
;;(and/c string? (lambda (s) (send the-color-database find-color s)))
(is-a?/c color%)
(list/c byte? byte? byte?)))
(define-syntax-rule (define-colors name ...)
(begin (define (name pict) (color (symbol->string 'name) pict)) ...))
(define-colors
red orange yellow green blue purple
black brown gray white cyan magenta)
(define (light c) (scale-color 2 c))
(define (dark c) (scale-color 1/2 c))
with-font
with-style
bold
italic
subscript
superscript
caps)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -83,6 +67,12 @@
(define (mini-slide . picts)
(apply vc-append gap-size picts))
(provide column
columns
column-size
two-columns
mini-slide)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Simple Tables
@ -124,171 +114,6 @@
[(list _) #t]
[(list xs ...) (apply = (map length xs))]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Space-smart picture selection
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax-parameter pict-combine #'ltl-superimpose)
(define-syntax-rule (with-pict-combine combine body ...)
(splicing-syntax-parameterize
([pict-combine #'combine])
body ...))
(define-syntax (pict-if stx)
(syntax-case stx ()
[(_ #:combine combine test success failure)
(syntax/loc stx
(let* ([result test])
(combine (show success result)
(hide failure result))))]
[(_ test success failure)
(quasisyntax/loc stx
(pict-if #:combine #,(syntax-parameter-value #'pict-combine)
test success failure))]))
(define-syntax (pict-cond stx)
(syntax-case stx (else)
[(_ #:combine combine [test expr] ... [else default])
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ... [final default])
(combine (cond [test pict] ... [else final])
(ghost pict) ... (ghost final)))))]
[(_ #:combine combine [test pict] ...)
(syntax/loc stx
(pict-cond #:combine combine [test pict] ... [else (blank 0 0)]))]
[(_ [test expr] ...)
(quasisyntax/loc stx
(pict-cond #:combine #,(syntax-parameter-value #'pict-combine)
[test expr] ...))]))
(define-syntax (pict-case stx)
(syntax-case stx (else)
[(_ test #:combine combine [literals expr] ... [else default])
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ... [final default])
(combine (case test [literals pict] ... [else final])
(ghost pict) ... (ghost final)))))]
[(_ test #:combine combine [literals expr] ...)
(syntax/loc stx
(pict-case test #:combine combine
[literals expr] ... [else (blank 0 0)]))]
[(_ test [literals expr] ...)
(quasisyntax/loc stx
(pict-case test #:combine #,(syntax-parameter-value #'pict-combine)
[literals expr] ...))]))
(define-syntax (pict-match stx)
(syntax-case stx ()
[(_ test #:combine combine [pattern expr] ...)
(with-syntax ([(pict ...) (generate-temporaries #'(expr ...))])
(syntax/loc stx
(let ([pict expr] ...)
(combine (match test [pattern pict] ... [_ (blank 0 0)])
(ghost pict) ...))))]
[(_ test [pattern expr] ...)
(quasisyntax/loc stx
(pict-match test #:combine #,(syntax-parameter-value #'pict-combine)
[pattern expr] ...))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Slide Staging
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-for-syntax (stage-keyword stx)
(raise-syntax-error #f "not in the body of a staged slide" stx))
(define-syntax-parameter stage stage-keyword)
(define-syntax-parameter stage-name stage-keyword)
(define-syntax (staged stx)
(syntax-case stx ()
[(_ [name ...] body ...)
(let* ([ids (syntax->list #'(name ...))])
(for ([id (in-list ids)] #:when (not (identifier? id)))
(raise-syntax-error #f "expected an identifier" stx id))
(with-syntax ([(num ...)
(for/list ([i (in-naturals 1)] [id (in-list ids)])
(datum->syntax #'here i id))])
(syntax/loc stx
(let* ([name num] ...)
(define (staged-computation number symbol)
(syntax-parameterize
([stage (make-rename-transformer #'number)]
[stage-name (make-rename-transformer #'symbol)])
(block body ...)))
(begin (staged-computation name 'name) ...)))))]))
(define-syntax-rule (slide/staged [name ...] body ...)
(staged [name ...] (slide body ...)))
(define-syntax-rule (before name) (< stage name))
(define-syntax-rule (before/at name) (<= stage name))
(define-syntax-rule (at/after name) (>= stage name))
(define-syntax-rule (after name) (> stage name))
(define-syntax-rule (before/after name) (not (= stage name)))
(define-syntax-rule (at name ...) (or (= stage name) ...))
(define (hide pict [hide? #t])
(if hide? (ghost pict) pict))
(define (show pict [show? #t])
(if show? pict (ghost pict)))
(define (shade pict [shade? #t] #:ratio [ratio 0.5])
(if shade? (cellophane pict ratio) pict))
(define (strike pict [strike? #t])
(if strike?
(pin-over pict
0
(/ (pict-height pict) 2)
(pip-line (pict-width pict) 0 0))
pict))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Exports
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide with-size with-scale big small
with-font with-style bold italic subscript superscript caps)
(provide/contract
[color/c flat-contract?]
[red (-> pict? pict?)]
[orange (-> pict? pict?)]
[yellow (-> pict? pict?)]
[green (-> pict? pict?)]
[blue (-> pict? pict?)]
[purple (-> pict? pict?)]
[black (-> pict? pict?)]
[brown (-> pict? pict?)]
[gray (-> pict? pict?)]
[white (-> pict? pict?)]
[cyan (-> pict? pict?)]
[magenta (-> pict? pict?)]
[light (-> color/c color/c)]
[dark (-> color/c color/c)]
[color (-> color/c pict? pict?)]
[fill
(-> pict?
(or/c (real-in 0 +inf.0) #f)
(or/c (real-in 0 +inf.0) #f)
pict?)])
(provide column columns column-size two-columns mini-slide)
(provide/contract
[tabular (->* []
[#:gap natural-number/c
@ -300,168 +125,25 @@
#:rest (matrixof (or/c string? pict?))
pict?)])
(provide/contract
[hide (->* [pict?] [any/c] pict?)]
[show (->* [pict?] [any/c] pict?)]
[strike (->* [pict?] [any/c] pict?)]
[shade (->* [pict?] [any/c #:ratio (real-in 0 1)] pict?)])
(provide staged slide/staged stage stage-name
before at after before/at at/after
pict-if pict-cond pict-case pict-match
pict-combine with-pict-combine)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Slide Staging
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax-rule (slide/staged [name ...] body ...)
(staged [name ...] (slide body ...)))
;; the following has been added by stamourv
(provide slide/staged)
;; borders may be of slightly uneven width, sadly
(define-values (ellipse/border
rectangle/border
rounded-rectangle/border)
(let ()
(define ((mk shape) w h
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (shape w h) border-color)
(colorize (shape (- w (* 2 border-width))
(- h (* 2 border-width)))
color)))
(values (mk filled-ellipse)
(mk filled-rectangle)
(mk filled-rounded-rectangle))))
(define (circle/border d
#:color (color "white")
#:border-color (border-color "black")
#:border-width (border-width 2))
(cc-superimpose
(colorize (disk d) border-color)
(colorize (disk (- d (* 2 border-width)))
color)))
(define shape/border-contract
(->* [real? real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?))
(provide/contract
[ellipse/border shape/border-contract]
[rectangle/border shape/border-contract]
[rounded-rectangle/border shape/border-contract]
[circle/border
(->* [real?]
[#:color color/c #:border-color color/c #:border-width real?]
pict?)])
;; the following has been written by Scott Owens
;; and updated and added by stamourv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Misc
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (blank-line)
(blank 0 (current-font-size)))
(define (label-line label pict src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust (x-adjust 0) #:y-adjust (y-adjust 0))
(let-values (((src-x src-y) (src-coord-fn pict src-pict))
((dest-x dest-y) (dest-coord-fn pict dest-pict)))
(let* ((src (make-rectangular src-x src-y))
(dest (make-rectangular dest-x dest-y))
(adjust (make-rectangular x-adjust y-adjust))
(v (- dest src))
(h2 (pict-height label)))
;; Ensure that the src is left of dest
(when (< (real-part v) 0)
(set! v (- v))
(set! src dest))
(let ((p (+ src
;; Move the label to sit atop the line.
(/ (* h2 -i v) (magnitude v) 2)
;; Center the label in the line.
(/ (- v (make-rectangular (pict-width label)
(pict-height label)))
2)
adjust)))
(pin-over
pict
(real-part p)
(imag-part p)
label)))))
(define (pin-label-line label pict
src-pict src-coord-fn
dest-pict dest-coord-fn
#:start-angle (start-angle #f)
#:end-angle (end-angle #f)
#:start-pull (start-pull 1/4)
#:end-pull (end-pull 1/4)
#:line-width (line-width #f)
#:color (color #f)
#:under? (under? #f)
#:x-adjust (x-adjust 0)
#:y-adjust (y-adjust 0))
(label-line
label
(pin-line
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 #:under? under?)
src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust x-adjust #:y-adjust y-adjust))
(define-values (pin-arrow-label-line
pin-arrows-label-line)
(let ()
(define ((mk fn)
label arrow-size pict
src-pict src-coord-fn
dest-pict dest-coord-fn
#:start-angle (start-angle #f)
#:end-angle (end-angle #f)
#:start-pull (start-pull 1/4)
#:end-pull (end-pull 1/4)
#:line-width (line-width #f)
#:color (color #f)
#:under? (under? #f)
#:solid? (solid? #t)
#:hide-arrowhead? (hide-arrowhead? #f)
#:x-adjust (x-adjust 0)
#:y-adjust (y-adjust 0))
(label-line
label
(fn
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 #:under? under?
#:hide-arrowhead? hide-arrowhead?)
src-pict src-coord-fn dest-pict dest-coord-fn
#:x-adjust x-adjust #:y-adjust y-adjust))
(values (mk pin-arrow-line)
(mk pin-arrows-line))))
(define pin-arrow-label-line-contract
(->* [pict? real? pict?
pict-path? (-> pict? pict-path? (values real? real?))
pict-path? (-> pict? pict-path? (values real? real?))]
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
#:start-pull real? #:end-pull real?
#:line-width (or/c real? #f)
#:color (or/c #f string? (is-a?/c color%))
#:under? any/c #:hide-arrowhead? any/c
#:x-adjust real? #:y-adjust real?]
pict?))
(provide/contract
[blank-line (-> pict?)]
[pin-label-line
(->* [pict? pict?
pict-path? (-> pict? pict-path? (values real? real?))
pict-path? (-> pict? pict-path? (values real? real?))]
[#:start-angle (or/c real? #f) #:end-angle (or/c real? #f)
#:start-pull real? #:end-pull real?
#:line-width (or/c real? #f)
#:color (or/c #f string? (is-a?/c color%))
#:under? any/c
#:x-adjust real? #:y-adjust real?]
pict?)]
[pin-arrow-label-line pin-arrow-label-line-contract]
[pin-arrows-label-line pin-arrow-label-line-contract])
[blank-line (-> pict?)])

1
collects/unstable/scribblings/gui.scrbl
View File

@ -10,6 +10,7 @@
@include-section["gui/language-level.scrbl"]
@include-section["gui/notify.scrbl"]
@include-section["gui/prefs.scrbl"]
@include-section["gui/pict.scrbl"]
@include-section["gui/slideshow.scrbl"]
@include-section["gui/pslide.scrbl"]
@include-section["gui/blur.scrbl"]

341
collects/unstable/scribblings/gui/pict.scrbl Normal file
View File

@ -0,0 +1,341 @@
#lang scribble/manual
@(require "../utils.rkt"
scribble/eval
(for-label slideshow
unstable/contract
unstable/gui/pict))
@(define the-eval (make-base-eval))
@(the-eval '(require racket/math slideshow/pict unstable/gui/pict))
@title{Pict Utilities}
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
@defmodule[unstable/gui/pict]
The functions and macros exported by this module are also exported by
@racketmodname[unstable/gui/slideshow].
@;{----------------------------------------}
@section{Pict Colors}
@defproc[(color [c color/c] [p pict?]) pict?]{
Applies color @racket[c] to picture @racket[p]. Equivalent to @racket[(colorize
p c)].
@examples[#:eval the-eval
(color "red" (disk 20))
]
}
@deftogether[(
@defproc[(red [pict pict?]) pict?]
@defproc[(orange [pict pict?]) pict?]
@defproc[(yellow [pict pict?]) pict?]
@defproc[(green [pict pict?]) pict?]
@defproc[(blue [pict pict?]) pict?]
@defproc[(purple [pict pict?]) pict?]
@defproc[(black [pict pict?]) pict?]
@defproc[(brown [pict pict?]) pict?]
@defproc[(gray [pict pict?]) pict?]
@defproc[(white [pict pict?]) pict?]
@defproc[(cyan [pict pict?]) pict?]
@defproc[(magenta [pict pict?]) pict?]
)]{
These functions apply appropriate colors to picture @racket[p].
@examples[#:eval the-eval
(red (disk 20))
]
}
@deftogether[(
@defproc[(light [color color/c]) color/c]
@defproc[(dark [color color/c]) color/c]
)]{
These functions produce ligher or darker versions of a color.
@examples[#:eval the-eval
(hc-append (colorize (disk 20) "red")
(colorize (disk 20) (dark "red"))
(colorize (disk 20) (light "red")))
]
}
@defthing[color/c flat-contract?]{
This contract recognizes color strings, @racket[color%] instances, and RGB color
lists.
}
@;{----------------------------------------}
@section{Pict Manipulation}
@defproc[(fill [pict pict?] [width (or/c real? #f)] [height (or/c real? #f)])
pict?]{
Extends @racket[pict]'s bounding box to a minimum @racket[width] and/or
@racket[height], placing the original picture in the middle of the space.
@examples[#:eval the-eval
(frame (fill (disk 20) 40 40))
]
}
@subsection{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.
@deftogether[(
@defproc[(show [pict pict?] [show? truth/c #t]) pict?]
@defproc[(hide [pict pict?] [hide? truth/c #t]) pict?]
)]{
These functions conditionally show or hide an image, essentially choosing
between @racket[pict] and @racket[(ghost pict)]. The only difference between
the two is the default behavior and the opposite meaning of the @racket[show?]
and @racket[hide?] booleans. Both functions are provided for mnemonic purposes.
}
@defproc[(strike [pict pict?] [strike? truth/c #t]) pict?]{
Displays a strikethrough image by putting a line through the middle of
@racket[pict] if @racket[strike?] is true; produces @racket[pict] unchanged
otherwise.
@examples[#:eval the-eval
(strike (colorize (disk 20) "yellow"))
]
}
@defproc[(shade [pict pict?]
[shade? truth/c #t]
[#:ratio ratio (real-in 0 1) 1/2])
pict?]{
Shades @racket[pict] to show with @racket[ratio] of its normal opacity; if
@racket[ratio] is @racket[1] or @racket[shade?] is @racket[#f], shows
@racket[pict] unchanged.
@examples[#:eval the-eval
(shade (colorize (disk 20) "red"))
]
}
@subsection{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 @racket[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.
@defform/subs[(pict-if maybe-combine test-expr then-expr else-expr)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses either @racket[then-expr] or @racket[else-expr] based on
@racket[test-expr], similarly to @racket[if]. Combines the chosen, visible
image with the other, invisible image using @racket[combine-expr], defaulting to
@racket[pict-combine].
@examples[#:eval the-eval
(let ([f (lambda (x)
(pict-if x
(disk 20)
(disk 40)))])
(hc-append 10
(frame (f #t))
(frame (f #f))))
]
}
@defform/subs[(pict-cond maybe-combine [test-expr pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on the first successful @racket[test-expr],
similarly to @racket[cond]. Combines the chosen, visible image with the other,
invisible images using @racket[combine-expr], defaulting to
@racket[pict-combine].
@examples[#:eval the-eval
(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))))
]
}
@defform/subs[(pict-case test-expr maybe-combine [literals pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on @racket[test-expr] and each list of
@racket[literals], similarly to @racket[case]. Combines the chosen, visible
image with the other, invisible images using @racket[combine-expr], defaulting
to @racket[pict-combine].
@examples[#:eval the-eval
(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))))
]
}
@defform/subs[(pict-match test-expr maybe-combine [pattern pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on @racket[test-expr] and each
@racket[pattern], similarly to @racket[match]. Combines the chosen, visible
image with the other, invisible images using @racket[combine-expr], defaulting
to @racket[pict-combine].
}
@defform[#:id pict-combine pict-combine]{
This syntax parameter determines the default pict combining form used by the
above macros. It defaults to @racket[lbl-superimpose].
}
@defform[(with-pict-combine combine-id body ...)]{
Sets @racket[pict-combine] to refer to @racket[combine-id] within each of the
@racket[body] terms, which are spliced into the containing context.
@examples[#:eval the-eval
(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))))
]
}
@section{Miscellaneous Pict Utilities}
@addition{Vincent St-Amour}
@deftogether[(
@defproc[(ellipse/border [w real?] [h real?]
[#:color color color/c "white"]
[#:border-color border-color color/c "black"]
[#:border-width border-width real? 2])
pict?]
@defproc[(circle/border [diameter real?]
[#:color color color/c "white"]
[#:border-color border-color color/c "black"]
[#:border-width border-width real? 2])
pict?]
@defproc[(rectangle/border [w real?] [h real?]
[#:color color color/c "white"]
[#:border-color border-color color/c "black"]
[#:border-width border-width real? 2])
pict?]
@defproc[(rounded-rectangle/border [w real?] [h real?]
[#:color color color/c "white"]
[#:border-color border-color color/c "black"]
[#:border-width border-width real? 2])
pict?]
)]{
These functions create shapes with border of the given color and width.
@examples[#:eval the-eval
(ellipse/border 40 20 #:border-color "blue")
(rounded-rectangle/border 40 20 #:color "red")
]
}
@addition{Scott Owens}
@deftogether[(
@defproc[(pin-label-line [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 start-angle (or/c real? #f) #f]
[#:end-angle end-angle (or/c real? #f) #f]
[#:start-pull start-pull real? 1/4]
[#:end-pull end-pull real? 1/4]
[#:line-width line-width (or/c real? #f) #f]
[#:color color (or/c #f string? (is-a?/c color%)) #f]
[#:under? under? any/c #f]
[#:x-adjust x-adjust real? 0]
[#:y-adjust y-adjust real? 0])
pict?]
@defproc[(pin-arrow-label-line [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 start-angle (or/c real? #f) #f]
[#:end-angle end-angle (or/c real? #f) #f]
[#:start-pull start-pull real? 1/4]
[#:end-pull end-pull real? 1/4]
[#:line-width line-width (or/c real? #f) #f]
[#:color color (or/c #f string? (is-a?/c color%)) #f]
[#:under? under? any/c #f]
[#:hide-arrowhead? hide-arrowhead? any/c #f]
[#:x-adjust x-adjust real? 0]
[#:y-adjust y-adjust real? 0])
pict?]
@defproc[(pin-arrows-label-line [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 start-angle (or/c real? #f) #f]
[#:end-angle end-angle (or/c real? #f) #f]
[#:start-pull start-pull real? 1/4]
[#:end-pull end-pull real? 1/4]
[#:line-width line-width (or/c real? #f) #f]
[#:color color (or/c #f string? (is-a?/c color%)) #f]
[#:under? under? any/c #f]
[#:hide-arrowhead? hide-arrowhead? any/c #f]
[#:x-adjust x-adjust real? 0]
[#:y-adjust y-adjust real? 0])
pict?]
)]{
These functions behave like @racket[pin-line], @racket[pin-arrow-line]
and @racket[pin-arrows-line] with the addition of a label attached to
the line.
@examples[#:eval the-eval
(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))
]
}
@(close-eval the-eval)

309
collects/unstable/scribblings/gui/slideshow.scrbl
View File

@ -6,9 +6,12 @@
@title{Slideshow Presentations}
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
@defmodule[unstable/gui/slideshow]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module also exports everything provided by
@racketmodname[unstable/gui/pict].
@section{Text Formatting}
@ -61,201 +64,6 @@ text, respectively, to @racket[current-main-font] while running @racket[text].
}
@section{Pict Colors}
@defproc[(color [c color/c] [p pict?]) pict?]{
Applies color @racket[c] to picture @racket[p]. Equivalent to @racket[(colorize
p c)].
}
@deftogether[(
@defproc[(red [pict pict?]) pict?]
@defproc[(orange [pict pict?]) pict?]
@defproc[(yellow [pict pict?]) pict?]
@defproc[(green [pict pict?]) pict?]
@defproc[(blue [pict pict?]) pict?]
@defproc[(purple [pict pict?]) pict?]
@defproc[(black [pict pict?]) pict?]
@defproc[(brown [pict pict?]) pict?]
@defproc[(gray [pict pict?]) pict?]
@defproc[(white [pict pict?]) pict?]
@defproc[(cyan [pict pict?]) pict?]
@defproc[(magenta [pict pict?]) pict?]
)]{
These functions apply appropriate colors to picture @racket[p].
}
@deftogether[(
@defproc[(light [color color/c]) color/c]
@defproc[(dark [color color/c]) color/c]
)]{
These functions produce ligher or darker versions of a color.
}
@defthing[color/c flat-contract?]{
This contract recognizes color strings, @racket[color%] instances, and RGB color
lists.
}
@section{Pict Manipulation}
@defproc[(fill [pict pict?] [width (or/c real? #f)] [height (or/c real? #f)])
pict?]{
Extends @racket[pict]'s bounding box to a minimum @racket[width] and/or
@racket[height], placing the original picture in the middle of the space.
}
@subsection{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.
@deftogether[(
@defproc[(show [pict pict?] [show? truth/c #t]) pict?]
@defproc[(hide [pict pict?] [hide? truth/c #t]) pict?]
)]{
These functions conditionally show or hide an image, essentially choosing
between @racket[pict] and @racket[(ghost pict)]. The only difference between
the two is the default behavior and the opposite meaning of the @racket[show?]
and @racket[hide?] booleans. Both functions are provided for mnemonic purposes.
}
@defproc[(strike [pict pict?] [strike? truth/c #t]) pict?]{
Displays a strikethrough image by putting a line through the middle of
@racket[pict] if @racket[strike?] is true; produces @racket[pict] unchanged
otherwise.
}
@defproc[(shade [pict pict?]
[shade? truth/c #t]
[#:ratio ratio (real-in 0 1) 1/2])
pict?]{
Shades @racket[pict] to show with @racket[ratio] of its normal opacity; if
@racket[ratio] is @racket[1] or @racket[shade?] is @racket[#f], shows
@racket[pict] unchanged.
}
@subsection{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 @racket[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.
@defform/subs[(pict-if maybe-combine test-expr then-expr else-expr)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses either @racket[then-expr] or @racket[else-expr] based on
@racket[test-expr], similarly to @racket[if]. Combines the chosen, visible
image with the other, invisible image using @racket[combine-expr], defaulting to
@racket[pict-combine].
}
@defform/subs[(pict-cond maybe-combine [test-expr pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on the first successful @racket[test-expr],
similarly to @racket[cond]. Combines the chosen, visible image with the other,
invisible images using @racket[combine-expr], defaulting to
@racket[pict-combine].
}
@defform/subs[(pict-case test-expr maybe-combine [literals pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on @racket[test-expr] and each list of
@racket[literals], similarly to @racket[case]. Combines the chosen, visible
image with the other, invisible images using @racket[combine-expr], defaulting
to @racket[pict-combine].
}
@defform/subs[(pict-match test-expr maybe-combine [pattern pict-expr] ...)
([maybe-combine code:blank (code:line #:combine combine-expr)])]{
Chooses a @racket[pict-expr] based on @racket[test-expr] and each
@racket[pattern], similarly to @racket[match]. Combines the chosen, visible
image with the other, invisible images using @racket[combine-expr], defaulting
to @racket[pict-combine].
}
@defform[#:id pict-combine pict-combine]{
This syntax parameter determines the default pict combining form used by the
above macros. It defaults to @racket[lbl-superimpose].
}
@defform[(with-pict-combine combine-id body ...)]{
Sets @racket[pict-combine] to refer to @racket[combine-id] within each of the
@racket[body] terms, which are spliced into the containing context.
}
@section{Staged Slides}
@defform[(staged [name ...] body ...)]{
Executes the @racket[body] terms once for each stage @racket[name]. The terms
may include expressions and mutually recursive definitions. Within the body,
each @racket[name] is bound to a number from @racket[1] to the number of stages
in order. Furthermore, during execution @racket[stage] is bound to the number
of the current stage and @racket[stage-name] is bound to a symbol representing
the @racket[name] of the current stage. By comparing @racket[stage] to the
numeric value of each @racket[name], or @racket[stage-name] to quoted symbols of
the form @racket['name], the user may compute based on the progression of the
stages.
}
@deftogether[(
@defform[#:id stage stage]
@defform[#:id stage-name stage-name]
)]{
These keywords are bound during the execution of @racket[staged] and should not
be used otherwise.
}
@defform[(slide/staged [name ...] arg ...)]{
Creates a staged slide. Equivalent to @racket[(staged [name ...] (slide arg
...))].
Within a staged slide, the boolean arguments to @racket[hide], @racket[show],
@racket[strike], and @racket[shade] can be used to determine in which stages to
perform a transformation. The macros @racket[pict-if], @racket[pict-cond],
@racket[pict-case], and @racket[pict-match] may also be used to create images
which change naturally between stages.
}
@section{Tables}
@defproc[(tabular [row (listof (or/c string? pict?))] ...
@ -314,89 +122,46 @@ Computes the width of one column out of @racket[n] that takes up a ratio of
}
@addition{Vincent St-Amour}
@section{Staged Slides}
@defform[(staged [name ...] body ...)]{
Executes the @racket[body] terms once for each stage @racket[name]. The terms
may include expressions and mutually recursive definitions. Within the body,
each @racket[name] is bound to a number from @racket[1] to the number of stages
in order. Furthermore, during execution @racket[stage] is bound to the number
of the current stage and @racket[stage-name] is bound to a symbol representing
the @racket[name] of the current stage. By comparing @racket[stage] to the
numeric value of each @racket[name], or @racket[stage-name] to quoted symbols of
the form @racket['name], the user may compute based on the progression of the
stages.
}
@deftogether[(
@defproc[(ellipse/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(circle/border [diameter real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(rectangle/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defproc[(rounded-rectangle/border [w real?] [h real?]
[#:color color color/c]
[#:border-color border-color color/c]
[#:border-width border-width real?])
pict?]
@defform[#:id stage stage]
@defform[#:id stage-name stage-name]
)]{
These functions create shapes with border of the given color and width.
These keywords are bound during the execution of @racket[staged] and should not
be used otherwise.
}
@defform[(slide/staged [name ...] arg ...)]{
Creates a staged slide. Equivalent to @racket[(staged [name ...] (slide arg
...))].
Within a staged slide, the boolean arguments to @racket[hide], @racket[show],
@racket[strike], and @racket[shade] can be used to determine in which stages to
perform a transformation. The macros @racket[pict-if], @racket[pict-cond],
@racket[pict-case], and @racket[pict-match] may also be used to create images
which change naturally between stages.
}
@section{Miscellaneous Slide Utilities}
@addition{Scott Owens}
@defproc[(blank-line) pict?]{
Adds a blank line of the current font size's height.
}
@deftogether[(
@defproc[(pin-label-line [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 start-angle (or/c real? #f)]
[#:end-angle end-angle (or/c real? #f)]
[#:start-pull start-pull real?]
[#:end-pull end-pull real?]
[#:line-width line-width (or/c real? #f)]
[#:color color (or/c #f string? (is-a?/c color%))]
[#:under? under? any/c]
[#:x-adjust x-adjust real?]
[#:y-adjust y-adjust real?])
pict?]
@defproc[(pin-arrow-label-line [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 start-angle (or/c real? #f)]
[#:end-angle end-angle (or/c real? #f)]
[#:start-pull start-pull real?]
[#:end-pull end-pull real?]
[#:line-width line-width (or/c real? #f)]
[#:color color (or/c #f string? (is-a?/c color%))]
[#:under? under? any/c]
[#:hide-arrowhead? hide-arrowhead? any/c]
[#:x-adjust x-adjust real?]
[#:y-adjust y-adjust real?])
pict?]
@defproc[(pin-arrows-label-line [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 start-angle (or/c real? #f)]
[#:end-angle end-angle (or/c real? #f)]
[#:start-pull start-pull real?]
[#:end-pull end-pull real?]
[#:line-width line-width (or/c real? #f)]
[#:color color (or/c #f string? (is-a?/c color%))]
[#:under? under? any/c]
[#:hide-arrowhead? hide-arrowhead? any/c]
[#:x-adjust x-adjust real?]
[#:y-adjust y-adjust real?])
pict?]
)]{
These functions behave like @racket[pin-line], @racket[pin-arrow-line]
and @racket[pin-arrows-line] with the addition of a label attached to
the line.
}