From 5c957f915c18b7b0a026fb2a4b273443288b6c0f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 24 Feb 2009 17:39:21 +0000 Subject: [PATCH] actually, just fold pin-curve, etc. into pin-line svn: r13820 --- collects/scribblings/slideshow/picts.scrbl | 86 +++++++------------ collects/slideshow/pict.ss | 99 +++++++++------------- 2 files changed, 71 insertions(+), 114 deletions(-) diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/scribblings/slideshow/picts.scrbl index 144560068e..72d8a03d26 100644 --- a/collects/scribblings/slideshow/picts.scrbl +++ b/collects/scribblings/slideshow/picts.scrbl @@ -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?]{ diff --git a/collects/slideshow/pict.ss b/collects/slideshow/pict.ss index 81281cdd2e..aac07f9fb0 100644 --- a/collects/slideshow/pict.ss +++ b/collects/slideshow/pict.ss @@ -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