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

actually, just fold pin-curve, etc. into pin-line

Browse Source 
svn: r13820
This commit is contained in:
Matthew Flatt 2009-02-24 17:39:21 +00:00
parent 8dae35d46b
commit 5c957f915c
2 changed files with 71 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/scribblings/slideshow/picts.scrbl
View File

@ -285,6 +285,10 @@ argument for consistency with the other functions.}
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f])
@ -294,6 +298,10 @@ argument for consistency with the other functions.}
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f]
@ -304,6 +312,10 @@ argument for consistency with the other functions.}
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f]
@ -317,67 +329,27 @@ and destination of the line.
If @scheme[under?] is true, then the line and arrows are added under
the existing @scheme[pict] drawing, instead of on top. If
@scheme[solid?] is false, then the arrowheads are hollow instead of
filled.}
filled.
@defproc*[([(pin-curve [arrow-size real? 12]
[pict pict?]
[src pict-path?]
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f])
pict?]
[(pin-arrow-curve [arrow-size real? 12]
[pict pict?]
[src pict-path?]
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f]
[#:solid? solid? any/c #t])
pict?]
[(pin-arrows-curve [arrow-size real? 12]
[pict pict?]
[src pict-path?]
[find-src (pict? pict-path? . -> . (values real? real?))]
[dest pict-path?]
[find-dest (pict? 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 (or/c real? #f) #f]
[#:end-pull end-pull (or/c real? #f) #f]
[#:line-width line-width (or/c #f real?) #f]
[#:color color (or/c #f string? (is-a/c? color%)) #f]
[#:under? under? any/c #f]
[#:solid? solid? any/c #t])
pict?])]{
The @scheme[start-angle], @scheme[end-angle], @scheme[start-pull], and
@scheme[end-pull] arguments control the curve of the line:
Like @scheme[pin-arrow-line], etc., but draws a Bezier curve based on
@scheme[start-angle], @scheme[end-angle], @scheme[start-pull], and
@scheme[end-pull].
@itemize[
The @scheme[start-angle] and @scheme[end-angle] arguments specify the
direction of curve at its start and end positions; if either is
@scheme[#f], it defaults to the angle of a straight line from the
start position to end position.
@item{The @scheme[start-angle] and @scheme[end-angle] arguments
specify the direction of curve at its start and end positions;
if either is @scheme[#f], it defaults to the angle of a
straight line from the start position to end position.}
The @scheme[start-pull] and @scheme[end-pull] arguments specify a kind
of momentum for the starting and ending angles; larger values preserve
the angle longer. If @scheme[start-pull] or @scheme[end-pull] is
@scheme[#f], then it is replaced with one-fourth of the distance
between the start and end points.}
@item{The @scheme[start-pull] and @scheme[end-pull] arguments specify
a kind of momentum for the starting and ending angles; larger
values preserve the angle longer. If @scheme[start-pull] or
@scheme[end-pull] is @scheme[#f], then it is replaced with
one-fourth of the distance between the start and end points.}
]
The defaults produce a straight line.}
@defthing[text-style/c contract?]{

99
collects/slideshow/pict.ss
View File

@ -42,62 +42,24 @@
(list? p)
(andmap pict? p))))
(define (pin-line p src find-src dest find-dest
#:line-width [lw #f]
(define (pin-line sz p
src src-find
dest dest-find
#:start-angle [sa #f] #:end-angle [ea #f]
#:start-pull [sp #f] #:end-pull [ep #f]
#:color [col #f]
#:under? [under? #f])
(finish-pin (launder (t:pin-line (ghost p)
src find-src
dest find-dest))
p lw col under?))
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t])
(if (not (or sa ea))
(finish-pin (launder (t:pin-line (ghost p)
src src-find
dest dest-find))
p lw col under?)
(pin-curve* #f #f p src src-find dest dest-find
sa ea sp ep sz col lw under? #t)))
(define (pin-arrow-line sz p src find-src dest find-dest
#:line-width [lw #f]
#:color [col #f]
#:under? [under? #f]
#:solid? [solid? #t])
(finish-pin (launder (t:pin-arrow-line sz (ghost p)
src find-src
dest find-dest
#f #f #f solid?))
p lw col under?))
(define (pin-arrows-line sz p src find-src dest find-dest
#:line-width [lw #f]
#:color [col #f]
#:under? [under? #f]
#:solid? [solid? #t])
(finish-pin (launder (t:pin-arrows-line sz (ghost p)
src find-src
dest find-dest
#f #f #f solid?))
p lw col under?))
(define (pin-curve sz p
src src-find
dest dest-find
#:start-angle [sa #f] #:end-angle [ea #f]
#:start-pull [sp #f] #:end-pull [ep #f]
#:color [col #f]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t])
(pin-curve* #f #f p src src-find dest dest-find
sa ea sp ep sz col lw under? #t))
(define (pin-arrow-curve sz p
src src-find
dest dest-find
#:start-angle [sa #f] #:end-angle [ea #f]
#:start-pull [sp #f] #:end-pull [ep #f]
#:color [col #f]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t])
(pin-curve* #f #t p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?))
(define (pin-arrows-curve sz p
(define (pin-arrow-line sz p
src src-find
dest dest-find
#:start-angle [sa #f] #:end-angle [ea #f]
@ -106,9 +68,33 @@
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t])
(pin-curve* #t #t p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?))
(if (not (or sa ea))
(finish-pin (launder (t:pin-arrow-line sz (ghost p)
src src-find
dest dest-find
#f #f #f solid?))
p lw col under?)
(pin-curve* #f #t p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?)))
(define (pin-arrows-line sz p
src src-find
dest dest-find
#:start-angle [sa #f] #:end-angle [ea #f]
#:start-pull [sp #f] #:end-pull [ep #f]
#:color [col #f]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t])
(if (not sa ea)
(finish-pin (launder (t:pin-arrows-line sz (ghost p)
src src-find
dest dest-find
#f #f #f solid?))
p lw col under?)
(pin-curve* #t #t p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?)))
(define (pin-curve* start-arrow? end-arrow? p
src src-find
dest dest-find
@ -199,7 +185,6 @@
frame
pict-path?
pin-line pin-arrow-line pin-arrows-line
pin-curve pin-arrow-curve pin-arrows-curve
(except-out (all-from-out texpict/mrpict)
dash-hline dash-vline