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

move the slideshow/pict library to its own collection

Browse Source 
also, adjust all of the requires in the tree to point to the pict
collection
This commit is contained in:
Robby Findler 2013-05-12 15:56:22 -05:00
parent f8622080bb
commit 9932ef33f7
79 changed files with 1475 additions and 1427 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/2htdp/tests/test-image.rkt
View File

@ -55,8 +55,8 @@
wxme
rackunit
file/convertible
slideshow/pict-convert
(only-in slideshow/pict pict?)
pict/convert
(only-in pict pict?)
(only-in lang/imageeq image=?)
(prefix-in 1: htdp/image)
(only-in lang/htdp-advanced equal~?)

8
collects/drracket/private/language.rkt
View File

@ -371,18 +371,18 @@
(define-syntax-rule
(dyn name)
(define name (if gave-up?
(symbol->string (format "~a-gave-up" 'name))
(dynamic-require 'slideshow/pict 'name))))
(string->symbol (format "~a-gave-up" 'name))
(dynamic-require 'pict 'name))))
(define gave-up? #f)
(define pict:convertible?
(with-handlers ((exn:fail? (λ (exn)
(set! gave-up? #t)
(log-error (exn-message exn))
(λ (val) #f))))
(dynamic-require 'slideshow/pict-convert 'pict-convertible?)))
(dynamic-require 'pict/convert 'pict-convertible?)))
(define pict-convert (if gave-up?
'pict-convert-gave-up
(dynamic-require 'slideshow/pict-convert 'pict-convert)))
(dynamic-require 'pict/convert 'pict-convert)))
(dyn pict-width)
(dyn pict-height)
(dyn pict-ascent)

2
collects/drracket/tool-lib.rkt
View File

@ -1715,7 +1715,7 @@ all of the names in the tools library, for use defining keybindings
and then invokes @racket[thunk], returning what it returns.
When @racket[drracket:language:make-setup-printing-parameters] is invoked,
it @racket[dynamic-require]s @racketmodname[slideshow/pict-convert] and
it @racket[dynamic-require]s @racketmodname[pict/convert] and
closes over the results, using them to convert values when the resulting
procedure is invoked.
})

2
collects/future-visualizer/main.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/contract
slideshow/pict
pict
racket/bool
future-visualizer/trace
"private/visualizer-gui.rkt"

2
collects/future-visualizer/private/drawing-helpers.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/pict
(require pict
"display.rkt"
"constants.rkt")
(provide opacity-layer

2
collects/future-visualizer/private/gui-helpers.rkt
View File

@ -1,6 +1,6 @@
#lang racket/gui
(require framework
slideshow/pict
pict
"display.rkt"
"constants.rkt"
"pict-canvas.rkt")

2
collects/future-visualizer/private/pict-canvas.rkt
View File

@ -1,6 +1,6 @@
#lang racket/gui
(require framework
slideshow/pict
pict
"display.rkt")
(provide pict-canvas%)

2
collects/future-visualizer/private/visualizer-drawing.rkt
View File

@ -2,7 +2,7 @@
(require racket/list
racket/class
racket/draw
slideshow/pict
pict
data/interval-map
"visualizer-data.rkt"
"graph-drawing.rkt"

2
collects/games/scribblings/same.scrbl
View File

@ -1,5 +1,5 @@
#lang scribble/doc
@(require "common.rkt" racket/class racket/draw (only-in slideshow/pict dc)
@(require "common.rkt" racket/class racket/draw (only-in pict dc)
"../same/same-lib.rkt")
@(define board-width 6)

2
collects/games/scribblings/tally-maze.scrbl
View File

@ -1,5 +1,5 @@
#lang scribble/doc
@(require "common.rkt" racket/class racket/draw (only-in slideshow/pict dc))
@(require "common.rkt" racket/class racket/draw (only-in pict dc))
@(define (add-commas n)
(define s (number->string n))

2
collects/gui-debugger/debug-tool.rkt
View File

@ -28,7 +28,7 @@
images/icons/style
images/icons/symbol
images/icons/tool
slideshow/pict))
pict))
(provide tool@)

4
collects/images/scribblings/flomap.scrbl
View File

@ -7,7 +7,7 @@
racket/flonum
slideshow)
images/flomap
slideshow/pict)
pict)
@(require (for-label (only-in typed/racket
Integer Float Nonnegative-Fixnum Real Boolean
@ -917,7 +917,7 @@ Contents:
Some standard image transforms.
These are lossless, in that repeated applications do not degrade (blur or alias) the image.
@examples[#:eval flomap-eval
(require slideshow/pict)
(require pict)
(define text-fm
(flomap-trim
(bitmap->flomap

6
collects/images/scribblings/icons.scrbl
View File

@ -13,7 +13,7 @@
images/icons/style
images/logos
mrlib/switchable-button
slideshow/pict)
pict)
racket/class racket/draw
images/icons/arrow
images/icons/control
@ -70,7 +70,7 @@ The icons in this collection are designed to be composed to create new ones: the
Further, slideshow's @racket[pict] combiners offer a way to compose them almost arbitrarily.
For example, a media player application might create a large ``step'' button by superimposing a @racket[record-icon] and a @racket[step-icon]:
@interaction[#:eval icons-eval
(require slideshow/pict images/icons/control images/icons/style)
(require pict images/icons/control images/icons/style)
(pict->bitmap
(cc-superimpose
(bitmap (record-icon #:color "forestgreen" #:height 96
@ -195,7 +195,7 @@ Still, most of the simple icons (such as those in @racketmodname[images/icons/ar
@doc-apply[icon-color->outline-color]{
For a given icon color, returns the proper outline @racket[color%].
As an example, here is how to duplicate the @racket[record-icon] using @racketmodname[slideshow/pict]:
As an example, here is how to duplicate the @racket[record-icon] using @racketmodname[pict]:
@interaction[#:eval icons-eval
(define outline-color (icon-color->outline-color "forestgreen"))
(define brush-pict (colorize (filled-ellipse 62 62) "forestgreen"))

3
collects/meta/dist-specs.rkt
View File

@ -570,7 +570,8 @@ mr-extras :+= (+ (- (package: "mrlib/")
(tests: "aligned-pasteboard/"))
;; -------------------- pict library
mr-extras :+= (- (+ (collects: "texpict/")
mr-extras :+= (- (+ (package: "pict/")
(collects: "texpict/")
(srcfile: "slideshow/pict.rkt")
(srcfile: "slideshow/pict-convert.rkt"))
(srcfile: "texpict/slideshow-run.rkt")

4
collects/mrlib/image-core.rkt
View File

@ -32,8 +32,8 @@ has been moved out).
make-pen make-color)
(for-syntax racket/base)
file/convertible
slideshow/pict-convert
(prefix-in pict: (only-in slideshow/pict dc))
pict/convert
(prefix-in pict: (only-in pict dc))
racket/math
racket/contract
"private/image-core-bitmap.rkt"

5
collects/pict/balloon.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang racket/base
(require texpict/balloon)
(provide (except-out (all-from-out texpict/balloon)
place-balloon))

126
collects/pict/code.rkt Normal file
View File

@ -0,0 +1,126 @@
#lang racket/base
(require pict
texpict/code
mzlib/unit
(for-syntax racket/base
syntax/to-string
mzlib/list))
(define get-current-code-font-size (make-parameter (lambda () 12)))
(define current-code-line-sep (make-parameter 2))
(define (current-font-size) ((get-current-code-font-size)))
(define-values/invoke-unit/infer code@)
(define-code code typeset-code)
(provide code
current-code-line-sep
get-current-code-font-size
define-code
(for-syntax prop:code-transformer
code-transformer?
make-code-transformer))
(provide-signature-elements code^)
(provide define-exec-code/scale
define-exec-code)
(define-syntax (define-exec-code/scale stx)
(define (drop-to-run l)
(map (lambda (x)
(cond
[(and (pair? (syntax-e x))
(eq? 'local (syntax-e (car (syntax-e x)))))
(let ([l (syntax->list x)])
(list* 'local
(drop-to-run (syntax->list (cadr l)))
(cddr l)))]
[(and (pair? (syntax-e x))
(eq? 'define (syntax-e (car (syntax-e x)))))
(let ([l (syntax->list x)])
(list* 'define
(cadr l)
(drop-to-run (cddr l))))]
[else x]))
(filter (lambda (x)
(cond
[(eq? '_ (syntax-e x))
#f]
[(eq? '... (syntax-e x))
#f]
[(eq? 'code:blank (syntax-e x))
#f]
[(and (pair? (syntax-e x))
(eq? 'code:comment (syntax-e (car (syntax-e x)))))
#f]
[(and (pair? (syntax-e x))
(eq? 'code:contract (syntax-e (car (syntax-e x)))))
#f]
[(and (pair? (syntax-e x))
(eq? 'unsyntax (syntax-e (car (syntax-e x)))))
#f]
[else #t]))
l)))
(define (drop-to-show l)
(foldr (lambda (x r)
(cond
[(and (identifier? x) (eq? '_ (syntax-e x)))
(cdr r)]
[(and (pair? (syntax-e x))
(eq? 'local (syntax-e (car (syntax-e x)))))
(cons
(let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(datum->syntax
(cadr l)
(drop-to-show (syntax->list (cadr l)))
(cadr l))
(cddr l))
x))
r)]
[(and (pair? (syntax-e x))
(eq? 'cond (syntax-e (car (syntax-e x)))))
(cons
(let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(drop-to-show (cdr l)))
x))
r)]
[(and (pair? (syntax-e x))
(eq? 'define (syntax-e (car (syntax-e x)))))
(cons (let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(cadr l)
(drop-to-show (cddr l)))
x))
r)]
[else (cons x r)]))
empty
l))
(syntax-case stx ()
[(_ s (showable-name runnable-name string-name) . c)
#`(begin
(define runnable-name
(quote-syntax
(begin
#,@(drop-to-run (syntax->list #'c)))))
(define showable-name
(scale/improve-new-text
(code
#,@(drop-to-show (syntax->list #'c)))
s))
(define string-name
#,(syntax->string #'c)))]))
(define-syntax define-exec-code
(syntax-rules ()
[(_ (a b c) . r)
(define-exec-code/scale 1 (a b c) . r)]))

9
collects/pict/convert.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang racket/base
(require "main.rkt"
racket/contract
texpict/private/convertible)
(provide pict-convert pict-convertible?)
(provide/contract
[prop:pict-convertible (struct-type-property/c (-> pict-convertible? pict?))]
[prop:pict-convertible? (struct-type-property/c predicate/c)])

3
collects/pict/face.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang racket/base
(require texpict/face)
(provide (all-from-out texpict/face))

4
collects/pict/flash.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang racket/base
(require texpict/flash)
(provide (all-from-out texpict/flash))

4
collects/pict/info.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang setup/infotab
(define scribblings
'(("scribblings/pict.scrbl" () (gui-library))))

288
collects/pict/main.rkt Normal file
View File

@ -0,0 +1,288 @@
(module pict scheme/base
(require (rename-in texpict/mrpict
[hline t:hline]
[vline t:vline]
[frame t:frame])
(rename-in texpict/utils
[pin-line t:pin-line]
[pin-arrow-line t:pin-arrow-line]
[pin-arrows-line t:pin-arrows-line])
(only-in racket/draw dc-path% make-bitmap bitmap% bitmap-dc%)
(only-in racket/class new send make-object is-a?/c)
racket/contract)
(define (hline w h #:segment [seg #f])
(if seg
(dash-hline w h seg)
(t:hline w h)))
(define (vline w h #:segment [seg #f])
(if seg
(dash-vline w h seg)
(t:vline w h)))
(define (frame p
#:color [col #f]
#:line-width [lw #f]
#:segment [seg #f])
(let* ([f (if seg
(dash-frame (launder (ghost p)) seg)
(t:frame (launder (ghost p))))]
[f (if col
(colorize f col)
f)]
[f (if lw
(linewidth lw f)
f)])
(refocus (cc-superimpose p f)
p)))
(define (pict-path? p)
(or (pict? p)
(and (pair? p)
(list? p)
(andmap pict? p))))
(define (pin-line 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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f])
(if (not (or sa ea))
(finish-pin (launder (t:pin-line (ghost p)
src src-find
dest dest-find
#:style style))
p lw col alpha under?)
(pin-curve* #f #f p src src-find dest dest-find
sa ea sp ep 0 col lw under? #t
style alpha)))
(define (pin-arrow-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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f]
#:hide-arrowhead? [hide-arrowhead? #f])
(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?
#:hide-arrowhead? hide-arrowhead?
#:style style))
p lw col alpha under?)
(pin-curve* #f (not hide-arrowhead?) p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?
style alpha)))
(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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f]
#:hide-arrowhead? [hide-arrowhead? #f])
(if (not (or sa ea))
(finish-pin (launder (t:pin-arrows-line sz (ghost p)
src src-find
dest dest-find
#f #f #f solid?
#:hide-arrowhead? hide-arrowhead?
#:style style))
p lw col alpha under?)
(pin-curve* (not hide-arrowhead?) (not hide-arrowhead?)
p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?
style alpha)))
(define (pin-curve* start-arrow? end-arrow? p
src src-find
dest dest-find
sa ea sp ep
sz col lw
under? solid?
style alpha)
(let-values ([(sx0 sy0) (src-find p src)]
[(dx0 dy0) (dest-find p dest)])
(let* ([sa (or sa
(atan (- sy0 dy0) (- dx0 sx0)))]
[ea (or ea
(atan (- sy0 dy0) (- dx0 sx0)))]
[d (sqrt (+ (* (- dy0 sy0) (- dy0 sy0)) (* (- dx0 sx0) (- dx0 sx0))))]
[sp (* (or sp 1/4) d)]
[ep (* (or ep 1/4) d)])
(let ([dx (if end-arrow? (- dx0 (* sz (cos ea))) dx0)]
[dy (if end-arrow? (+ dy0 (* sz (sin ea))) dy0)]
[sx (if start-arrow? (+ sx0 (* sz (cos sa))) sx0)]
[sy (if start-arrow? (- sy0 (* sz (sin sa))) sy0)]
[path (new dc-path%)]
[maybe-pin-line
(lambda (arrow? p sx sy dx dy)
(if arrow?
(pin-arrow-line
sz
p
p (lambda (a b) (values sx sy))
p (lambda (a b) (values dx dy))
#:line-width lw
#:color col
#:under? under?
#:solid? solid?
#:style style)
p))])
(send path move-to sx sy)
(send path curve-to
(+ sx (* sp (cos sa)))
(- sy (* sp (sin sa)))
(- dx (* ep (cos ea)))
(+ dy (* ep (sin ea)))
dx
dy)
(maybe-pin-line
start-arrow?
(maybe-pin-line
end-arrow?
((if under? pin-under pin-over)
p
0 0
(let* ([p (dc (lambda (dc x y)
(let ([b (send dc get-brush)])
(send dc set-brush "white" 'transparent)
(send dc draw-path path x y)
(send dc set-brush b)))
0 0)]
[p (if col
(colorize p col)
p)]
[p (if (= alpha 1.0)
p
(cellophane p alpha))]
[p (if lw
(linewidth lw p)
p)]
[p (if style
(linestyle style p)
p)])
p))
dx dy dx0 dy0)
sx sy sx0 sy0)))))
(define (finish-pin l p lw col alpha under?)
(let* ([l (if lw
(linewidth lw l)
l)]
[l (if col
(colorize l col)
l)]
[l (if (= alpha 1.0)
l
(cellophane l alpha))])
(if under?
(cc-superimpose l p)
(cc-superimpose p l))))
(define fish
(let ([standard-fish
(lambda (w h
#:direction [direction 'left]
#:color [color "blue"]
#:eye-color [eye-color "black"]
#:open-mouth [open-mouth #f])
(standard-fish w h direction color eye-color open-mouth))])
standard-fish))
(define (pict->bitmap p [smoothing 'aligned])
(define w (pict-width p))
(define h (pict-height p))
(define bm (make-bitmap (max 1 (inexact->exact (ceiling w)))
(max 1 (inexact->exact (ceiling h)))))
(define dc (make-object bitmap-dc% bm))
(send dc set-smoothing smoothing)
(draw-pict p dc 0 0)
bm)
(provide hline vline
frame
pict-path?
pin-line pin-arrow-line pin-arrows-line
(except-out (all-from-out texpict/mrpict)
dash-hline dash-vline
dash-frame oval oval/radius
caps-text
big-circle
picture
cons-picture
cons-picture*
place-over
place-under
record
thick
thin
find-lt
find-lc
find-lb
find-ltl
find-lbl
find-ct
find-cc
find-cb
find-ctl
find-cbl
find-rt
find-rc
find-rb
find-rtl
find-rbl
drop
lift)
(rename-out [drop drop-below-ascent]
[lift lift-above-baseline])
(except-out (all-from-out texpict/utils)
color-frame color-dash-frame
round-frame color-round-frame
cons-colorized-picture
arrow-line
arrows-line
add-line
add-arrow-line
add-arrows-line
explode-star
standard-fish
find-pen find-brush)
(rename-out [fish standard-fish])
(contract-out [pict->bitmap ((pict?) ((one-of/c 'unsmoothed 'smoothed 'aligned))
. ->* . (is-a?/c bitmap%))])
))

394
collects/pict/scribblings/code.scrbl Normal file
View File

@ -0,0 +1,394 @@
#lang scribble/doc
@(require scribble/manual
scribble/eval
(for-label (except-in racket only drop)
pict/code
pict
racket/gui/base))
@(define stx-obj
(tech #:doc '(lib "scribblings/reference/reference.scrbl") "syntax object"))
@(define ss-eval (make-base-eval))
@(interaction-eval #:eval ss-eval
(begin
(require pict/code
pict
(for-syntax racket/base))
(current-code-tt (lambda (s) (text s "monospace" 14)))
(define-code code typeset-code)))
@title{Typesetting Racket Code}
@defmodule[pict/code]{This library is re-provided by
@racketmodname[slideshow/code], but
initializes @racket[get-current-code-font-size].}
@defproc[(typeset-code [stx syntax?]) pict?]{
Produces a pict for code in the given @|stx-obj|. The
source-location information of the syntax object determines the line
breaks, line indenting, and space within a row. Empty rows are
ignored.
Beware that if you use @racket[read-syntax] on a file port, you may
have to turn on line counting via @racket[port-count-lines!] for the
code to typeset properly. Also beware that when a source file
containing a @racket[syntax] or @racket[quote-syntax] form is
compiled, source location information is omitted from the compiled
@|stx-obj|.
Normally, @racket[typeset-code] is used through the @racket[code]
syntactic form, which works properly with compilation, and that
escapes to pict-producing code via @racket[unsyntax]. See also
@racket[define-code].
Embedded picts within @racket[stx] are used directly. Row elements are
combined using and operator like @racket[htl-append], so use
@racket[code-align] (see below) as necessary to add an ascent to
ascentless picts. More precisely, creation of a line of code uses
@racket[pict-last] to determine the end point of the element most
recently added to a line; the main effect is that closing parentheses
are attached in the right place when a multi-line pict is embedded in
@racket[stx].
An identifier that starts with @litchar{_} is italicized in the pict,
and the @litchar{_} is dropped, unless the
@racket[code-italic-underscore-enabled] parameter is set to
@racket[#f]. Also, unless @racket[code-scripts-enabled] is set to
@racket[#f], @litchar{_} and @litchar{^} in the middle of a word
create superscripts and subscripts, respectively (like TeX); for
example @racketidfont{foo^4_ok} is displayed as the identifier
@racketidfont{foo} with a @racketidfont{4} superscript and an
@racketidfont{ok} subscript.
Further, uses of certain identifiers in @racket[stx] typeset
specially:
@itemize[
@item{@as-index{@racketidfont{code:blank}} --- produces a space.}
@item{@racket[(#,(as-index (racketidfont "code:comment")) _s ...)]
--- produces a comment block, with each @racket[_s] on its own line,
where each @racket[_s] must be a string or a pict.}
@item{@racket[(#,(as-index (racketidfont "code:line")) _datum ...)]
--- typesets the @racket[_datum] sequence, which is mostly useful for
the top-level sequence, since @racket[typeset-code] accepts only one
argument.}
@item{@racket[(#,(as-index (racketidfont "code:contract")) _datum
...)] --- like @racketidfont{code:line}, but every @racket[_datum]
is colored as a comment, and a @litchar{;} is prefixed to every line.}
@item{@racket[(#,(as-index (racketidfont "code:template")) _datum
...)] --- like @racketidfont{code:line}, but a @litchar{;} is
prefixed to every line.}
@item{@racketidfont{$} --- typesets as a vertical bar (for no
particularly good reason).}
]}
@defform[(code datum ...)]{
The macro form of @racket[typeset-code]. Within a @racket[datum],
@racket[unsyntax] can be used to escape to an expression, and
identifiers bound as syntax to @tech{code transformer}s trigger
transformations.
For more information, see @racket[typeset-code] and
@racket[define-code], since @racket[code] is defined as
@racketblock[
(define-code code typeset-code)
]
@defexamples[#:eval ss-eval #:escape potato
(code (+ 1 2))
(code (+ 1 #,(+ 1 1)))
(code (+ 1 #,(frame (code 2))))
(define-syntax two (make-code-transformer #'(code 2)))
(code (+ 1 two))
]}
@defparam[current-code-font style text-style/c]{
Parameter for a base font used to typeset text. The default is
@racket[`(bold . modern)]. For even more control, see
@racket[current-code-tt].}
@defparam[current-code-tt proc (string? . -> . pict?)]{
Parameter for a one-argument procedure to turn a
string into a pict, used to typeset text. The default is
@racketblock[
(lambda (s) (text s (current-code-font) ((get-current-code-font-size))))
]
This procedure is not used to typeset subscripts or other items that
require font changes, where @racket[current-code-font] is used
directly.}
@defparam[get-current-code-font-size proc (-> exact-nonnegative-integer?)]{
A parameter used to access the default font size. The
@racketmodname[slideshow/code] library initializes this parameter to
@racket[current-font-size].}
@defparam[current-code-line-sep amt real?]{
A parameter that determines the spacing between lines of typeset code.
The default is @racket[2].}
@defparam[current-comment-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of comments.}
@defparam[current-keyword-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of syntactic-form names. See
@racket[current-keyword-list].}
@defparam[current-id-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of identifiers that are not syntactic form
names or constants.}
@defparam[current-literal-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of literal values, such as strings and
numbers. See also @racket[current-literal-list]}
@defparam[current-const-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of constant names. See
@racket[current-const-list].}
@defparam[current-base-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of everything else.}
@defparam[current-reader-forms syms (listof symbol?)]{
Parameter for a list of symbols indicating which built-in reader forms
should be used. The default is @racket['(quote quasiquote unquote
unquote-splicing syntax quasisyntax unsyntax unsyntax-splicing)].
Remove a symbol to suppress the corresponding reader output.}
@defproc[(code-align [pict pict?]) pict?]{
Adjusts the ascent of @racket[pict] so that its bottom aligns with the
baseline for text; use this function when @racket[pict] has no
ascent.}
@defparam[current-keyword-list names (listof string?)]{
A list of strings to color as syntactic-form names. The default
includes all of the forms provided by @racketmodname[racket/base]
and all of the forms provided by @racketmodname[mzscheme].}
@defparam[current-const-list names (listof string?)]{
A list of strings to color as constant names. The default is
@racket[null].}
@defparam[current-literal-list names (listof string?)]{
A list of strings to color as literals, in addition to literals such
as strings. The default is @racket[null].}
@defthing[racket/base-const-list (listof string?)]{
A list of strings that could be used to initialize the
@racket[current-const-list] parameter.}
@defthing[mzscheme-const-list (listof string?)]{
A list of strings that could be used to initialize the
@racket[current-const-list] parameter.}
@defboolparam[code-colorize-enabled on?]{
A parameter to enable or disable all code coloring. The default is
@racket[#t].}
@defboolparam[code-colorize-quote-enabled on?]{
A parameter to control whether under a @racket[quote] is colorized as
a literal (as in this documentation). The default is @racket[#t].}
@defboolparam[code-italic-underscore-enabled on?]{
A parameter to control whether @litchar{_}-prefixed identifiers are
italicized (dropping the @litchar{_}). The default is @racket[#t].}
@defboolparam[code-scripts-enabled on?]{
A parameter to control whether TeX-style subscripts and subscripts are
recognized in an identifier.}
@defform*[[(define-code code-id typeset-code-id)
(define-code code-id typeset-code-id escape-id)]]{
Defines @racket[code-id] as a macro that uses
@racket[typeset-code-id], which is a function with the same input as
@racket[typeset-code]. The @racket[escape-id] form defaults to
@racket[unsyntax].
The resulting @racket[code-id] syntactic form takes a sequence of
@racket[_datum]s:
@racketblock[
(code-id _datum ...)
]
It produces a pict that typesets the sequence. Source-location
information for the @racket[_datum] determines the layout of code in
the resulting pict. The @racket[code-id] is expanded in such a way
that source location is preserved during compilation (so
@racket[typeset-code-id] receives a syntax object with source
locations intact).
If a @racket[_datum] contains @racket[(escape-id _expr)]---perhaps as
@RACKET[#,_expr] when @racket[escape-id] is @racket[unsyntax]---then
the @racket[_expr] is evaluated and the result datum is spliced in
place of the @racket[escape-id] form in @racket[_datum]. If the result
is not a syntax object, it is given the source location of the
@racket[escape-id] form. A pict value intected this way as a
@racket[_datum] is rendered as itself.
If a @racket[_datum] contains @racket[(transform-id _datum ...)] or
@racket[transform-id] for a @racket[transform-id] that is bound as syntax to a
@tech{code transformer}, then the @racket[(transform-id _datum ...)]
or @racket[transform-id] may be replaced with an escaped expression,
depending on the @tech{code transformer}'s result.}
@deftogether[(
@defproc[(make-code-transformer [proc-or-stx (or/c (syntax? . -> . (or/c syntax? #f))
syntax?)])
code-transformer?]
@defthing[prop:code-transformer struct-type-property?]
@defproc[(code-transformer? [v any/c]) boolean?]
)]{
Exported @racket[for-syntax] for creating @deftech{code transformers}.
For @tech{code transformer} created with
@racket[(make-code-transformer _proc)], @racket[proc] takes a syntax
object representing the use of an identifier bound to the transformer,
and it produces an expression whose value replaces the identifier use
within a @racket[code] form or a form defined via
@racket[define-code]. Like a macro transformer, a code transformer is
triggered either by a use of the bound identifier in an
``application'' position, in which case the transformer receives the
entire ``application'' form, or the identifier by itself can also
trigger the transformer. The @tech{code transformer}'s @racket[_proc]
can return @racket[#f], in which case the use of the identifier is
left untransformed; if the identifier was used in an ``application''
position, the transformer @racket[_proc] will be called again for the
identifier use by itself.
A @tech{code transformer} produced by @racket[(make-code-transformer _stx)]
is equivalent to
@racketblock[
(make-code-transformer (lambda (use-stx)
(if (identifier? use-stx)
_stx
#f)))
]
A structure type with the @racket[prop:code-transformer] property
implements a @tech{code transformer}. The property value must be a
procedure of one argument, which receives the structure and returns a
procedure that is like a @racket[_proc] passed to
@racket[make-code-transformer], except that the property value takes
the structure instance as an argument before the syntax object to
transform.
The @racket[code-transformer?] predicate returns @racket[#t] for a
value produced by @racket[make-code-transformer] or for an instance of
a structure type with the @racket[prop:code-transformer] property,
@racket[#f] otherwise.
@examples[
#:eval ss-eval
(let-syntax ([bag (make-code-transformer #'(code hat))]
[copy (make-code-transformer (syntax-rules ()
[(_ c) (code (* 2 c))]))])
(inset (frame (code ((copy cat) in the bag))) 2))
]}
@defform[(define-exec-code (pict-id runnable-id string-id)
datum ...)]{
Binds @racket[pict-id] to the result of @racket[(code datum ...)],
except that if an identifier @racketidfont{_} appears anywhere in a
@racket[datum], then the identifier and the following expression are
not included for @racket[code].
Meanwhile, @racket[runnable-id] is bound to a @|stx-obj| that wraps
the @racket[datum]s in a @racket[begin]. In this case,
@racketidfont{_}s are removed from the @racket[datum]s, but not the
following expression. Thus, an @racketidfont{_} identifier is used to
comment out an expression from the pict, but have it present in the
@|stx-obj| for evaluation.
The @racket[string-id] is bound to a string representation of the code
that is in the pict. This string is useful for copying to the
clipboard with @racket[(send the-clipboard set-clipboard-string
string-id 0)].}
@defform[(define-exec-code/scale scale-expr (pict-id runnable-id string-id)
datum ...)]{
Like @racket[define-exec-code], but with a scale to use via
@racket[scale/improve-new-text] when generating the pict.}
@deftogether[(
@defthing[comment-color (or/c string? (is-a?/c color%))]
@defthing[keyword-color (or/c string? (is-a?/c color%))]
@defthing[id-color (or/c string? (is-a?/c color%))]
@defthing[literal-color (or/c string? (is-a?/c color%))]
)]{
For backward compatibility, the default values for
@racket[current-comment-color], etc.}
@defproc[(code-pict-bottom-line-pict [pict pict?])
(or/c pict? #f)]{
The same as @racket[pict-last], provided for backward compatibility.}
@defproc[(pict->code-pict [pict pict?] [bl-pict (or/c pict? #f)]) pict?]{
Mainly for backward compatibility: returns @racket[(if bl-pict
(use-last pict (or (pict-last bl-pict) bl-pict)))].}
@; ----------------------------------------
@(close-eval ss-eval)

431
collects/pict/scribblings/more.scrbl Normal file
View File

@ -0,0 +1,431 @@
#lang scribble/doc
@(require "pict-diagram.rkt"
scribble/eval scribble/manual
pict/face pict
(for-label racket/gui
slideshow/base slideshow/code
pict/flash pict/face pict/balloon
(except-in racket only drop)
pict
pict/convert))
@(define ss-eval (make-base-eval))
@(ss-eval '(require pict racket/math racket/class racket/draw
racket/list pict/balloon pict/flash))
@title{More Pict Constructors}
@section{Dingbats}
@defproc[(cloud [w real?]
[h real?]
[color (or/c string? (is-a?/c color%)) "gray"])
pict?]{
Creates a fluffy cloud.
@examples[#:eval ss-eval
(cloud 100 75)
(cloud 100 75 "lavenderblush")
]}
@defproc[(file-icon [w real?]
[h real?]
[color (or/c string? (is-a?/c color%) any/c)]
[shaded? any/c #f])
pict?]{
Creates a Mac-like file icon, optionally shaded. If @racket[color] is
not a string or @racket[color%] object, it is treated as a boolean, in
which case true means @racket["gray"] and false means
@racket["white"].
@examples[#:eval ss-eval
(file-icon 50 60 "bisque")
(file-icon 50 60 "honeydew" #t)
]}
@defproc[(standard-fish [w real?]
[h real?]
[#:direction direction (or/c 'left 'right) 'left]
[#:color color (or/c string? (is-a?/c color%)) "blue"]
[#:eye-color eye-color (or/c string? (is-a?/c color%) #f) "black"]
[#:open-mouth open-mouth (or/c boolean? real?) #f])
pict?]{
Creates a fish swimming either @racket['left] or @racket['right].
If @racket[eye-color] is @racket[#f], no eye is drawn.
The @racket[open-mouth] argument can be either @racket[#f] (mouth
closed), @racket[#t] (mouth fully open), or a number: @racket[0.0] is
closed, @racket[1.0] is fully open, and numbers in between are
partially open.
@examples[#:eval ss-eval
(standard-fish 100 50)
(standard-fish 100 50 #:direction 'right #:color "chocolate")
(standard-fish 100 50 #:eye-color "saddlebrown" #:color "salmon")
(standard-fish 100 50 #:open-mouth #t #:color "olive")
]}
@defproc[(jack-o-lantern [size real?]
[pumpkin-color (or/c string? (is-a?/c color%)) "orange"]
[face-color (or/c string? (is-a?/c color%)) "black"])
pict?]{
Creates a jack-o-lantern; use the same pumpkin and face color to get a
plain pumpkin. The @racket[size] determines the width.
@examples[#:eval ss-eval
(jack-o-lantern 100)
(jack-o-lantern 100 "cadet blue" "khaki")
]}
@defproc[(angel-wing [w real?]
[h real?]
[left? any/c])
pict?]{
Creates an angel wing, left or right, or any size. The color and pen
width for drawing the wing outline is the current one.
@examples[#:eval ss-eval
(angel-wing 100 40 #f)
(angel-wing 100 40 #t)
]}
@defproc[(desktop-machine [scale real?]
[style (listof symbol?) null])
pict?]{
Produces a picture of ancient desktop computer. The @racket[scale]
argument scales the size relative to the base size of 120 by 115.
The @racket[style] can include any of the following:
@itemlist[
@item{@racket['plt] --- include a Racket logo on the machine's screen}
@item{@racket['binary] --- put 1s and 0s on the machine's screen}
@item{@racket['devil] --- like @racket['binary], and also give the machine
horns and a tail}
]
@examples[#:eval ss-eval
(desktop-machine 1)
(desktop-machine 1 '(devil plt))
(desktop-machine 1 '(plt binary))
]}
@defproc[(thermometer [#:height-% height-% (between/c 0 1) 1]
[#:color-% color-% (between/c 0 1) height-%]
[#:ticks ticks non-exact-negative-integer? 4]
[#:start-color start-color (or/c string? (is-a?/c color%)) "lightblue"]
[#:end-color end-color (or/c string? (is-a?/c color%)) "lightcoral"]
[#:top-circle-diameter top-circle-diameter positive-real? 40]
[#:bottom-circle-diameter bottom-circle-diameter positive-real? 80]
[#:stem-height stem-height positive-real? 180]
[#:mercury-inset mercury-inset positive-real? 8])
pict?]{
Produces a thermometer that consists of a semi-circle on top of a rectangle on
top of a circle. The sizes of the three components are controlled via the
@racket[top-circle-diameter], @racket[stem-height], and @racket[bottom-circle-diameter]
arguments.
The mercury is drawn the same way, but by creating the three components inset from the
versions that draw the boundary of the thermometer. This inset is conrolled by the
@racket[mercury-inset] argument.
The height of the mercury in the thermometer is controlled by the @racket[height-%] argument.
Its color is interpolated between the @racket[start-color] and @racket[end-color], as
determined by the @racket[color-%] argument.
Finally, some number of ticks are drawn, basd on the @racket[ticks] argument.
@examples[#:eval ss-eval
(thermometer #:stem-height 90
#:bottom-circle-diameter 40
#:top-circle-diameter 20
#:mercury-inset 4)
]}
@; ----------------------------------------
@section{Balloon Annotations}
@defmodule[pict/balloon]{The @racketmodname[pict/balloon]
library provides functions for creating and placing cartoon-speech
balloons.}
@defproc[(wrap-balloon [pict pict?]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color]
[corner-radius (and/c real? (not/c negative?)) 32])
balloon?]{
Superimposes @racket[pict] on top of a balloon that wraps it.
The @racket[spike] argument indicates the corner from which a spike
protrudes from the balloon (i.e., the spike that points to whatever
the balloon is about). For example, @racket['n] means ``north,'',
which is a spike in the top middle of the balloon.
The @racket[dx] and @racket[dy] arguments specify how far the spike
should protrude. For a @racket['w] spike, @racket[dx] should be
negative, etc.
The @racket[color] argument is the background color for the balloon.
The @racket[corner-radius] argument determines the radius of the cicle
used to roun the balloon's corners. As usual, if it is less than
@racket[1], then it acts as a ratio of the balloon's width or height.
The result is a balloon, not a pict. The @racket[balloon-pict]
function extracts a pict whose @tech{bounding box} does not include the
spike, but includes the rest of the image, and the
@racket[balloon-point-x] and @racket[balloon-point-y] functions
extract the location of the spike point. More typically, the
@racket[pin-balloon] function is used to add a balloon to a pict.}
@defproc[(pip-wrap-balloon [pict pict?]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color]
[corner-radius (and/c real? (not/c negative?)) 32])
pict?]{
Like @racket[wrap-balloon], but produces a zero-sized pict suitable
for use with @racket[pin-over].}
@defproc*[([(pin-balloon [balloon balloon?]
[base pict?]
[x real?]
[y real?])
pict?]
[(pin-balloon [balloon balloon?]
[base pict?]
[at-pict pict-path?]
[find (pict? pict-path? . -> . (values real? real?))])
pict?])]{
Superimposes the pict in @racket[balloon] onto @racket[base] to
produce a new pict. The balloon is positioned so that its spike points
to the location specified by either @racket[x] and @racket[y]
(numbers) or at the position determined by combining @racket[base] and
@racket[at-pict] with @racket[find]. The @racket[find] function uses
its arguments like @racket[lt-find].
The resulting pict has the same @tech{bounding box}, descent, and ascent as
@racket[base], even if the balloon extends beyond the bounding box.
@examples[#:eval ss-eval
(define a-pict (standard-fish 70 40))
(pin-balloon (balloon 40 30 5 'se 5 5)
(cc-superimpose (blank 300 150) a-pict)
a-pict
lc-find)
(pin-balloon (wrap-balloon (text "Hello!") 'sw -5 3)
(cc-superimpose (blank 300 150) a-pict)
a-pict
rt-find)
]}
@defproc[(balloon [w real?]
[h real?]
[corner-radius (and/c real? (not/c negative?))]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color])
balloon?]{
Creates a balloon, much like @racket[wrap-balloon] except that the balloon's
width is @racket[w] and its height is @racket[h].}
@defproc*[([(balloon? [v any/c]) boolean?]
[(make-balloon [pict pict?] [x real?] [y real?]) balloon?]
[(balloon-pict [balloon balloon?]) pict?]
[(balloon-point-x [balloon balloon?]) real?]
[(balloon-point-y [balloon balloon?]) real?])]{
A balloon encapsulates a pict and the position of the balloon's spike
relative to the balloon's top-left corner.}
@defthing[balloon-color (or/c string? (is-a?/c color%))]
The default background color for a balloon.
@defboolparam[balloon-enable-3d on?]{
A parameter that determines whether balloons are drawn with 3-D shading.}
@; ----------------------------------------
@section{Face}
@defmodule[pict/face]{The @racketmodname[pict/face] library
provides functions for a kind of @as-index{Mr. Potatohead}-style face
library.}
@defthing[default-face-color (or/c string (is-a?/c color%))]{
Orange.}
@; helper for the next defproc
@(define (small-face mood) (scale (face mood) 0.25))
@defproc[(face [mood symbol?]
[color (or/c string (is-a?/c color%)) default-face-color])
pict?]{
Returns a pict for a pre-configured face with the given base
color. The built-in configurations, selected by mood-symbol, are as
follows:
@tabular[#:sep @hspace[2]
(list (list @para{@racket['unhappy] --- @racket[(face* 'none 'plain #t default-face-color 6)]}
@(small-face 'unhappy))
(list @para{@racket['sortof-unhappy] --- @racket[(face* 'worried 'grimace #t default-face-color 6)]}
@(small-face 'sortof-unhappy))
(list @para{@racket['sortof-happy] --- @racket[(face* 'worried 'medium #f default-face-color 6)]}
@(small-face 'sortof-happy))
(list @para{@racket['happy] --- @racket[(face* 'none 'plain #f default-face-color 6)]}
@(small-face 'happy))
(list @para{@racket['happier] --- @racket[(face* 'none 'large #f default-face-color 3)]}
@(small-face 'happier))
(list @para{@racket['embarrassed] --- @racket[(face* 'worried 'medium #f default-face-color 3)]}
@(small-face 'embarrassed))
(list @para{@racket['badly-embarrassed] --- @racket[(face* 'worried 'medium #t default-face-color 3)]}
@(small-face 'badly-embarrassed))
(list @para{@racket['unhappier] --- @racket[(face* 'normal 'large #t default-face-color 3)]}
@(small-face 'unhappier))
(list @para{@racket['happiest] --- @racket[(face* 'normal 'huge #f default-face-color 0 -3)]}
@(small-face 'happiest))
(list @para{@racket['unhappiest] --- @racket[(face* 'normal 'huge #t default-face-color 0 -3)]}
@(small-face 'unhappiest))
(list @para{@racket['mad] --- @racket[(face* 'angry 'grimace #t default-face-color 0)]}
@(small-face 'mad))
(list @para{@racket['mean] --- @racket[(face* 'angry 'narrow #f default-face-color 0)]}
@(small-face 'mean))
(list @para{@racket['surprised] --- @racket[(face* 'worried 'oh #t default-face-color -4 -3 2)]}
@(small-face 'surprised)))
]}
@defproc[(face* [eyebrow-kind (or/c 'none 'normal 'worried 'angry)]
[mouth-kind (or/c 'plain 'smaller 'narrow 'medium 'large
'huge 'grimace 'oh 'tongue)]
[frown? any/c]
[color (or/c string (is-a?/c color%))]
[eye-inset real?]
[eyebrow-dy real?]
[pupil-dx real?]
[pupil-dy real?]
[#:eyebrow-shading? eyebrow-on? any/c #t]
[#:mouth-shading? mouth-on? any/c #t]
[#:eye-shading? eye-on? any/c #t]
[#:tongue-shading? tongue-on? any/c #t]
[#:face-background-shading? face-bg-on? any/c #t]
[#:teeth? teeth-on? any/c #t])
pict?]{
Returns a pict for a face:
@itemize[
@item{@racket[eyebrow-kind] determines the eyebrow shape.}
@item{@racket[mouth-kind] determines the mouth shape, combined with
@racket[frown?].}
@item{@racket[frown?] determines whether the mouth is up or down.}
@item{@racket[color] determines the face color.}
@item{@racket[eye-inset] adjusts the eye size; recommend values are
between 0 and 10.}
@item{@racket[eyebrow-dy] adjusts the eyebrows; recommend values:
between -5 and 5.}
@item{@racket[pupil-dx] adjusts the pupil; recommend values are
between -10 and 10.}
@item{@racket[pupil-dy] adjusts the pupil; recommend values are
between -15 and 15.}
]
The @racket[#:eyebrow-shading?] through
@racket[#:face-background-shading?] arguments control whether a
shading is used for on a particular feature in the face (shading tends
to look worse than just anti-aliasing when the face is small). The
@racket[#:teeth?] argument controls the visibility of the teeth for
some mouth shapes.}
@; ----------------------------------------
@section{Flash}
@defmodule[pict/flash]
@defproc[(filled-flash [width real?]
[height real?]
[n-points exact-positive-integer? 10]
[spike-fraction (real-in 0 1) 0.25]
[rotation real? 0])
pict?]{
Returns a pict for a ``flash'': a spiky oval, like the yellow
background that goes behind a ``new!'' logo on web pages or a box of
cereal.
The @racket[height] and @racket[width] arguments determine the size of
the oval in which the flash is drawn, prior to rotation. The actual
height and width may be smaller if @racket[points] is not a multiple
of 4, and the actual height and width will be different if the flash
is rotated.
The @racket[n-points] argument determines the number of points on the
flash.
The @racket[spike-fraction] argument determines how big the flash
spikes are compared to the bounding oval.
The @racket[rotation] argument specifies an angle in radians for
counter-clockwise rotation.
The flash is drawn in the default color.
@examples[#:eval ss-eval
(filled-flash 100 50)
(filled-flash 100 50 8 0.25 (/ pi 2))
]}
@defproc[(outline-flash [width real?]
[height real?]
[n-points exact-positive-integer? 10]
[spike-fraction (real-in 0 1) 0.25]
[rotation real? 0])
pict?]{
Like @racket[filled-flash], but drawing only the outline.
@examples[#:eval ss-eval
(outline-flash 100 50)
(outline-flash 100 50 8 0.25 (/ pi 2))
]}
@include-section["code.scrbl"]
@(close-eval ss-eval)

2
collects/scribblings/slideshow/pict-diagram.rkt → collects/pict/scribblings/pict-diagram.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/pict
(require pict
racket/class
racket/draw)

457
collects/scribblings/slideshow/picts.scrbl → collects/pict/scribblings/pict.scrbl
View File

@ -1,24 +1,28 @@
#lang scribble/doc
@(require "ss.rkt" "pict-diagram.rkt"
scribble/eval
slideshow/face slideshow/pict
(for-label racket/gui slideshow/code slideshow/flash slideshow/face
slideshow/balloon slideshow/pict-convert))
@(require "pict-diagram.rkt"
scribble/eval scribble/manual
pict/face pict
(for-label racket/gui
slideshow/base slideshow/code
pict/flash pict/face pict/balloon
(except-in racket only drop)
pict
pict/convert))
@(define ss-eval (make-base-eval))
@(ss-eval '(require slideshow/pict racket/math racket/class racket/draw
racket/list slideshow/balloon slideshow/flash))
@(ss-eval '(require pict racket/math racket/class racket/draw
racket/list pict/balloon pict/flash))
@title[#:style 'toc]{Making Pictures}
@title[#:style 'toc]{Functional Pictures}
@declare-exporting[slideshow/pict slideshow]
@declare-exporting[pict]
@defmodule*/no-declare[(slideshow/pict)]{ The
@racketmodname[slideshow/pict] layer provides core functions for
constructing pictures, and it is independent of the slide viewer. This
layer can be used, for example, to generate a picture as encapsulated
PostScript for inclusion into a larger document. The
@racketmodname[slideshow/pict] layer is re-provided by the
@defmodule*/no-declare[(pict)]{ The
@racketmodname[pict] library is one of the standard Racket
functional picture libraries (the other being @racketmodname[2htdp/image]).
This library was original designed for use with Slideshow,
and is re-provided by the
@racketmodname[slideshow] language.}
@local-table-of-contents[]
@ -216,11 +220,6 @@ The @racket[style] argument must be one of the following:
@item{@racket[(cons 'superscript style)]}
@item{@racket[(cons 'caps style)]}
@item{@racket[(cons 'outline style)] --- draws an outline of the text
instead of solid glyphs; if a @racket[color%] object is
provided, it determines the outline color, while the current
color (or white if there is none) is used to fill the glyphs}
@item{@racket[(cons 'combine style)] --- allows kerning and ligatures
(the default, unless the @racket['modern] family is specified)}
@ -884,420 +883,10 @@ pict with the same shape and location.}
@; ------------------------------------------------------------------------
@section{More Pict Constructors}
@include-section["more.scrbl"]
@; ----------------------------------------
@subsection{Dingbats}
@defproc[(cloud [w real?]
[h real?]
[color (or/c string? (is-a?/c color%)) "gray"])
pict?]{
Creates a fluffy cloud.
@examples[#:eval ss-eval
(cloud 100 75)
(cloud 100 75 "lavenderblush")
]}
@defproc[(file-icon [w real?]
[h real?]
[color (or/c string? (is-a?/c color%) any/c)]
[shaded? any/c #f])
pict?]{
Creates a Mac-like file icon, optionally shaded. If @racket[color] is
not a string or @racket[color%] object, it is treated as a boolean, in
which case true means @racket["gray"] and false means
@racket["white"].
@examples[#:eval ss-eval
(file-icon 50 60 "bisque")
(file-icon 50 60 "honeydew" #t)
]}
@defproc[(standard-fish [w real?]
[h real?]
[#:direction direction (or/c 'left 'right) 'left]
[#:color color (or/c string? (is-a?/c color%)) "blue"]
[#:eye-color eye-color (or/c string? (is-a?/c color%) #f) "black"]
[#:open-mouth open-mouth (or/c boolean? real?) #f])
pict?]{
Creates a fish swimming either @racket['left] or @racket['right].
If @racket[eye-color] is @racket[#f], no eye is drawn.
The @racket[open-mouth] argument can be either @racket[#f] (mouth
closed), @racket[#t] (mouth fully open), or a number: @racket[0.0] is
closed, @racket[1.0] is fully open, and numbers in between are
partially open.
@examples[#:eval ss-eval
(standard-fish 100 50)
(standard-fish 100 50 #:direction 'right #:color "chocolate")
(standard-fish 100 50 #:eye-color "saddlebrown" #:color "salmon")
(standard-fish 100 50 #:open-mouth #t #:color "olive")
]}
@defproc[(jack-o-lantern [size real?]
[pumpkin-color (or/c string? (is-a?/c color%)) "orange"]
[face-color (or/c string? (is-a?/c color%)) "black"])
pict?]{
Creates a jack-o-lantern; use the same pumpkin and face color to get a
plain pumpkin. The @racket[size] determines the width.
@examples[#:eval ss-eval
(jack-o-lantern 100)
(jack-o-lantern 100 "cadet blue" "khaki")
]}
@defproc[(angel-wing [w real?]
[h real?]
[left? any/c])
pict?]{
Creates an angel wing, left or right, or any size. The color and pen
width for drawing the wing outline is the current one.
@examples[#:eval ss-eval
(angel-wing 100 40 #f)
(angel-wing 100 40 #t)
]}
@defproc[(desktop-machine [scale real?]
[style (listof symbol?) null])
pict?]{
Produces a picture of ancient desktop computer. The @racket[scale]
argument scales the size relative to the base size of 120 by 115.
The @racket[style] can include any of the following:
@itemlist[
@item{@racket['plt] --- include a Racket logo on the machine's screen}
@item{@racket['binary] --- put 1s and 0s on the machine's screen}
@item{@racket['devil] --- like @racket['binary], and also give the machine
horns and a tail}
]
@examples[#:eval ss-eval
(desktop-machine 1)
(desktop-machine 1 '(devil plt))
(desktop-machine 1 '(plt binary))
]}
@defproc[(thermometer [#:height-% height-% (between/c 0 1) 1]
[#:color-% color-% (between/c 0 1) height-%]
[#:ticks ticks non-exact-negative-integer? 4]
[#:start-color start-color (or/c string? (is-a?/c color%)) "lightblue"]
[#:end-color end-color (or/c string? (is-a?/c color%)) "lightcoral"]
[#:top-circle-diameter top-circle-diameter positive-real? 40]
[#:bottom-circle-diameter bottom-circle-diameter positive-real? 80]
[#:stem-height stem-height positive-real? 180]
[#:mercury-inset mercury-inset positive-real? 8])
pict?]{
Produces a thermometer that consists of a semi-circle on top of a rectangle on
top of a circle. The sizes of the three components are controlled via the
@racket[top-circle-diameter], @racket[stem-height], and @racket[bottom-circle-diameter]
arguments.
The mercury is drawn the same way, but by creating the three components inset from the
versions that draw the boundary of the thermometer. This inset is conrolled by the
@racket[mercury-inset] argument.
The height of the mercury in the thermometer is controlled by the @racket[height-%] argument.
Its color is interpolated between the @racket[start-color] and @racket[end-color], as
determined by the @racket[color-%] argument.
Finally, some number of ticks are drawn, basd on the @racket[ticks] argument.
@examples[#:eval ss-eval
(thermometer #:stem-height 90
#:bottom-circle-diameter 40
#:top-circle-diameter 20
#:mercury-inset 4)
]}
@; ----------------------------------------
@subsection{Balloon Annotations}
@defmodule[slideshow/balloon]{The @racketmodname[slideshow/balloon]
library provides functions for creating and placing cartoon-speech
balloons.}
@defproc[(wrap-balloon [pict pict?]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color]
[corner-radius (and/c real? (not/c negative?)) 32])
balloon?]{
Superimposes @racket[pict] on top of a balloon that wraps it.
The @racket[spike] argument indicates the corner from which a spike
protrudes from the balloon (i.e., the spike that points to whatever
the balloon is about). For example, @racket['n] means ``north,'',
which is a spike in the top middle of the balloon.
The @racket[dx] and @racket[dy] arguments specify how far the spike
should protrude. For a @racket['w] spike, @racket[dx] should be
negative, etc.
The @racket[color] argument is the background color for the balloon.
The @racket[corner-radius] argument determines the radius of the cicle
used to roun the balloon's corners. As usual, if it is less than
@racket[1], then it acts as a ratio of the balloon's width or height.
The result is a balloon, not a pict. The @racket[balloon-pict]
function extracts a pict whose @tech{bounding box} does not include the
spike, but includes the rest of the image, and the
@racket[balloon-point-x] and @racket[balloon-point-y] functions
extract the location of the spike point. More typically, the
@racket[pin-balloon] function is used to add a balloon to a pict.}
@defproc[(pip-wrap-balloon [pict pict?]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color]
[corner-radius (and/c real? (not/c negative?)) 32])
pict?]{
Like @racket[wrap-balloon], but produces a zero-sized pict suitable
for use with @racket[pin-over].}
@defproc*[([(pin-balloon [balloon balloon?]
[base pict?]
[x real?]
[y real?])
pict?]
[(pin-balloon [balloon balloon?]
[base pict?]
[at-pict pict-path?]
[find (pict? pict-path? . -> . (values real? real?))])
pict?])]{
Superimposes the pict in @racket[balloon] onto @racket[base] to
produce a new pict. The balloon is positioned so that its spike points
to the location specified by either @racket[x] and @racket[y]
(numbers) or at the position determined by combining @racket[base] and
@racket[at-pict] with @racket[find]. The @racket[find] function uses
its arguments like @racket[lt-find].
The resulting pict has the same @tech{bounding box}, descent, and ascent as
@racket[base], even if the balloon extends beyond the bounding box.
@examples[#:eval ss-eval
(define a-pict (standard-fish 70 40))
(pin-balloon (balloon 40 30 5 'se 5 5)
(cc-superimpose (blank 300 150) a-pict)
a-pict
lc-find)
(pin-balloon (wrap-balloon (text "Hello!") 'sw -5 3)
(cc-superimpose (blank 300 150) a-pict)
a-pict
rt-find)
]}
@defproc[(balloon [w real?]
[h real?]
[corner-radius (and/c real? (not/c negative?))]
[spike (or/c 'n 's 'e 'w 'ne 'se 'sw 'nw)]
[dx real?]
[dy real?]
[color (or/c string? (is-a?/c color%)) balloon-color])
balloon?]{
Creates a balloon, much like @racket[wrap-balloon] except that the balloon's
width is @racket[w] and its height is @racket[h].}
@defproc*[([(balloon? [v any/c]) boolean?]
[(make-balloon [pict pict?] [x real?] [y real?]) balloon?]
[(balloon-pict [balloon balloon?]) pict?]
[(balloon-point-x [balloon balloon?]) real?]
[(balloon-point-y [balloon balloon?]) real?])]{
A balloon encapsulates a pict and the position of the balloon's spike
relative to the balloon's top-left corner.}
@defthing[balloon-color (or/c string? (is-a?/c color%))]
The default background color for a balloon.
@defboolparam[balloon-enable-3d on?]{
A parameter that determines whether balloons are drawn with 3-D shading.}
@; ----------------------------------------
@subsection{Face}
@defmodule[slideshow/face]{The @racketmodname[slideshow/face] library
provides functions for a kind of @as-index{Mr. Potatohead}-style face
library.}
@defthing[default-face-color (or/c string (is-a?/c color%))]{
Orange.}
@; helper for the next defproc
@(define (small-face mood) (scale (face mood) 0.25))
@defproc[(face [mood symbol?]
[color (or/c string (is-a?/c color%)) default-face-color])
pict?]{
Returns a pict for a pre-configured face with the given base
color. The built-in configurations, selected by mood-symbol, are as
follows:
@tabular[#:sep @hspace[2]
(list (list @para{@racket['unhappy] --- @racket[(face* 'none 'plain #t default-face-color 6)]}
@(small-face 'unhappy))
(list @para{@racket['sortof-unhappy] --- @racket[(face* 'worried 'grimace #t default-face-color 6)]}
@(small-face 'sortof-unhappy))
(list @para{@racket['sortof-happy] --- @racket[(face* 'worried 'medium #f default-face-color 6)]}
@(small-face 'sortof-happy))
(list @para{@racket['happy] --- @racket[(face* 'none 'plain #f default-face-color 6)]}
@(small-face 'happy))
(list @para{@racket['happier] --- @racket[(face* 'none 'large #f default-face-color 3)]}
@(small-face 'happier))
(list @para{@racket['embarrassed] --- @racket[(face* 'worried 'medium #f default-face-color 3)]}
@(small-face 'embarrassed))
(list @para{@racket['badly-embarrassed] --- @racket[(face* 'worried 'medium #t default-face-color 3)]}
@(small-face 'badly-embarrassed))
(list @para{@racket['unhappier] --- @racket[(face* 'normal 'large #t default-face-color 3)]}
@(small-face 'unhappier))
(list @para{@racket['happiest] --- @racket[(face* 'normal 'huge #f default-face-color 0 -3)]}
@(small-face 'happiest))
(list @para{@racket['unhappiest] --- @racket[(face* 'normal 'huge #t default-face-color 0 -3)]}
@(small-face 'unhappiest))
(list @para{@racket['mad] --- @racket[(face* 'angry 'grimace #t default-face-color 0)]}
@(small-face 'mad))
(list @para{@racket['mean] --- @racket[(face* 'angry 'narrow #f default-face-color 0)]}
@(small-face 'mean))
(list @para{@racket['surprised] --- @racket[(face* 'worried 'oh #t default-face-color -4 -3 2)]}
@(small-face 'surprised)))
]}
@defproc[(face* [eyebrow-kind (or/c 'none 'normal 'worried 'angry)]
[mouth-kind (or/c 'plain 'smaller 'narrow 'medium 'large
'huge 'grimace 'oh 'tongue)]
[frown? any/c]
[color (or/c string (is-a?/c color%))]
[eye-inset real?]
[eyebrow-dy real?]
[pupil-dx real?]
[pupil-dy real?]
[#:eyebrow-shading? eyebrow-on? any/c #t]
[#:mouth-shading? mouth-on? any/c #t]
[#:eye-shading? eye-on? any/c #t]
[#:tongue-shading? tongue-on? any/c #t]
[#:face-background-shading? face-bg-on? any/c #t]
[#:teeth? teeth-on? any/c #t])
pict?]{
Returns a pict for a face:
@itemize[
@item{@racket[eyebrow-kind] determines the eyebrow shape.}
@item{@racket[mouth-kind] determines the mouth shape, combined with
@racket[frown?].}
@item{@racket[frown?] determines whether the mouth is up or down.}
@item{@racket[color] determines the face color.}
@item{@racket[eye-inset] adjusts the eye size; recommend values are
between 0 and 10.}
@item{@racket[eyebrow-dy] adjusts the eyebrows; recommend values:
between -5 and 5.}
@item{@racket[pupil-dx] adjusts the pupil; recommend values are
between -10 and 10.}
@item{@racket[pupil-dy] adjusts the pupil; recommend values are
between -15 and 15.}
]
The @racket[#:eyebrow-shading?] through
@racket[#:face-background-shading?] arguments control whether a
shading is used for on a particular feature in the face (shading tends
to look worse than just anti-aliasing when the face is small). The
@racket[#:teeth?] argument controls the visibility of the teeth for
some mouth shapes.}
@; ----------------------------------------
@subsection{Flash}
@defmodule[slideshow/flash]
@defproc[(filled-flash [width real?]
[height real?]
[n-points exact-positive-integer? 10]
[spike-fraction (real-in 0 1) 0.25]
[rotation real? 0])
pict?]{
Returns a pict for a ``flash'': a spiky oval, like the yellow
background that goes behind a ``new!'' logo on web pages or a box of
cereal.
The @racket[height] and @racket[width] arguments determine the size of
the oval in which the flash is drawn, prior to rotation. The actual
height and width may be smaller if @racket[points] is not a multiple
of 4, and the actual height and width will be different if the flash
is rotated.
The @racket[n-points] argument determines the number of points on the
flash.
The @racket[spike-fraction] argument determines how big the flash
spikes are compared to the bounding oval.
The @racket[rotation] argument specifies an angle in radians for
counter-clockwise rotation.
The flash is drawn in the default color.
@examples[#:eval ss-eval
(filled-flash 100 50)
(filled-flash 100 50 8 0.25 (/ pi 2))
]}
@defproc[(outline-flash [width real?]
[height real?]
[n-points exact-positive-integer? 10]
[spike-fraction (real-in 0 1) 0.25]
[rotation real? 0])
pict?]{
Like @racket[filled-flash], but drawing only the outline.
@examples[#:eval ss-eval
(outline-flash 100 50)
(outline-flash 100 50 8 0.25 (/ pi 2))
]}
@; ------------------------------------------------------------------------
@section{Miscellaneous}
@defproc[(hyperlinkize [pict pict?])
@ -1403,11 +992,11 @@ form sets this parameter while also scaling the resulting pict.}
@section{Conversion to Picts}
@defmodule[slideshow/pict-convert]{The
@racketmodname[slideshow/pict-convert] library defines a protocol for
@defmodule[pict/convert]{The
@racketmodname[pict/convert] library defines a protocol for
values to convert themselves to @tech{picts}. The protocol
is used by DrRacket's interactions window, for example, to render
values that it prints}
values that it prints.}
@defthing[prop:pict-convertible struct-type-property?]{

2
collects/plot/plot2d/plot.rkt
View File

@ -4,7 +4,7 @@
(require racket/draw racket/snip racket/contract racket/list racket/class racket/match
unstable/contract
slideshow/pict
pict
unstable/parameter-group
racket/lazy-require
unstable/latent-contract/defthing

2
collects/plot/plot3d/plot.rkt
View File

@ -4,7 +4,7 @@
(require racket/draw racket/snip racket/match racket/list racket/class racket/contract
unstable/contract
slideshow/pict
pict
unstable/parameter-group
racket/lazy-require
unstable/latent-contract/defthing

4
collects/plot/scribblings/common.rkt
View File

@ -3,7 +3,7 @@
(require scribble/eval
(for-label racket
racket/gui/base
slideshow/pict
pict
db
plot
plot/utils
@ -17,7 +17,7 @@
(all-from-out scribble/eval)
(for-label (all-from-out racket
racket/gui/base
slideshow/pict
pict
db
plot
plot/utils

2
collects/plot/typed/plot2d/plot.rkt
View File

@ -45,7 +45,7 @@
[#:legend-anchor Anchor])
->* Void)]
#;; Picts are from slideshow/pict, which isn't typed yet
#;; Picts are from the pict collection, which isn't typed yet
[plot-pict ((Treeof (U renderer2d nonrenderer))
[#:x-min (Option Real)]
[#:x-max (Option Real)]

2
collects/plot/typed/plot3d/plot.rkt
View File

@ -55,7 +55,7 @@
[#:legend-anchor Anchor])
->* Void)]
#;; Picts are from slideshow/pict, which isn't typed yet
#;; Picts are from the pict collection, which isn't typed yet
[plot3d-pict ((Treeof (U renderer3d nonrenderer))
[#:x-min (Option Real)]
[#:x-max (Option Real)]

7
collects/redex/scribblings/ref.scrbl
View File

@ -10,7 +10,7 @@
racket/contract
mrlib/graph
(except-in 2htdp/image make-pen text)
(only-in slideshow/pict pict? text dc-for-text-size text-style/c
(only-in pict pict? text dc-for-text-size text-style/c
vc-append)
redex))
@ -2122,7 +2122,7 @@ characters written to the port go to the end of the editor.
Use @racket[write-special] to send @racket[snip%] objects or
@racketmodname[2htdp/image] images
(or other things that subscribe to @racketmodname[file/convertible]
or @racketmodname[slideshow/pict-convert])
or @racketmodname[pict/convert])
directly to the editor.
The @racket[colors] argument, if provided, specifies a list of
@ -2493,8 +2493,7 @@ relations, and metafunction written with plt redex.
Each grammar, reduction relation, and metafunction can be
saved in a .ps file (as encapsulated postscript), or can be
turned into a pict for viewing in the REPL or using with
Slideshow (see
@other-manual['(lib "scribblings/slideshow/slideshow.scrbl")]).
Slideshow (see the @racketmodname[pict] library).
@subsection{Picts, PDF, & PostScript}

8
collects/redex/scribblings/tut.scrbl
View File

@ -14,7 +14,7 @@
racket/gui
racket/pretty
racket/contract
slideshow/pict
pict
mrlib/graph
redex))
@ -22,7 +22,7 @@
@(interaction-eval #:eval amb-eval (require racket
redex/reduction-semantics
redex/pict
slideshow/pict
pict
racket/pretty))
@(interaction-eval #:eval amb-eval (begin (pretty-print-columns 40) (random-seed 0)))
@ -1046,10 +1046,10 @@ The result of @racket[render-reduction-relation] is rendered directly in DrRacke
interactions window, and also can be saved as a @filepath{.ps} file by passing
the name of the file as the second argument to @racket[render-reduction-relation].
Redex's typesetting also interoperates with the @racketmodname[slideshow/pict] library.
Redex's typesetting also interoperates with the @racketmodname[pict] library.
If we pull it in with a @racket[require]:
@racketblock[(require #,(racketmodname slideshow/pict))]
@racketblock[(require #,(racketmodname pict))]
then we can use the pict primitives to combine typeset fragments into a larger whole.

2
collects/redex/tests/bitmap-test-util.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require framework
slideshow/pict
pict
racket/runtime-path
racket/gui/base
(for-syntax racket/base)

2
collects/redex/tests/bitmap-test.rkt
View File

@ -1,7 +1,7 @@
#lang racket
(require "bitmap-test-util.rkt"
"../main.rkt"
slideshow/pict)
pict)
;; tests:
;; - language,

4
collects/scribblings/draw/linear-gradient-class.scrbl
View File

@ -1,9 +1,9 @@
#lang scribble/doc
@(require "common.rkt" scribble/eval
(for-label slideshow/pict))
(for-label pict))
@(define class-eval (make-base-eval))
@(interaction-eval #:eval class-eval (require racket/class racket/draw slideshow/pict))
@(interaction-eval #:eval class-eval (require racket/class racket/draw pict))
@defclass/title[linear-gradient% object% ()]{

4
collects/scribblings/draw/pen-class.scrbl
View File

@ -1,11 +1,11 @@
#lang scribble/doc
@(require "common.rkt"
(for-label slideshow/pict))
(for-label pict))
@(define pen-eval (make-base-eval))
@(interaction-eval
#:eval pen-eval
(require racket/draw slideshow/pict racket/class))
(require racket/draw pict racket/class))
@defclass/title[pen% object% ()]{

4
collects/scribblings/draw/radial-gradient-class.scrbl
View File

@ -1,8 +1,8 @@
#lang scribble/doc
@(require "common.rkt" scribble/eval (for-label slideshow/pict))
@(require "common.rkt" scribble/eval (for-label pict))
@(define class-eval (make-base-eval))
@(interaction-eval #:eval class-eval (require racket/class racket/draw slideshow/pict))
@(interaction-eval #:eval class-eval (require racket/class racket/draw pict))
@defclass/title[radial-gradient% object% ()]{

6
collects/scribblings/guide/graphics.scrbl
View File

@ -23,7 +23,7 @@ interfaces (GUIs):
See @other-doc['(lib "scribblings/gui/gui.scrbl")]
for more information.}
@item{The @racketmodname[slideshow/pict] library provides a more
@item{The @racketmodname[pict] library provides a more
functional abstraction layer over @racketmodname[racket/draw].
This layer is especially useful for creating slide
presentations with @seclink[#:doc '(lib
@ -31,14 +31,14 @@ interfaces (GUIs):
it is also useful for creating images for @seclink[#:doc '(lib
"scribblings/scribble/scribble.scrbl") "top"]{Scribble}
documents or other drawing tasks. Pictures created with the
@racketmodname[slideshow/pict] library can be rendered to any
@racketmodname[pict] library can be rendered to any
drawing context.
See @other-doc['(lib "scribblings/slideshow/slideshow.scrbl")]
for more information.}
@item{The @racketmodname[2htdp/image] library is similar to
@racketmodname[slideshow/pict]. It is more streamlined for
@racketmodname[pict]. It is more streamlined for
pedagogical use, but also slightly more specific to screen and
bitmap drawing.

2
collects/scribblings/guide/module-hier.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/pict
(require pict
racket/draw
racket/class
racket/math)

2
collects/scribblings/quick/mreval.rkt
View File

@ -11,7 +11,7 @@
[gui-interaction-eval-show mr-interaction-eval-show]))
(define ss-eval (make-base-eval))
(void (interaction-eval #:eval ss-eval (require slideshow/pict)))
(void (interaction-eval #:eval ss-eval (require pict)))
(define-syntax-rule (ss-interaction e ...)
(interaction #:eval ss-eval e ...))

14
collects/scribblings/quick/quick.scrbl
View File

@ -16,9 +16,9 @@
(for-label racket/base
racket/gui/base
racket/class
slideshow
slideshow pict
slideshow/code
slideshow/flash)
pict/flash)
(for-syntax racket/base))
@ -375,11 +375,11 @@ picture-making functions as well as more commonly used functions
such as @racket[list] and @racket[map].
To import additional libraries, use the @racket[require] form. For
example, the library @racketmodname[slideshow/flash] provides a
example, the library @racketmodname[pict/flash] provides a
@racket[filled-flash] function:
@ss-def+int[
(require slideshow/flash)
(require pict/flash)
(filled-flash 40 30)
]
@ -390,9 +390,9 @@ Modules are named and distributed in various ways:
@item{Some modules are packaged in the Racket distribution or
otherwise installed into a hierarchy of
@defterm{collections}. For example, the module name
@racketmodname[slideshow/flash] means ``the module implemented
@racketmodname[pict/flash] means ``the module implemented
in the file @filepath{flash.rkt} that is located in the
@filepath{slideshow} collection.'' When a module name includes
@filepath{pict} collection.'' When a module name includes
no slash, then it refers to a @filepath{main.rkt} file.}
@item{Some modules are distributed through the
@ -548,7 +548,7 @@ exposes a picture's drawing function. We can use
@racket[make-pict-drawer] in a canvas-painting callback to draw a
picture into a canvas:
@(mr-interaction-eval (require slideshow/flash))
@(mr-interaction-eval (require pict/flash))
@mr-def+int[
(define (add-drawing p)

2
collects/scribblings/scribble/class-diagrams.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require (prefix-in etc: mzlib/etc)
texpict/mrpict
(only-in slideshow/pict pin-line pin-arrow-line)
(only-in pict pin-line pin-arrow-line)
(except-in texpict/utils pin-line pin-arrow-line)
racket/class
racket/runtime-path

8
collects/scribblings/scribble/how-to-paper.scrbl
View File

@ -1,8 +1,8 @@
#lang scribble/doc
@(require scribble/manual scribble/bnf "utils.rkt"
slideshow/pict
pict
(for-label scriblib/figure scribble/base scribble/sigplan
(except-in slideshow/pict table)))
(except-in pict table)))
@(define-syntax-rule (samplemod . text) (codeblock . text))
@(define-syntax-rule (sample a . text)
@ -645,12 +645,12 @@ renders as
@section[#:tag "pictures"]{Pictures}
Any value that is convertable to an image can be used directly within
a Scribble document. Functions from the @racketmodname[slideshow/pict]
a Scribble document. Functions from the @racketmodname[pict]
and @racketmodname[2htdp/image] libraries, for example, generate
images. For example,
@sample|{
@(require slideshow/pict)
@(require pict)
This cookie has lost its chocolate chips:
@(colorize (filled-ellipse 40 40) "beige").

2
collects/scribblings/scribble/struct-hierarchy.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require "class-diagrams.rkt"
(only-in slideshow/pict pin-arrow-line)
(only-in pict pin-arrow-line)
texpict/mrpict
(except-in texpict/utils pin-arrow-line)
racket/system

390
collects/scribblings/slideshow/code.scrbl
View File

@ -4,391 +4,11 @@
(for-label slideshow/code
racket/gui/base))
@(define stx-obj
(tech #:doc '(lib "scribblings/reference/reference.scrbl") "syntax object"))
@title{Typesetting Racket Code in Slideshow}
@(define ss-eval (make-base-eval))
@(interaction-eval #:eval ss-eval
(begin
(require slideshow/code-pict
slideshow/pict
(for-syntax racket/base))
(current-code-tt (lambda (s) (text s "monospace" 14)))
(define-code code typeset-code)))
@title{Typesetting Racket Code}
@defmodule*[(slideshow/code-pict slideshow/code)]{
The @racketmodname[slideshow/code-pict] library
provides utilities for typesetting Racket code as a pict.
The @racketmodname[slideshow/code] library initializes
@defmodule[slideshow/code]{
The @racketmodname[slideshow/code] library
provides all of the exports of
@racketmodname[pict/code] and also initializes
@racket[get-current-code-font-size] to @racket[current-font-size].}
@defproc[(typeset-code [stx syntax?]) pict?]{
Produces a pict for code in the given @|stx-obj|. The
source-location information of the syntax object determines the line
breaks, line indenting, and space within a row. Empty rows are
ignored.
Beware that if you use @racket[read-syntax] on a file port, you may
have to turn on line counting via @racket[port-count-lines!] for the
code to typeset properly. Also beware that when a source file
containing a @racket[syntax] or @racket[quote-syntax] form is
compiled, source location information is omitted from the compiled
@|stx-obj|.
Normally, @racket[typeset-code] is used through the @racket[code]
syntactic form, which works properly with compilation, and that
escapes to pict-producing code via @racket[unsyntax]. See also
@racket[define-code].
Embedded picts within @racket[stx] are used directly. Row elements are
combined using and operator like @racket[htl-append], so use
@racket[code-align] (see below) as necessary to add an ascent to
ascentless picts. More precisely, creation of a line of code uses
@racket[pict-last] to determine the end point of the element most
recently added to a line; the main effect is that closing parentheses
are attached in the right place when a multi-line pict is embedded in
@racket[stx].
An identifier that starts with @litchar{_} is italicized in the pict,
and the @litchar{_} is dropped, unless the
@racket[code-italic-underscore-enabled] parameter is set to
@racket[#f]. Also, unless @racket[code-scripts-enabled] is set to
@racket[#f], @litchar{_} and @litchar{^} in the middle of a word
create superscripts and subscripts, respectively (like TeX); for
example @racketidfont{foo^4_ok} is displayed as the identifier
@racketidfont{foo} with a @racketidfont{4} superscript and an
@racketidfont{ok} subscript.
Further, uses of certain identifiers in @racket[stx] typeset
specially:
@itemize[
@item{@as-index{@racketidfont{code:blank}} --- produces a space.}
@item{@racket[(#,(as-index (racketidfont "code:comment")) _s ...)]
--- produces a comment block, with each @racket[_s] on its own line,
where each @racket[_s] must be a string or a pict.}
@item{@racket[(#,(as-index (racketidfont "code:line")) _datum ...)]
--- typesets the @racket[_datum] sequence, which is mostly useful for
the top-level sequence, since @racket[typeset-code] accepts only one
argument.}
@item{@racket[(#,(as-index (racketidfont "code:contract")) _datum
...)] --- like @racketidfont{code:line}, but every @racket[_datum]
is colored as a comment, and a @litchar{;} is prefixed to every line.}
@item{@racket[(#,(as-index (racketidfont "code:template")) _datum
...)] --- like @racketidfont{code:line}, but a @litchar{;} is
prefixed to every line.}
@item{@racketidfont{$} --- typesets as a vertical bar (for no
particularly good reason).}
]}
@defform[(code datum ...)]{
The macro form of @racket[typeset-code]. Within a @racket[datum],
@racket[unsyntax] can be used to escape to an expression, and
identifiers bound as syntax to @tech{code transformer}s trigger
transformations.
For more information, see @racket[typeset-code] and
@racket[define-code], since @racket[code] is defined as
@racketblock[
(define-code code typeset-code)
]
@defexamples[#:eval ss-eval #:escape potato
(code (+ 1 2))
(code (+ 1 #,(+ 1 1)))
(code (+ 1 #,(frame (code 2))))
(define-syntax two (make-code-transformer #'(code 2)))
(code (+ 1 two))
]}
@defparam[current-code-font style text-style/c]{
Parameter for a base font used to typeset text. The default is
@racket[`(bold . modern)]. For even more control, see
@racket[current-code-tt].}
@defparam[current-code-tt proc (string? . -> . pict?)]{
Parameter for a one-argument procedure to turn a
string into a pict, used to typeset text. The default is
@racketblock[
(lambda (s) (text s (current-code-font) ((get-current-code-font-size))))
]
This procedure is not used to typeset subscripts or other items that
require font changes, where @racket[current-code-font] is used
directly.}
@defparam[get-current-code-font-size proc (-> exact-nonnegative-integer?)]{
A parameter used to access the default font size. The
@racketmodname[slideshow/code] library initializes this parameter to
@racket[current-font-size].}
@defparam[current-code-line-sep amt real?]{
A parameter that determines the spacing between lines of typeset code.
The default is @racket[2].}
@defparam[current-comment-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of comments.}
@defparam[current-keyword-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of syntactic-form names. See
@racket[current-keyword-list].}
@defparam[current-id-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of identifiers that are not syntactic form
names or constants.}
@defparam[current-literal-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of literal values, such as strings and
numbers. See also @racket[current-literal-list]}
@defparam[current-const-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of constant names. See
@racket[current-const-list].}
@defparam[current-base-color color (or/c string? (is-a?/c color%))]{
A parameter for the color of everything else.}
@defparam[current-reader-forms syms (listof symbol?)]{
Parameter for a list of symbols indicating which built-in reader forms
should be used. The default is @racket['(quote quasiquote unquote
unquote-splicing syntax quasisyntax unsyntax unsyntax-splicing)].
Remove a symbol to suppress the corresponding reader output.}
@defproc[(code-align [pict pict?]) pict?]{
Adjusts the ascent of @racket[pict] so that its bottom aligns with the
baseline for text; use this function when @racket[pict] has no
ascent.}
@defparam[current-keyword-list names (listof string?)]{
A list of strings to color as syntactic-form names. The default
includes all of the forms provided by @racketmodname[racket/base]
and all of the forms provided by @racketmodname[mzscheme].}
@defparam[current-const-list names (listof string?)]{
A list of strings to color as constant names. The default is
@racket[null].}
@defparam[current-literal-list names (listof string?)]{
A list of strings to color as literals, in addition to literals such
as strings. The default is @racket[null].}
@defthing[racket/base-const-list (listof string?)]{
A list of strings that could be used to initialize the
@racket[current-const-list] parameter.}
@defthing[mzscheme-const-list (listof string?)]{
A list of strings that could be used to initialize the
@racket[current-const-list] parameter.}
@defboolparam[code-colorize-enabled on?]{
A parameter to enable or disable all code coloring. The default is
@racket[#t].}
@defboolparam[code-colorize-quote-enabled on?]{
A parameter to control whether under a @racket[quote] is colorized as
a literal (as in this documentation). The default is @racket[#t].}
@defboolparam[code-italic-underscore-enabled on?]{
A parameter to control whether @litchar{_}-prefixed identifiers are
italicized (dropping the @litchar{_}). The default is @racket[#t].}
@defboolparam[code-scripts-enabled on?]{
A parameter to control whether TeX-style subscripts and subscripts are
recognized in an identifier.}
@defform*[[(define-code code-id typeset-code-id)
(define-code code-id typeset-code-id escape-id)]]{
Defines @racket[code-id] as a macro that uses
@racket[typeset-code-id], which is a function with the same input as
@racket[typeset-code]. The @racket[escape-id] form defaults to
@racket[unsyntax].
The resulting @racket[code-id] syntactic form takes a sequence of
@racket[_datum]s:
@racketblock[
(code-id _datum ...)
]
It produces a pict that typesets the sequence. Source-location
information for the @racket[_datum] determines the layout of code in
the resulting pict. The @racket[code-id] is expanded in such a way
that source location is preserved during compilation (so
@racket[typeset-code-id] receives a syntax object with source
locations intact).
If a @racket[_datum] contains @racket[(escape-id _expr)]---perhaps as
@RACKET[#,_expr] when @racket[escape-id] is @racket[unsyntax]---then
the @racket[_expr] is evaluated and the result datum is spliced in
place of the @racket[escape-id] form in @racket[_datum]. If the result
is not a syntax object, it is given the source location of the
@racket[escape-id] form. A pict value intected this way as a
@racket[_datum] is rendered as itself.
If a @racket[_datum] contains @racket[(transform-id _datum ...)] or
@racket[transform-id] for a @racket[transform-id] that is bound as syntax to a
@tech{code transformer}, then the @racket[(transform-id _datum ...)]
or @racket[transform-id] may be replaced with an escaped expression,
depending on the @tech{code transformer}'s result.}
@deftogether[(
@defproc[(make-code-transformer [proc-or-stx (or/c (syntax? . -> . (or/c syntax? #f))
syntax?)])
code-transformer?]
@defthing[prop:code-transformer struct-type-property?]
@defproc[(code-transformer? [v any/c]) boolean?]
)]{
Exported @racket[for-syntax] for creating @deftech{code transformers}.
For @tech{code transformer} created with
@racket[(make-code-transformer _proc)], @racket[proc] takes a syntax
object representing the use of an identifier bound to the transformer,
and it produces an expression whose value replaces the identifier use
within a @racket[code] form or a form defined via
@racket[define-code]. Like a macro transformer, a code transformer is
triggered either by a use of the bound identifier in an
``application'' position, in which case the transformer receives the
entire ``application'' form, or the identifier by itself can also
trigger the transformer. The @tech{code transformer}'s @racket[_proc]
can return @racket[#f], in which case the use of the identifier is
left untransformed; if the identifier was used in an ``application''
position, the transformer @racket[_proc] will be called again for the
identifier use by itself.
A @tech{code transformer} produced by @racket[(make-code-transformer _stx)]
is equivalent to
@racketblock[
(make-code-transformer (lambda (use-stx)
(if (identifier? use-stx)
_stx
#f)))
]
A structure type with the @racket[prop:code-transformer] property
implements a @tech{code transformer}. The property value must be a
procedure of one argument, which receives the structure and returns a
procedure that is like a @racket[_proc] passed to
@racket[make-code-transformer], except that the property value takes
the structure instance as an argument before the syntax object to
transform.
The @racket[code-transformer?] predicate returns @racket[#t] for a
value produced by @racket[make-code-transformer] or for an instance of
a structure type with the @racket[prop:code-transformer] property,
@racket[#f] otherwise.
@examples[
#:eval ss-eval
(let-syntax ([bag (make-code-transformer #'(code hat))]
[copy (make-code-transformer (syntax-rules ()
[(_ c) (code (* 2 c))]))])
(inset (frame (code ((copy cat) in the bag))) 2))
]}
@defform[(define-exec-code (pict-id runnable-id string-id)
datum ...)]{
Binds @racket[pict-id] to the result of @racket[(code datum ...)],
except that if an identifier @racketidfont{_} appears anywhere in a
@racket[datum], then the identifier and the following expression are
not included for @racket[code].
Meanwhile, @racket[runnable-id] is bound to a @|stx-obj| that wraps
the @racket[datum]s in a @racket[begin]. In this case,
@racketidfont{_}s are removed from the @racket[datum]s, but not the
following expression. Thus, an @racketidfont{_} identifier is used to
comment out an expression from the pict, but have it present in the
@|stx-obj| for evaluation.
The @racket[string-id] is bound to a string representation of the code
that is in the pict. This string is useful for copying to the
clipboard with @racket[(send the-clipboard set-clipboard-string
string-id 0)].}
@defform[(define-exec-code/scale scale-expr (pict-id runnable-id string-id)
datum ...)]{
Like @racket[define-exec-code], but with a scale to use via
@racket[scale/improve-new-text] when generating the pict.}
@deftogether[(
@defthing[comment-color (or/c string? (is-a?/c color%))]
@defthing[keyword-color (or/c string? (is-a?/c color%))]
@defthing[id-color (or/c string? (is-a?/c color%))]
@defthing[literal-color (or/c string? (is-a?/c color%))]
)]{
For backward compatibility, the default values for
@racket[current-comment-color], etc.}
@defproc[(code-pict-bottom-line-pict [pict pict?])
(or/c pict? #f)]{
The same as @racket[pict-last], provided for backward compatibility.}
@defproc[(pict->code-pict [pict pict?] [bl-pict (or/c pict? #f)]) pict?]{
Mainly for backward compatibility: returns @racket[(if bl-pict
(use-last pict (or (pict-last bl-pict) bl-pict)))].}
@; ----------------------------------------
@close-eval[ss-eval]

2
collects/scribblings/slideshow/guide.scrbl
View File

@ -20,7 +20,7 @@ The @racketmodname[slideshow] module acts as a language that includes:
@item{all of @racketmodname[racket];}
@item{pict-creating functions from @racketmodname[slideshow/pict]; and}
@item{pict-creating functions from @racketmodname[pict]; and}
@item{slide-composing functions from @racketmodname[slideshow/base].}

3
collects/scribblings/slideshow/slideshow.scrbl
View File

@ -15,7 +15,7 @@ program.
To get started, run the @exec{slideshow} executable, and click the
@onscreen{Run Tutorial} link.
To learn more about why Slideshow is cool, see also ``Slideshow:
To learn more about Slideshow, see also ``Slideshow:
Functional Presentations'' @cite["Findler06"].
@defmodulelang*/no-declare[(slideshow)]{Most of the bindings defined
@ -28,7 +28,6 @@ which also re-exports all of @racketmodname[racket] except for
@; ------------------------------------------------------------------------
@include-section["guide.scrbl"]
@include-section["picts.scrbl"]
@include-section["slides.scrbl"]
@include-section["code.scrbl"]
@include-section["play.scrbl"]

4
collects/scribblings/slideshow/ss.rkt
View File

@ -5,7 +5,7 @@
(require (for-label (except-in racket only drop)
slideshow/base
slideshow/pict))
pict))
(provide (for-label (all-from-out racket
slideshow/base
slideshow/pict)))
pict)))

7
collects/slideshow/balloon.rkt
View File

@ -1,4 +1,3 @@
(module balloon scheme/base
(require texpict/balloon)
(provide (except-out (all-from-out texpict/balloon)
place-balloon)))
#lang racket/base
(require pict/balloon)
(provide (all-from-out pict/balloon))

127
collects/slideshow/code-pict.rkt
View File

@ -1,126 +1,3 @@
#lang racket/base
(require slideshow/pict
texpict/code
mzlib/unit
(for-syntax racket/base
syntax/to-string
mzlib/list))
(define get-current-code-font-size (make-parameter (lambda () 12)))
(define current-code-line-sep (make-parameter 2))
(define (current-font-size) ((get-current-code-font-size)))
(define-values/invoke-unit/infer code@)
(define-code code typeset-code)
(provide code
current-code-line-sep
get-current-code-font-size
define-code
(for-syntax prop:code-transformer
code-transformer?
make-code-transformer))
(provide-signature-elements code^)
(provide define-exec-code/scale
define-exec-code)
(define-syntax (define-exec-code/scale stx)
(define (drop-to-run l)
(map (lambda (x)
(cond
[(and (pair? (syntax-e x))
(eq? 'local (syntax-e (car (syntax-e x)))))
(let ([l (syntax->list x)])
(list* 'local
(drop-to-run (syntax->list (cadr l)))
(cddr l)))]
[(and (pair? (syntax-e x))
(eq? 'define (syntax-e (car (syntax-e x)))))
(let ([l (syntax->list x)])
(list* 'define
(cadr l)
(drop-to-run (cddr l))))]
[else x]))
(filter (lambda (x)
(cond
[(eq? '_ (syntax-e x))
#f]
[(eq? '... (syntax-e x))
#f]
[(eq? 'code:blank (syntax-e x))
#f]
[(and (pair? (syntax-e x))
(eq? 'code:comment (syntax-e (car (syntax-e x)))))
#f]
[(and (pair? (syntax-e x))
(eq? 'code:contract (syntax-e (car (syntax-e x)))))
#f]
[(and (pair? (syntax-e x))
(eq? 'unsyntax (syntax-e (car (syntax-e x)))))
#f]
[else #t]))
l)))
(define (drop-to-show l)
(foldr (lambda (x r)
(cond
[(and (identifier? x) (eq? '_ (syntax-e x)))
(cdr r)]
[(and (pair? (syntax-e x))
(eq? 'local (syntax-e (car (syntax-e x)))))
(cons
(let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(datum->syntax
(cadr l)
(drop-to-show (syntax->list (cadr l)))
(cadr l))
(cddr l))
x))
r)]
[(and (pair? (syntax-e x))
(eq? 'cond (syntax-e (car (syntax-e x)))))
(cons
(let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(drop-to-show (cdr l)))
x))
r)]
[(and (pair? (syntax-e x))
(eq? 'define (syntax-e (car (syntax-e x)))))
(cons (let ([l (syntax->list x)])
(datum->syntax
x
(list* (car l)
(cadr l)
(drop-to-show (cddr l)))
x))
r)]
[else (cons x r)]))
empty
l))
(syntax-case stx ()
[(_ s (showable-name runnable-name string-name) . c)
#`(begin
(define runnable-name
(quote-syntax
(begin
#,@(drop-to-run (syntax->list #'c)))))
(define showable-name
(scale/improve-new-text
(code
#,@(drop-to-show (syntax->list #'c)))
s))
(define string-name
#,(syntax->string #'c)))]))
(define-syntax define-exec-code
(syntax-rules ()
[(_ (a b c) . r)
(define-exec-code/scale 1 (a b c) . r)]))
(require pict/code)
(provide (all-from-out pict/code))

6
collects/slideshow/face.rkt
View File

@ -1,3 +1,3 @@
(module face scheme/base
(require texpict/face)
(provide (all-from-out texpict/face)))
#lang racket/base
(require pict/face)
(provide (all-from-out pict/face))

7
collects/slideshow/flash.rkt
View File

@ -1,4 +1,3 @@
#lang scheme/base
(require texpict/flash)
(provide (all-from-out texpict/flash))
#lang racket/base
(require pict/flash)
(provide (all-from-out pict/flash))

2
collects/slideshow/initial-ones.rkt
View File

@ -4,7 +4,7 @@
;; we can use scheme/base and import slideshow/base, etc.
(require slideshow/base
slideshow/pict
pict
slideshow/code
racket/class
racket/list

11
collects/slideshow/pict-convert.rkt
View File

@ -1,10 +1,3 @@
#lang racket/base
(require "pict.rkt"
racket/contract
texpict/private/convertible)
(provide pict-convert pict-convertible?)
(provide/contract
[prop:pict-convertible (struct-type-property/c (-> pict-convertible? pict?))]
[prop:pict-convertible? (struct-type-property/c predicate/c)])
(require pict/convert)
(provide (all-from-out pict/convert))

59
collects/slideshow/pict-snipclass.rkt
View File

@ -1,31 +1,30 @@
(module pict-snipclass mzscheme
(require mzlib/class
mred)
(provide snip-class)
(require "private/pict-box-lib.rkt")
#lang racket/base
(require racket/class racket/gui/base)
(define pict-snip%
(class* editor-snip% (readable-snip<%>)
(define/public (read-special file line col pos)
(build-lib-pict-stx
(lambda (ids) (syntax (void)))
(get-snp/poss this)))
(super-new)))
(define lib-pict-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([snip (new pict-snip%)]
[editor (new pasteboard%)]
[show-picts? (not (zero? (send stream-in get-exact)))]
[up-to-date? (not (zero? (send stream-in get-exact)))])
(send snip set-editor editor)
(send editor read-from-file stream-in #f)
snip))
(super-new)))
(define snip-class (make-object lib-pict-snipclass%))
(send snip-class set-version 2)
(send snip-class set-classname (format "~s" '(lib "pict-snipclass.ss" "slideshow")))
(send (get-the-snip-class-list) add snip-class))
(provide snip-class)
(require "private/pict-box-lib.rkt")
(define pict-snip%
(class* editor-snip% (readable-snip<%>)
(define/public (read-special file line col pos)
(build-lib-pict-stx
(lambda (ids) (syntax (void)))
(get-snp/poss this)))
(super-new)))
(define lib-pict-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([snip (new pict-snip%)]
[editor (new pasteboard%)]
[show-picts? (not (zero? (send stream-in get-exact)))]
[up-to-date? (not (zero? (send stream-in get-exact)))])
(send snip set-editor editor)
(send editor read-from-file stream-in #f)
snip))
(super-new)))
(define snip-class (make-object lib-pict-snipclass%))
(send snip-class set-version 2)
(send snip-class set-classname (format "~s" '(lib "pict-snipclass.ss" "slideshow")))
(send (get-the-snip-class-list) add snip-class)

291
collects/slideshow/pict.rkt
View File

@ -1,288 +1,3 @@
(module pict scheme/base
(require (rename-in texpict/mrpict
[hline t:hline]
[vline t:vline]
[frame t:frame])
(rename-in texpict/utils
[pin-line t:pin-line]
[pin-arrow-line t:pin-arrow-line]
[pin-arrows-line t:pin-arrows-line])
(only-in racket/draw dc-path% make-bitmap bitmap% bitmap-dc%)
(only-in racket/class new send make-object is-a?/c)
racket/contract)
(define (hline w h #:segment [seg #f])
(if seg
(dash-hline w h seg)
(t:hline w h)))
(define (vline w h #:segment [seg #f])
(if seg
(dash-vline w h seg)
(t:vline w h)))
(define (frame p
#:color [col #f]
#:line-width [lw #f]
#:segment [seg #f])
(let* ([f (if seg
(dash-frame (launder (ghost p)) seg)
(t:frame (launder (ghost p))))]
[f (if col
(colorize f col)
f)]
[f (if lw
(linewidth lw f)
f)])
(refocus (cc-superimpose p f)
p)))
(define (pict-path? p)
(or (pict? p)
(and (pair? p)
(list? p)
(andmap pict? p))))
(define (pin-line 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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f])
(if (not (or sa ea))
(finish-pin (launder (t:pin-line (ghost p)
src src-find
dest dest-find
#:style style))
p lw col alpha under?)
(pin-curve* #f #f p src src-find dest dest-find
sa ea sp ep 0 col lw under? #t
style alpha)))
(define (pin-arrow-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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f]
#:hide-arrowhead? [hide-arrowhead? #f])
(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?
#:hide-arrowhead? hide-arrowhead?
#:style style))
p lw col alpha under?)
(pin-curve* #f (not hide-arrowhead?) p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?
style alpha)))
(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]
#:alpha [alpha 1.0]
#:line-width [lw #f]
#:under? [under? #f]
#:solid? [solid? #t]
#:style [style #f]
#:hide-arrowhead? [hide-arrowhead? #f])
(if (not (or sa ea))
(finish-pin (launder (t:pin-arrows-line sz (ghost p)
src src-find
dest dest-find
#f #f #f solid?
#:hide-arrowhead? hide-arrowhead?
#:style style))
p lw col alpha under?)
(pin-curve* (not hide-arrowhead?) (not hide-arrowhead?)
p src src-find dest dest-find
sa ea sp ep sz col lw under? solid?
style alpha)))
(define (pin-curve* start-arrow? end-arrow? p
src src-find
dest dest-find
sa ea sp ep
sz col lw
under? solid?
style alpha)
(let-values ([(sx0 sy0) (src-find p src)]
[(dx0 dy0) (dest-find p dest)])
(let* ([sa (or sa
(atan (- sy0 dy0) (- dx0 sx0)))]
[ea (or ea
(atan (- sy0 dy0) (- dx0 sx0)))]
[d (sqrt (+ (* (- dy0 sy0) (- dy0 sy0)) (* (- dx0 sx0) (- dx0 sx0))))]
[sp (* (or sp 1/4) d)]
[ep (* (or ep 1/4) d)])
(let ([dx (if end-arrow? (- dx0 (* sz (cos ea))) dx0)]
[dy (if end-arrow? (+ dy0 (* sz (sin ea))) dy0)]
[sx (if start-arrow? (+ sx0 (* sz (cos sa))) sx0)]
[sy (if start-arrow? (- sy0 (* sz (sin sa))) sy0)]
[path (new dc-path%)]
[maybe-pin-line
(lambda (arrow? p sx sy dx dy)
(if arrow?
(pin-arrow-line
sz
p
p (lambda (a b) (values sx sy))
p (lambda (a b) (values dx dy))
#:line-width lw
#:color col
#:under? under?
#:solid? solid?
#:style style)
p))])
(send path move-to sx sy)
(send path curve-to
(+ sx (* sp (cos sa)))
(- sy (* sp (sin sa)))
(- dx (* ep (cos ea)))
(+ dy (* ep (sin ea)))
dx
dy)
(maybe-pin-line
start-arrow?
(maybe-pin-line
end-arrow?
((if under? pin-under pin-over)
p
0 0
(let* ([p (dc (lambda (dc x y)
(let ([b (send dc get-brush)])
(send dc set-brush "white" 'transparent)
(send dc draw-path path x y)
(send dc set-brush b)))
0 0)]
[p (if col
(colorize p col)
p)]
[p (if (= alpha 1.0)
p
(cellophane p alpha))]
[p (if lw
(linewidth lw p)
p)]
[p (if style
(linestyle style p)
p)])
p))
dx dy dx0 dy0)
sx sy sx0 sy0)))))
(define (finish-pin l p lw col alpha under?)
(let* ([l (if lw
(linewidth lw l)
l)]
[l (if col
(colorize l col)
l)]
[l (if (= alpha 1.0)
l
(cellophane l alpha))])
(if under?
(cc-superimpose l p)
(cc-superimpose p l))))
(define fish
(let ([standard-fish
(lambda (w h
#:direction [direction 'left]
#:color [color "blue"]
#:eye-color [eye-color "black"]
#:open-mouth [open-mouth #f])
(standard-fish w h direction color eye-color open-mouth))])
standard-fish))
(define (pict->bitmap p [smoothing 'aligned])
(define w (pict-width p))
(define h (pict-height p))
(define bm (make-bitmap (max 1 (inexact->exact (ceiling w)))
(max 1 (inexact->exact (ceiling h)))))
(define dc (make-object bitmap-dc% bm))
(send dc set-smoothing smoothing)
(draw-pict p dc 0 0)
bm)
(provide hline vline
frame
pict-path?
pin-line pin-arrow-line pin-arrows-line
(except-out (all-from-out texpict/mrpict)
dash-hline dash-vline
dash-frame oval oval/radius
caps-text
big-circle
picture
cons-picture
cons-picture*
place-over
place-under
record
thick
thin
find-lt
find-lc
find-lb
find-ltl
find-lbl
find-ct
find-cc
find-cb
find-ctl
find-cbl
find-rt
find-rc
find-rb
find-rtl
find-rbl
drop
lift)
(rename-out [drop drop-below-ascent]
[lift lift-above-baseline])
(except-out (all-from-out texpict/utils)
color-frame color-dash-frame
round-frame color-round-frame
cons-colorized-picture
arrow-line
arrows-line
add-line
add-arrow-line
add-arrows-line
explode-star
standard-fish
find-pen find-brush)
(rename-out [fish standard-fish])
(contract-out [pict->bitmap ((pict?) ((one-of/c 'unsmoothed 'smoothed 'aligned))
. ->* . (is-a?/c bitmap%))])
))
#lang racket/base
(require pict)
(provide (all-from-out pict))

2
collects/slideshow/play.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require slideshow/base
slideshow/pict
pict
scheme/list
scheme/math)

92
collects/slideshow/private/image-snipr.rkt
View File

@ -1,47 +1,47 @@
(module image-snipr mzscheme
(require mred
mzlib/class)
#lang racket/base
(require racket/gui/base
racket/class)
(provide snipclass
image-snip/r%)
(define image-snip/r%
(class image-snip%
(init bitmap)
(init-field orig-snip)
(define/public (get-orig-snip) orig-snip)
(inherit get-bitmap)
(define/override (copy) (make-object image-snip/r% (get-bitmap) orig-snip))
(super-make-object bitmap)
(inherit set-snipclass set-bitmap)
(set-snipclass snipclass)
(define/override (write stream-out)
(super write stream-out)
(let* ([sc (send orig-snip get-snipclass)]
[cn-bytes (string->bytes/utf-8 (send sc get-classname))])
(send stream-out put (+ (bytes-length cn-bytes) 1) cn-bytes)
(send orig-snip write stream-out)))))
(define image-snip/r-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([is-sc (send (get-the-snip-class-list) find "wximage")]
[bs (send is-sc read stream-in)]
[bm (send bs get-bitmap)])
(send bs set-bitmap (make-object bitmap% 1 1)) ;; ugh
(let* ([name (bytes->string/utf-8 (send stream-in get-bytes))]
[sc (send (get-the-snip-class-list) find name)])
(unless sc
(error 'ack! "did not find a snipclass ~s, so cannot continue parsing stream" name))
(let* ([hidden-snip (send sc read stream-in)])
(make-object image-snip/r% bm hidden-snip)))))
(super-new)))
(define snipclass (new image-snip/r-snipclass%))
(send snipclass set-classname (format "~s" '(lib "image-snipr.ss" "slideshow" "private")))
(send snipclass set-version 1)
(send (get-the-snip-class-list) add snipclass))
(provide snipclass
image-snip/r%)
(define image-snip/r%
(class image-snip%
(init bitmap)
(init-field orig-snip)
(define/public (get-orig-snip) orig-snip)
(inherit get-bitmap)
(define/override (copy) (make-object image-snip/r% (get-bitmap) orig-snip))
(super-make-object bitmap)
(inherit set-snipclass set-bitmap)
(set-snipclass snipclass)
(define/override (write stream-out)
(super write stream-out)
(let* ([sc (send orig-snip get-snipclass)]
[cn-bytes (string->bytes/utf-8 (send sc get-classname))])
(send stream-out put (+ (bytes-length cn-bytes) 1) cn-bytes)
(send orig-snip write stream-out)))))
(define image-snip/r-snipclass%
(class snip-class%
(define/override (read stream-in)
(let* ([is-sc (send (get-the-snip-class-list) find "wximage")]
[bs (send is-sc read stream-in)]
[bm (send bs get-bitmap)])
(send bs set-bitmap (make-object bitmap% 1 1)) ;; ugh
(let* ([name (bytes->string/utf-8 (send stream-in get-bytes))]
[sc (send (get-the-snip-class-list) find name)])
(unless sc
(error 'ack! "did not find a snipclass ~s, so cannot continue parsing stream" name))
(let* ([hidden-snip (send sc read stream-in)])
(make-object image-snip/r% bm hidden-snip)))))
(super-new)))
(define snipclass (new image-snip/r-snipclass%))
(send snipclass set-classname (format "~s" '(lib "image-snipr.ss" "slideshow" "private")))
(send snipclass set-version 1)
(send (get-the-snip-class-list) add snipclass)

8
collects/slideshow/tutorial-show.rkt
View File

@ -417,10 +417,10 @@
(show-arrows (code arrow) (t "arrow") arrow)
(show-arrows (code arrowhead) (t "arrowhead") arrowhead)
(require slideshow/face)
(require pict/face)
(slide
#:title "Faces"
(para "The" (code slideshow/face)
(para "The" (code pict/face)
"library makes faces")
(blank)
(hc-append
@ -540,10 +540,10 @@
plain-file lt-find
#:color "orange"))
(require slideshow/balloon)
(require pict/balloon)
(slide
#:title "Balloons"
(para "The" (code slideshow/balloon)
(para "The" (code pict/balloon)
"library provides cartoon balloons ---"
"another reason to use" (code -find) "functions")
(let* ([orig fish-file-scene]

2
collects/teachpack/door.ss
View File

@ -1,7 +1,5 @@
#lang slideshow
(require slideshow/pict)
(define DELTA 40)
(define FT 12)

2
collects/teachpack/nuworld.ss
View File

@ -1,6 +1,6 @@
#lang slideshow
(require slideshow/pict mred/mred)
(require racket/draw)
(define DELTA 80)
(define FT 12)

2
collects/teachpack/server.ss
View File

@ -1,7 +1,5 @@
#lang slideshow
(require slideshow/pict)
(define DELTA 80)
(define FT 12)

2
collects/teachpack/world.ss
View File

@ -1,7 +1,5 @@
#lang slideshow
(require slideshow/pict)
(define DELTA 80)
(define FT 12)

2
collects/tests/racket/enter.rkt
View File

@ -10,4 +10,4 @@
(error "not in f?")))
;; Make sure that `enter!' can work on lots of modules:
(enter! slideshow/pict)
(enter! pict)

2
collects/unstable/gui/pict.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/pict
(require pict
racket/contract/base racket/match
racket/splicing racket/stxparam racket/draw
racket/block racket/class

2
collects/unstable/gui/ppict.rkt
View File

@ -4,7 +4,7 @@
syntax/parse/experimental/contract
"private/ppict-syntax.rkt")
racket/contract/base
slideshow/pict
pict
"private/ppict.rkt"
"private/tag-pict.rkt")

2
collects/unstable/gui/private/blur.rkt
View File

@ -5,7 +5,7 @@
racket/class
racket/draw
unstable/future
slideshow/pict)
pict)
(define nneg-real/c (and/c real? (not/c negative?)))

2
collects/unstable/gui/private/ppict-syntax.rkt
View File

@ -3,7 +3,7 @@
(for-template racket/base
racket/contract/base
racket/stxparam
slideshow/pict
pict
"ppict.rkt"))
(provide fragment-sequence)

2
collects/unstable/gui/private/ppict.rkt
View File

@ -4,7 +4,7 @@
racket/class
racket/stxparam
racket/contract/base
slideshow/pict
pict
"tag-pict.rkt")
#|

2
collects/unstable/gui/private/shframe.rkt
View File

@ -2,7 +2,7 @@
(require racket/math
racket/class
racket/draw
slideshow/pict
pict
"blur.rkt")
(provide shadow-frame
arch)

2
collects/unstable/gui/private/tag-pict.rkt
View File

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/pict)
(require pict)
(provide tag-pict
find-tag
find-tag*

2
collects/unstable/gui/pslide.rkt
View File

@ -4,7 +4,7 @@
"private/ppict-syntax.rkt")
racket/contract/base
slideshow/base
slideshow/pict
pict
"private/ppict.rkt")
;; ============================================================

2
collects/unstable/gui/redex.rkt
View File

@ -2,7 +2,7 @@
(require racket/contract
redex/reduction-semantics
redex/pict
slideshow/pict
pict
racket/list)
;; TO DO:

2
collects/unstable/gui/scribble.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require (prefix-in s: (combine-in scribble/manual scribble/core))
(prefix-in slideshow: (combine-in slideshow/base slideshow/pict))
(prefix-in slideshow: (combine-in slideshow/base pict))
racket/draw
racket/class ;; only for make-object
racket/match)

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

@ -1,5 +1,5 @@
#lang racket/base
(require slideshow/base slideshow/pict
(require slideshow/base pict
racket/contract/base racket/list racket/match
racket/stxparam
(for-syntax racket/base racket/list racket/set syntax/parse)

4
collects/unstable/scribblings/gui/pict.scrbl
View File

@ -6,12 +6,12 @@
racket/class
racket/draw
racket/future
slideshow/pict
pict
unstable/contract
unstable/gui/pict))
@(define the-eval (make-base-eval))
@(the-eval '(require racket/math slideshow/pict unstable/gui/pict))
@(the-eval '(require racket/math pict unstable/gui/pict))
@title[#:tag "pict"]{Pict Utilities}
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]

2
collects/unstable/scribblings/gui/pslide.scrbl
View File

@ -13,7 +13,7 @@
@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
@(define the-eval (make-base-eval))
@(the-eval '(require slideshow/pict unstable/gui/ppict unstable/gui/private/tag-pict))
@(the-eval '(require pict unstable/gui/ppict unstable/gui/private/tag-pict))
@section[#:tag "ppicts"]{Progressive Picts}

4
collects/unstable/scribblings/gui/redex.scrbl
View File

@ -1,10 +1,10 @@
#lang scribble/manual
@(require racket/stxparam scribble/base scribble/eval "../utils.rkt"
(for-syntax racket/base syntax/srcloc)
(for-label racket/base racket/contract slideshow/pict redex unstable/gui/redex))
(for-label racket/base racket/contract pict redex unstable/gui/redex))
@(define the-eval (make-base-eval))
@(the-eval '(require redex/reduction-semantics redex/pict unstable/gui/redex slideshow/pict))
@(the-eval '(require redex/reduction-semantics redex/pict unstable/gui/redex pict))
@title[#:tag "redex"]{Redex}
@unstable-header[]